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 toMaybe :: Bool -> a -> Maybe a
   58 toMaybe False _ = Nothing
   59 toMaybe True  x = Just x
   60 
   61 -- | ListExtra
   62 
   63 unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> a -> m [b]
   64 unfoldrM f = go <=< f where
   65   go  Nothing       = pure []
   66   go (Just (b, a')) = (b : ) <$> (go <=< f) a'
   67 
   68 --unfoldr :: (a ->  Maybe (b, a)) -> a -> [b]
   69 --unfoldr f = runIdentity <$> unfoldrM (Identity <$> f)
   70 
   71 runParser :: Monad m => Parser a b m -> [a] -> m [b]
   72 runParser f = go where
   73   go [] = pure []
   74   go a  = (build <=< f) a where build (b, a') = (b : ) <$> go a'
   75 
   76 repeatedlyM :: Monad m => Parser a b m -> [a] -> m [b]
   77 repeatedlyM = runParser
   78 
   79 repeatedly :: ([a] -> (b, [a])) -> [a] -> [b]
   80 repeatedly f = runIdentity <$> repeatedlyM (Identity <$> f)
   81 
   82 -- | NonEmptyExtra
   83 
   84 many1' :: (Monad f, Alternative f) => f a -> f $ NonEmpty a
   85 many1' p = liftA2 (:|) p $ many p
   86 
   87 -- | Extra
   88 
   89 -- | `tee` is deprecated, use `<*>`
   90 tee :: (a -> b -> c) -> (a -> b) -> a -> c
   91 tee f1 f2 a = (f1 a <$> f2) a
   92 
   93 type Act s a = s -> Either s a
   94 type ActM m s a = s -> m (Either s a)
   95 type Parser a b m = [a] -> m (b, [a])