{-# 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 Prettyprinter
  ( 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 forall a b. (a -> b) -> a -> b
$
    Text -> Text
LT.fromStrict forall a b. (a -> b) -> a -> b
$
      String -> Text
pack forall a b. (a -> b) -> a -> b
$
        forall b a. (Show a, IsString b) => a -> b
show forall a b. (a -> b) -> a -> b
$
          forall n. ModuleDefinition -> Doc n
renderModuleDefinition
            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.Morpheus", []),
                    (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 :: forall n. 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
    } =
    forall ann. [Doc ann] -> Doc ann
vsep (forall a b. (a -> b) -> [a] -> [b]
map forall ann. Text -> Doc ann
renderExtension [Text]
extensions)
      forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
      forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
      forall a. Semigroup a => a -> a -> a
<> Doc n
"module"
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Text
moduleName
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"where"
        forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
        forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
        forall a. Semigroup a => a -> a -> a
<> forall ann. [Doc ann] -> Doc ann
vsep (forall a b. (a -> b) -> [a] -> [b]
map forall ann. (Text, [Text]) -> Doc ann
renderImport [(Text, [Text])]
imports)
        forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
        forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line
        forall a. Semigroup a => a -> a -> a
<> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a t. (HasCallStack, IsText t) => t -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (Show a, IsString b) => a -> b
show) forall a. a -> a
id (forall ann. [ServerTypeDefinition] -> Either Text (Doc ann)
renderTypes [ServerTypeDefinition]
types)