ghcup-hs/lib/GHCup/Prelude.hs

89 lines
2.3 KiB
Haskell
Raw Normal View History

2020-01-14 21:55:34 +00:00
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module GHCup.Prelude where
import Control.Applicative
2020-01-16 22:27:38 +00:00
import Control.Monad
2020-01-14 21:55:34 +00:00
import Data.Strict.Maybe
import Data.Monoid ( (<>) )
import Prelude ( Monad
, Bool
, return
, (.)
)
import qualified Prelude as P
2020-01-16 22:27:38 +00:00
import Data.String
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.Text.Lazy as TL
import Data.Text ( Text )
import qualified Data.ByteString.Lazy as L
2020-01-14 21:55:34 +00:00
fS :: IsString a => P.String -> a
fS = fromString
fromStrictMaybe :: Maybe a -> P.Maybe a
fromStrictMaybe = maybe P.Nothing P.Just
2020-01-16 22:27:38 +00:00
fSM :: Maybe a -> P.Maybe a
fSM = fromStrictMaybe
2020-01-14 21:55:34 +00:00
toStrictMaybe :: P.Maybe a -> Maybe a
toStrictMaybe = P.maybe Nothing Just
2020-01-16 22:27:38 +00:00
tSM :: P.Maybe a -> Maybe a
tSM = toStrictMaybe
2020-01-14 21:55:34 +00:00
instance Applicative Maybe where
pure = Just
Just f <*> m = P.fmap f m
Nothing <*> _m = Nothing
liftA2 f (Just x) (Just y) = Just (f x y)
liftA2 _ _ _ = Nothing
Just _m1 *> m2 = m2
Nothing *> _m2 = Nothing
instance Alternative Maybe where
empty = Nothing
Nothing <|> r = r
l <|> _ = l
internalError :: P.String -> P.IO a
internalError = P.fail . ("Internal error: " <>)
-- | Like 'when', but where the test can be monadic.
whenM :: Monad m => m Bool -> m () -> m ()
whenM ~b ~t = ifM b t (return ())
-- | Like 'unless', but where the test can be monadic.
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM ~b ~f = ifM b (return ()) f
-- | Like @if@, but where the test can be monadic.
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM ~b ~t ~f = do
b' <- b
if b' then t else f
2020-01-16 22:27:38 +00:00
whileM :: Monad m => m a -> (a -> m Bool) -> m a
whileM ~action ~f = do
a <- action
b' <- f a
if b' then whileM action f else pure a
2020-01-14 21:55:34 +00:00
whileM_ :: Monad m => m a -> (a -> m Bool) -> m ()
2020-01-16 22:27:38 +00:00
whileM_ ~action = void . whileM action
guardM :: (Monad m, Alternative m) => m Bool -> m ()
guardM f = guard =<< f
2020-01-14 21:55:34 +00:00
2020-01-16 22:27:38 +00:00
lBS2sT :: L.ByteString -> Text
lBS2sT = TL.toStrict . TLE.decodeUtf8