{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}

module Data.Morpheus.CodeGen.Internal.Flags
  ( Flags,
    Flag (..),
    runCodeGenT,
    CodeGenT,
    langExtension,
    requireExternal,
  )
where

import Control.Monad.Except
import Data.Morpheus.Types.Internal.AST (GQLError)
import Data.Text
import Relude hiding (ByteString, get)

type Flags = [Flag]

data Flag
  = FlagLanguageExtension Text
  | FlagExternal Text
  deriving (Eq Flag
Flag -> Flag -> Bool
Flag -> Flag -> Ordering
Flag -> Flag -> Flag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Flag -> Flag -> Flag
$cmin :: Flag -> Flag -> Flag
max :: Flag -> Flag -> Flag
$cmax :: Flag -> Flag -> Flag
>= :: Flag -> Flag -> Bool
$c>= :: Flag -> Flag -> Bool
> :: Flag -> Flag -> Bool
$c> :: Flag -> Flag -> Bool
<= :: Flag -> Flag -> Bool
$c<= :: Flag -> Flag -> Bool
< :: Flag -> Flag -> Bool
$c< :: Flag -> Flag -> Bool
compare :: Flag -> Flag -> Ordering
$ccompare :: Flag -> Flag -> Ordering
Ord, Flag -> Flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show)

newtype CodeGenT ctx (m :: Type -> Type) a = CodeGenT
  { forall ctx (m :: * -> *) a.
CodeGenT ctx m a -> ReaderT ctx (StateT [Flag] m) a
_runCodeGenT :: ReaderT ctx (StateT Flags m) a
  }
  deriving newtype
    ( forall a b. a -> CodeGenT ctx m b -> CodeGenT ctx m a
forall a b. (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
forall ctx (m :: * -> *) a b.
Functor m =>
a -> CodeGenT ctx m b -> CodeGenT ctx m a
forall ctx (m :: * -> *) a b.
Functor m =>
(a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CodeGenT ctx m b -> CodeGenT ctx m a
$c<$ :: forall ctx (m :: * -> *) a b.
Functor m =>
a -> CodeGenT ctx m b -> CodeGenT ctx m a
fmap :: forall a b. (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
$cfmap :: forall ctx (m :: * -> *) a b.
Functor m =>
(a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
Functor,
      forall a. a -> CodeGenT ctx m a
forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m a
forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
forall a b.
CodeGenT ctx m (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
forall a b c.
(a -> b -> c)
-> CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m c
forall {ctx} {m :: * -> *}. Monad m => Functor (CodeGenT ctx m)
forall ctx (m :: * -> *) a. Monad m => a -> CodeGenT ctx m a
forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m a
forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
forall ctx (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m a
$c<* :: forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m a
*> :: forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
$c*> :: forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
liftA2 :: forall a b c.
(a -> b -> c)
-> CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m c
$cliftA2 :: forall ctx (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m c
<*> :: forall a b.
CodeGenT ctx m (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
$c<*> :: forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
pure :: forall a. a -> CodeGenT ctx m a
$cpure :: forall ctx (m :: * -> *) a. Monad m => a -> CodeGenT ctx m a
Applicative,
      forall a. a -> CodeGenT ctx m a
forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
forall a b.
CodeGenT ctx m a -> (a -> CodeGenT ctx m b) -> CodeGenT ctx m b
forall ctx (m :: * -> *). Monad m => Applicative (CodeGenT ctx m)
forall ctx (m :: * -> *) a. Monad m => a -> CodeGenT ctx m a
forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> (a -> CodeGenT ctx m b) -> CodeGenT ctx m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> CodeGenT ctx m a
$creturn :: forall ctx (m :: * -> *) a. Monad m => a -> CodeGenT ctx m a
>> :: forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
$c>> :: forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
>>= :: forall a b.
CodeGenT ctx m a -> (a -> CodeGenT ctx m b) -> CodeGenT ctx m b
$c>>= :: forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> (a -> CodeGenT ctx m b) -> CodeGenT ctx m b
Monad,
      forall a. String -> CodeGenT ctx m a
forall {ctx} {m :: * -> *}. MonadFail m => Monad (CodeGenT ctx m)
forall ctx (m :: * -> *) a.
MonadFail m =>
String -> CodeGenT ctx m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> CodeGenT ctx m a
$cfail :: forall ctx (m :: * -> *) a.
MonadFail m =>
String -> CodeGenT ctx m a
MonadFail,
      MonadReader ctx,
      MonadState
        Flags
    )

deriving instance MonadError GQLError m => MonadError GQLError (CodeGenT ctx m)

instance MonadTrans (CodeGenT ctx) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> CodeGenT ctx m a
lift = forall ctx (m :: * -> *) a.
ReaderT ctx (StateT [Flag] m) a -> CodeGenT ctx m a
CodeGenT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runCodeGenT :: Monad m => CodeGenT ctx m a -> ctx -> m (a, Flags)
runCodeGenT :: forall (m :: * -> *) ctx a.
Monad m =>
CodeGenT ctx m a -> ctx -> m (a, [Flag])
runCodeGenT (CodeGenT ReaderT ctx (StateT [Flag] m) a
m) ctx
ctx = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ctx (StateT [Flag] m) a
m ctx
ctx) forall a. Monoid a => a
mempty

langExtension :: MonadState Flags m => Text -> m ()
langExtension :: forall (m :: * -> *). MonadState [Flag] m => Text -> m ()
langExtension Text
ext = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Flag
FlagLanguageExtension Text
ext forall a. a -> [a] -> [a]
:)

requireExternal :: MonadState Flags m => Text -> m ()
requireExternal :: forall (m :: * -> *). MonadState [Flag] m => Text -> m ()
requireExternal Text
ext = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> Flag
FlagExternal Text
ext forall a. a -> [a] -> [a]
:)