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

module GHCup.Prelude where

import           Control.Applicative
import           Control.Monad
import           Data.Strict.Maybe
import           Data.Monoid                    ( (<>) )
import           Prelude                        ( Monad
                                                , Bool
                                                , return
                                                , (.)
                                                )
import qualified Prelude                       as P
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



fS :: IsString a => P.String -> a
fS = fromString

fromStrictMaybe :: Maybe a -> P.Maybe a
fromStrictMaybe = maybe P.Nothing P.Just

fSM :: Maybe a -> P.Maybe a
fSM = fromStrictMaybe

toStrictMaybe :: P.Maybe a -> Maybe a
toStrictMaybe = P.maybe Nothing Just

tSM :: P.Maybe a -> Maybe a
tSM = toStrictMaybe

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

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