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