{-# 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) -- MORPHEUS 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"