never executed always true always false

    1 module HelVM.HelIO.Extra where
    2 
    3 import           Control.Type.Operator
    4 
    5 import           Data.Char             hiding (chr)
    6 import           Data.Default
    7 import           Data.Typeable
    8 import           Text.Pretty.Simple
    9 
   10 import qualified Data.Text             as Text
   11 
   12 -- | FilesExtra
   13 
   14 readFileLTextUtf8 :: MonadIO m => FilePath -> m LText
   15 readFileLTextUtf8 = (pure <$> decodeUtf8) <=< readFileLBS
   16 
   17 readFileTextUtf8 :: MonadIO m => FilePath -> m Text
   18 readFileTextUtf8 = (pure <$> decodeUtf8) <=< readFileBS
   19 
   20 -- | TextExtra
   21 
   22 toUppers :: Text -> Text
   23 toUppers = Text.map toUpper
   24 
   25 splitOneOf :: String -> Text -> [Text]
   26 splitOneOf s = Text.split contains where contains c = c `elem` s
   27 
   28 -- | ShowExtra
   29 
   30 showP :: Show a => a -> Text
   31 showP = toText <$> pShowNoColor
   32 
   33 showToText :: (Typeable a , Show a) => a -> Text
   34 showToText a = show a `fromMaybe` (cast a :: Maybe Text)
   35 
   36 -- | CharExtra
   37 
   38 genericChr :: Integral a => a -> Char
   39 genericChr = chr <$> fromIntegral
   40 
   41 -- | MaybeExtra
   42 
   43 infixr 0 ???
   44 (???) :: Maybe a -> a -> a
   45 (???) = flip fromMaybe
   46 
   47 fromMaybeOrDef :: Default a => Maybe a -> a
   48 fromMaybeOrDef = fromMaybe def
   49 
   50 headMaybe :: [a] -> Maybe a
   51 headMaybe = viaNonEmpty head
   52 
   53 fromJustWith :: Show e => e -> Maybe a -> a
   54 fromJustWith e = fromJustWithText (show e)
   55 
   56 fromJustWithText :: Text -> Maybe a -> a
   57 fromJustWithText t Nothing  = error t
   58 fromJustWithText _ (Just a) = a
   59 
   60 toMaybe :: Bool -> a -> Maybe a
   61 toMaybe False _ = Nothing
   62 toMaybe True  x = Just x
   63 
   64 -- | ListExtra
   65 
   66 unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> a -> m [b]
   67 unfoldrM f = go <=< f where
   68   go  Nothing       = pure []
   69   go (Just (b, a')) = (b : ) <$> (go <=< f) a'
   70 
   71 --unfoldr :: (a ->  Maybe (b, a)) -> a -> [b]
   72 --unfoldr f = runIdentity <$> unfoldrM (Identity <$> f)
   73 
   74 runParser :: Monad m => Parser a b m -> [a] -> m [b]
   75 runParser f = go where
   76   go [] = pure []
   77   go a  = (build <=< f) a where build (b, a') = (b : ) <$> go a'
   78 
   79 repeatedlyM :: Monad m => Parser a b m -> [a] -> m [b]
   80 repeatedlyM = runParser
   81 
   82 repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]
   83 repeatedly f = runIdentity <$> repeatedlyM (Identity <$> f)
   84 
   85 -- | NonEmptyExtra
   86 
   87 many1' :: (Monad f, Alternative f) => f a -> f $ NonEmpty a
   88 many1' p = liftA2 (:|) p $ many p
   89 
   90 -- | Extra
   91 
   92 -- | `tee` is deprecated, use `<*>`
   93 tee :: (a -> b -> c) -> (a -> b) -> a -> c
   94 tee f1 f2 a = (f1 a <$> f2) a
   95 
   96 type Act s a = s -> Either s a
   97 type ActM m s a = s -> m (Either s a)
   98 type Parser a b m = [a] -> m (b, [a])