{-# 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
Eq Flag =>
(Flag -> Flag -> Ordering)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Bool)
-> (Flag -> Flag -> Flag)
-> (Flag -> Flag -> Flag)
-> Ord 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
$ccompare :: Flag -> Flag -> Ordering
compare :: Flag -> Flag -> Ordering
$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
>= :: Flag -> Flag -> Bool
$cmax :: Flag -> Flag -> Flag
max :: Flag -> Flag -> Flag
$cmin :: Flag -> Flag -> Flag
min :: Flag -> Flag -> Flag
Ord, Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
/= :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flag -> ShowS
showsPrec :: Int -> Flag -> ShowS
$cshow :: Flag -> String
show :: Flag -> String
$cshowList :: [Flag] -> ShowS
showList :: [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 -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b)
-> (forall a b. a -> CodeGenT ctx m b -> CodeGenT ctx m a)
-> Functor (CodeGenT ctx m)
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
$cfmap :: forall ctx (m :: * -> *) a b.
Functor m =>
(a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
fmap :: forall a b. (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
$c<$ :: forall ctx (m :: * -> *) a b.
Functor m =>
a -> CodeGenT ctx m b -> CodeGenT ctx m a
<$ :: forall a b. a -> CodeGenT ctx m b -> CodeGenT ctx m a
Functor,
      Functor (CodeGenT ctx m)
Functor (CodeGenT ctx m) =>
(forall a. a -> CodeGenT ctx m a)
-> (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 a b.
    CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b)
-> (forall a b.
    CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m a)
-> Applicative (CodeGenT ctx m)
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
$cpure :: forall ctx (m :: * -> *) a. Monad m => a -> CodeGenT ctx m a
pure :: forall a. a -> CodeGenT ctx m a
$c<*> :: forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
<*> :: forall a b.
CodeGenT ctx m (a -> b) -> CodeGenT ctx m a -> CodeGenT ctx m b
$cliftA2 :: forall ctx (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m c
liftA2 :: forall a b c.
(a -> b -> c)
-> CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m c
$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 -> 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 a
<* :: forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m a
Applicative,
      Applicative (CodeGenT ctx m)
Applicative (CodeGenT ctx m) =>
(forall a b.
 CodeGenT ctx m a -> (a -> CodeGenT ctx m b) -> CodeGenT ctx m b)
-> (forall a b.
    CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b)
-> (forall a. a -> CodeGenT ctx m a)
-> Monad (CodeGenT ctx m)
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
$c>>= :: forall ctx (m :: * -> *) a b.
Monad m =>
CodeGenT ctx m a -> (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 -> CodeGenT ctx m b -> CodeGenT ctx m b
>> :: forall a b.
CodeGenT ctx m a -> CodeGenT ctx m b -> CodeGenT ctx m b
$creturn :: forall ctx (m :: * -> *) a. Monad m => a -> CodeGenT ctx m a
return :: forall a. a -> CodeGenT ctx m a
Monad,
      Monad (CodeGenT ctx m)
Monad (CodeGenT ctx m) =>
(forall a. String -> CodeGenT ctx m a)
-> MonadFail (CodeGenT ctx m)
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
$cfail :: forall ctx (m :: * -> *) a.
MonadFail m =>
String -> CodeGenT ctx m a
fail :: forall a. 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 = ReaderT ctx (StateT [Flag] m) a -> CodeGenT ctx m a
forall ctx (m :: * -> *) a.
ReaderT ctx (StateT [Flag] m) a -> CodeGenT ctx m a
CodeGenT (ReaderT ctx (StateT [Flag] m) a -> CodeGenT ctx m a)
-> (m a -> ReaderT ctx (StateT [Flag] m) a)
-> m a
-> CodeGenT ctx m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Flag] m a -> ReaderT ctx (StateT [Flag] m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT ctx m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT [Flag] m a -> ReaderT ctx (StateT [Flag] m) a)
-> (m a -> StateT [Flag] m a)
-> m a
-> ReaderT ctx (StateT [Flag] m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT [Flag] m a
forall (m :: * -> *) a. Monad m => m a -> StateT [Flag] m a
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 = StateT [Flag] m a -> [Flag] -> m (a, [Flag])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT ctx (StateT [Flag] m) a -> ctx -> StateT [Flag] m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ctx (StateT [Flag] m) a
m ctx
ctx) [Flag]
forall a. Monoid a => a
mempty

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

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