{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.TH.Compile
  ( compileDocument,
    gqlDocument,
  )
where

--
--  Morpheus

import qualified Data.ByteString.Lazy.Char8 as LB
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Morpheus.CodeGen
  ( parseServerTypeDefinitions,
  )
import Data.Morpheus.CodeGen.Internal.AST
  ( CodeGenConfig (..),
  )
import Data.Morpheus.Server.TH.Declare
  ( runDeclare,
  )
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Relude hiding (ByteString)

gqlDocument :: QuasiQuoter
gqlDocument :: QuasiQuoter
gqlDocument = CodeGenConfig -> QuasiQuoter
mkQuasiQuoter CodeGenConfig :: Bool -> CodeGenConfig
CodeGenConfig {namespace :: Bool
namespace = Bool
False}

mkQuasiQuoter :: CodeGenConfig -> QuasiQuoter
mkQuasiQuoter :: CodeGenConfig -> QuasiQuoter
mkQuasiQuoter CodeGenConfig
ctx =
  QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = Text -> String -> Q Exp
forall a. Text -> a
notHandled Text
"Expressions",
      quotePat :: String -> Q Pat
quotePat = Text -> String -> Q Pat
forall a. Text -> a
notHandled Text
"Patterns",
      quoteType :: String -> Q Type
quoteType = Text -> String -> Q Type
forall a. Text -> a
notHandled Text
"Types",
      quoteDec :: String -> Q [Dec]
quoteDec = CodeGenConfig -> ByteString -> Q [Dec]
compileDocument CodeGenConfig
ctx (ByteString -> Q [Dec])
-> (String -> ByteString) -> String -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
LB.pack
    }
  where
    notHandled :: Text -> a
notHandled Text
things =
      Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
things Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" are not supported by the GraphQL QuasiQuoter"

compileDocument :: CodeGenConfig -> ByteString -> Q [Dec]
compileDocument :: CodeGenConfig -> ByteString -> Q [Dec]
compileDocument CodeGenConfig
ctx = CodeGenConfig -> ByteString -> Q [ServerTypeDefinition]
forall (m :: * -> *).
CodeGenMonad m =>
CodeGenConfig -> ByteString -> m [ServerTypeDefinition]
parseServerTypeDefinitions CodeGenConfig
ctx (ByteString -> Q [ServerTypeDefinition])
-> ([ServerTypeDefinition] -> Q [Dec]) -> ByteString -> Q [Dec]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CodeGenConfig -> [ServerTypeDefinition] -> Q [Dec]
forall a. Declare a => CodeGenConfig -> a -> Q [Dec]
runDeclare CodeGenConfig
ctx