{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.CodeGen.Printing.Render ( renderDocument, ) where import Data.ByteString.Lazy.Char8 (ByteString) import Data.Morpheus.CodeGen.Internal.AST ( ModuleDefinition (..), ServerTypeDefinition (..), ) import Data.Morpheus.CodeGen.Printing.Terms ( renderExtension, renderImport, ) import Data.Morpheus.CodeGen.Printing.Type ( renderTypes, ) import Data.Text ( pack, ) import qualified Data.Text.Lazy as LT ( fromStrict, ) import Data.Text.Lazy.Encoding (encodeUtf8) import Data.Text.Prettyprint.Doc ( (<+>), Doc, line, pretty, vsep, ) import Relude hiding (ByteString, encodeUtf8) renderDocument :: String -> [ServerTypeDefinition] -> ByteString renderDocument :: String -> [ServerTypeDefinition] -> ByteString renderDocument String moduleName [ServerTypeDefinition] types = Text -> ByteString encodeUtf8 (Text -> ByteString) -> Text -> ByteString forall a b. (a -> b) -> a -> b $ Text -> Text LT.fromStrict (Text -> Text) -> Text -> Text forall a b. (a -> b) -> a -> b $ String -> Text pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Doc Any -> String forall b a. (Show a, IsString b) => a -> b show (Doc Any -> String) -> Doc Any -> String forall a b. (a -> b) -> a -> b $ ModuleDefinition -> Doc Any forall n. ModuleDefinition -> Doc n renderModuleDefinition ModuleDefinition :: Text -> [(Text, [Text])] -> [Text] -> [ServerTypeDefinition] -> ModuleDefinition ModuleDefinition { moduleName :: Text moduleName = String -> Text pack String moduleName, imports :: [(Text, [Text])] imports = [ (Text "Data.Data", [Text "Typeable"]), (Text "Data.Morpheus.Kind", [Text "TYPE"]), (Text "Data.Morpheus.Types", []), (Text "Data.Text", [Text "Text"]), (Text "GHC.Generics", [Text "Generic"]), (Text "Data.Map", [Text "fromList", Text "empty"]) ], extensions :: [Text] extensions = [ Text "DeriveAnyClass", Text "DeriveGeneric", Text "TypeFamilies", Text "OverloadedStrings", Text "DataKinds", Text "DuplicateRecordFields" ], [ServerTypeDefinition] types :: [ServerTypeDefinition] types :: [ServerTypeDefinition] types } renderModuleDefinition :: ModuleDefinition -> Doc n renderModuleDefinition :: ModuleDefinition -> Doc n renderModuleDefinition ModuleDefinition { [Text] extensions :: [Text] extensions :: ModuleDefinition -> [Text] extensions, Text moduleName :: Text moduleName :: ModuleDefinition -> Text moduleName, [(Text, [Text])] imports :: [(Text, [Text])] imports :: ModuleDefinition -> [(Text, [Text])] imports, [ServerTypeDefinition] types :: [ServerTypeDefinition] types :: ModuleDefinition -> [ServerTypeDefinition] types } = [Doc n] -> Doc n forall ann. [Doc ann] -> Doc ann vsep ((Text -> Doc n) -> [Text] -> [Doc n] forall a b. (a -> b) -> [a] -> [b] map Text -> Doc n forall ann. Text -> Doc ann renderExtension [Text] extensions) Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> Doc n forall ann. Doc ann line Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> Doc n forall ann. Doc ann line Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> Doc n "module" Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> Text -> Doc n forall a ann. Pretty a => a -> Doc ann pretty Text moduleName Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc n "where" Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> Doc n forall ann. Doc ann line Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> Doc n forall ann. Doc ann line Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> [Doc n] -> Doc n forall ann. [Doc ann] -> Doc ann vsep (((Text, [Text]) -> Doc n) -> [(Text, [Text])] -> [Doc n] forall a b. (a -> b) -> [a] -> [b] map (Text, [Text]) -> Doc n forall ann. (Text, [Text]) -> Doc ann renderImport [(Text, [Text])] imports) Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> Doc n forall ann. Doc ann line Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> Doc n forall ann. Doc ann line Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> (Text -> Doc n) -> (Doc n -> Doc n) -> Either Text (Doc n) -> Doc n forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (Text -> Doc n forall a t. (HasCallStack, IsText t) => t -> a error (Text -> Doc n) -> (Text -> Text) -> Text -> Doc n forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Text forall b a. (Show a, IsString b) => a -> b show) Doc n -> Doc n forall a. a -> a id ([ServerTypeDefinition] -> Either Text (Doc n) forall ann. [ServerTypeDefinition] -> Either Text (Doc ann) renderTypes [ServerTypeDefinition] types)