ghcup-hs/lib/GHCup/Prelude.hs

{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module GHCup.Prelude where

import           Control.Applicative
import           Control.Monad
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           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)

hideError :: IOErrorType -> IO () -> IO ()
hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e)