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