ghcup-hs/lib/GHCup/Prelude.hs
2020-02-18 22:37:03 +01:00

102 lines
2.7 KiB
Haskell

{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module GHCup.Prelude where
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class ( lift )
import Control.Exception.Safe
import qualified Data.Strict.Maybe as S
import Data.Monoid ( (<>) )
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
import Haskus.Utils.Variant.Excepts
import System.IO.Error
fS :: IsString a => String -> a
fS = fromString
fromStrictMaybe :: S.Maybe a -> Maybe a
fromStrictMaybe = S.maybe Nothing Just
fSM :: S.Maybe a -> Maybe a
fSM = fromStrictMaybe
toStrictMaybe :: Maybe a -> S.Maybe a
toStrictMaybe = maybe S.Nothing S.Just
tSM :: Maybe a -> S.Maybe a
tSM = toStrictMaybe
internalError :: String -> IO a
internalError = fail . ("Internal error: " <>)
iE :: String -> IO a
iE = internalError
-- | 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
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
whileM_ :: Monad m => m a -> (a -> m Bool) -> m ()
whileM_ ~action = void . whileM action
guardM :: (Monad m, Alternative m) => m Bool -> m ()
guardM ~f = guard =<< f
lBS2sT :: L.ByteString -> Text
lBS2sT = TL.toStrict . TLE.decodeUtf8
handleIO' :: IOErrorType -> (IOException -> IO ()) -> IO () -> IO ()
handleIO' err handler =
handleIO (\e -> if err == ioeGetErrorType e then handler e else ioError e)
(??) :: forall e es a m . (Monad m, e :< es) => Maybe a -> e -> Excepts es m a
(??) m e = maybe (throwE e) pure m
(!?) :: forall e es a m
. (Monad m, e :< es)
=> m (Maybe a)
-> e
-> Excepts es m a
(!?) em e = lift em >>= (?? e)
lE :: forall e es a m . (Monad m, e :< es) => Either e a -> Excepts es m a
lE = liftE . veitherToExcepts . fromEither
lEM :: forall e es a m . (Monad m, e :< es) => m (Either e a) -> Excepts es m a
lEM em = lift em >>= lE
fromEither :: Either a b -> VEither '[a] b
fromEither = either (VLeft . V) VRight