{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Morpheus.Rendering.Haskell.Render
( renderHaskellDocument
) where
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Semigroup ((<>))
import Data.Text (Text, intercalate, pack)
import qualified Data.Text as T (concat)
import qualified Data.Text.Lazy as LT (fromStrict)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Morpheus.Rendering.Haskell.Terms (Context (..), renderExtension)
import Data.Morpheus.Rendering.Haskell.Types (renderType)
import Data.Morpheus.Rendering.Haskell.Values (Scope (..), renderResolver, renderRootResolver)
import Data.Morpheus.Types.Internal.Data (DataTypeLib (..), allDataTypes)
renderHaskellDocument :: String -> DataTypeLib -> ByteString
renderHaskellDocument modName lib =
encodeText $
renderLanguageExtensions context <> renderExports context <>
renderImports context <>
onSub renderApiEvents "" <>
renderRootResolver context lib <>
types
where
encodeText = encodeUtf8 . LT.fromStrict
onSub onS els =
case subscription lib of
Nothing -> els
_ -> onS
renderApiEvents =
"data Channel = Channel -- ChannelA | ChannelB" <> "\n\n" <>
"data Content = Content -- ContentA Int | ContentB String" <>
"\n\n"
types = intercalate "\n\n" $ map renderFullType (allDataTypes lib)
where
renderFullType x = renderType cont x <> "\n\n" <> renderResolver cont x
where
cont = context {scope = getScope $ fst x}
getScope "Mutation" = Mutation
getScope "Subscription" = Subscription
getScope _ = Query
context =
Context
{ moduleName = pack modName
, imports =
[ ("GHC.Generics", ["Generic"])
, ( "Data.Morpheus.Kind"
, ["SCALAR", "ENUM", "INPUT_OBJECT", "OBJECT", "UNION"])
, ( "Data.Morpheus.Types"
, [ "GQLRootResolver(..)"
, "toMutResolver"
, "IORes"
, "IOMutRes"
, "IOSubRes"
, "Event(..)"
, "SubRootRes"
, "GQLType(..)"
, "GQLScalar(..)"
, "ScalarValue(..)"
])
, ("Data.Text", ["Text"])
]
, extensions = ["OverloadedStrings", "DeriveGeneric", "TypeFamilies"]
, scope = Query
, pubSub = onSub ("Channel", "Content") ("()", "()")
}
renderLanguageExtensions :: Context -> Text
renderLanguageExtensions Context {extensions} =
T.concat (map renderExtension extensions) <> "\n"
renderExports :: Context -> Text
renderExports Context {moduleName} =
"-- generated by 'Morpheus' CLI\n" <> "module " <> moduleName <>
" (rootResolver) where\n\n"
renderImports :: Context -> Text
renderImports Context {imports} = T.concat (map renderImport imports) <> "\n"
where
renderImport (src, list) =
"import " <> src <> " (" <> intercalate ", " list <> ")\n"