{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}

module GHCup.Prelude where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans.Class      ( lift )
import           Control.Exception.Safe
import           Data.ByteString                ( ByteString )
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.Text                     as T
import           Data.Versions
import qualified Data.ByteString.Lazy          as L
import           Haskus.Utils.Variant.Excepts
import           System.IO.Error
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax     ( Exp(..)
                                                , Lift
                                                )
import qualified Language.Haskell.TH.Syntax    as TH
import           Language.Haskell.TH.Quote      ( QuasiQuoter(..) )
import           GHC.Base



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


showT :: Show a => a -> Text
showT = fS . show

-- | 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

hideExcept :: forall e es es' a m
            . (Monad m, e :< es, LiftVariant (Remove e es) es')
           => e
           -> a
           -> Excepts es m a
           -> Excepts es' m a
hideExcept h a action =
  catchLiftLeft ((\(x@e) -> pure a) :: (e -> Excepts es' m a)) action



deriving instance Lift Versioning
deriving instance Lift Version
deriving instance Lift SemVer
deriving instance Lift Mess
deriving instance Lift PVP
deriving instance Lift (NonEmpty Word)
deriving instance Lift VSep
deriving instance Lift VUnit
instance Lift Text

qq :: (Text -> Q Exp) -> QuasiQuoter
qq quoteExp' = QuasiQuoter
  { quoteExp  = (\s -> quoteExp' . T.pack $ s)
  , quotePat  = \_ ->
    fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
  , quoteType = \_ ->
    fail "illegal QuasiQuote (allowed as expression only, used as a type)"
  , quoteDec  = \_ -> fail
    "illegal QuasiQuote (allowed as expression only, used as a declaration)"
  }

ver :: QuasiQuoter
ver = qq mkV
 where
  mkV :: Text -> Q Exp
  mkV = either (fail . show) TH.lift . version

mver :: QuasiQuoter
mver = qq mkV
 where
  mkV :: Text -> Q Exp
  mkV = either (fail . show) TH.lift . mess

sver :: QuasiQuoter
sver = qq mkV
 where
  mkV :: Text -> Q Exp
  mkV = either (fail . show) TH.lift . semver

vers :: QuasiQuoter
vers = qq mkV
 where
  mkV :: Text -> Q Exp
  mkV = either (fail . show) TH.lift . versioning

pver :: QuasiQuoter
pver = qq mkV
 where
  mkV :: Text -> Q Exp
  mkV = either (fail . show) TH.lift . pvp