{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.CodeGen.Printer ( HSDoc (..), Printer (..), apply, infix', print', unpack, wrapped, (.<>), optional, ignore, pack, ) where import Data.Morpheus.Types.Internal.AST ( DirectiveLocation, Name, TypeRef (..), TypeWrapper (..), packName, unpackName, ) import qualified Data.Text as T import qualified Language.Haskell.TH as TH import Prettyprinter (Doc, Pretty (..), list, pretty, tupled, (<+>)) import Relude hiding (optional, print, show) import Prelude (show) infix' :: HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n infix' :: forall n. HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n infix' HSDoc n a HSDoc n op HSDoc n b = Doc n -> HSDoc n forall n. Doc n -> HSDoc n pack (Doc n -> HSDoc n) -> Doc n -> HSDoc n forall a b. (a -> b) -> a -> b $ HSDoc n -> Doc n forall n. HSDoc n -> Doc n rawDocument HSDoc n a Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> HSDoc n -> Doc n forall n. HSDoc n -> Doc n rawDocument HSDoc n op Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> HSDoc n -> Doc n forall n. HSDoc n -> Doc n rawDocument HSDoc n b (.<>) :: HSDoc n -> HSDoc n -> HSDoc n .<> :: forall n. HSDoc n -> HSDoc n -> HSDoc n (.<>) HSDoc n a HSDoc n b = Bool -> Doc n -> HSDoc n forall n. Bool -> Doc n -> HSDoc n HSDoc Bool True (Doc n -> HSDoc n) -> Doc n -> HSDoc n forall a b. (a -> b) -> a -> b $ HSDoc n -> Doc n forall n. HSDoc n -> Doc n unpack HSDoc n a Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> HSDoc n -> Doc n forall n. HSDoc n -> Doc n unpack HSDoc n b apply :: Name t -> [HSDoc n] -> HSDoc n apply :: forall (t :: NAME) n. Name t -> [HSDoc n] -> HSDoc n apply Name t name [HSDoc n] xs = Bool -> Doc n -> HSDoc n forall n. Bool -> Doc n -> HSDoc n HSDoc Bool True ((Doc n -> HSDoc n -> Doc n) -> Doc n -> [HSDoc n] -> Doc n forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' (\Doc n b HSDoc n a -> Doc n b Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> HSDoc n -> Doc n forall n. HSDoc n -> Doc n unpack HSDoc n a) (Name t -> Doc n forall a n. Printer a => a -> Doc n print' Name t name) [HSDoc n] xs) renderMaybe :: Bool -> HSDoc n -> HSDoc n renderMaybe :: forall n. Bool -> HSDoc n -> HSDoc n renderMaybe Bool True = HSDoc n -> HSDoc n forall a. a -> a id renderMaybe Bool False = HSDoc n -> HSDoc n -> HSDoc n forall n. HSDoc n -> HSDoc n -> HSDoc n (.<>) HSDoc n "Maybe" renderList :: HSDoc n -> HSDoc n renderList :: forall n. HSDoc n -> HSDoc n renderList = Doc n -> HSDoc n forall n. Doc n -> HSDoc n pack (Doc n -> HSDoc n) -> (HSDoc n -> Doc n) -> HSDoc n -> HSDoc n forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc n] -> Doc n forall ann. [Doc ann] -> Doc ann list ([Doc n] -> Doc n) -> (HSDoc n -> [Doc n]) -> HSDoc n -> Doc n forall b c a. (b -> c) -> (a -> b) -> a -> c . Doc n -> [Doc n] forall a. a -> [a] forall (f :: * -> *) a. Applicative f => a -> f a pure (Doc n -> [Doc n]) -> (HSDoc n -> Doc n) -> HSDoc n -> [Doc n] forall b c a. (b -> c) -> (a -> b) -> a -> c . HSDoc n -> Doc n forall n. HSDoc n -> Doc n rawDocument print' :: Printer a => a -> Doc n print' :: forall a n. Printer a => a -> Doc n print' = HSDoc n -> Doc n forall n. HSDoc n -> Doc n unpack (HSDoc n -> Doc n) -> (a -> HSDoc n) -> a -> Doc n forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> HSDoc n forall ann. a -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print pack :: Doc n -> HSDoc n pack :: forall n. Doc n -> HSDoc n pack = Bool -> Doc n -> HSDoc n forall n. Bool -> Doc n -> HSDoc n HSDoc Bool False unpack :: HSDoc n -> Doc n unpack :: forall n. HSDoc n -> Doc n unpack HSDoc {Bool Doc n rawDocument :: forall n. HSDoc n -> Doc n isComplex :: Bool rawDocument :: Doc n isComplex :: forall n. HSDoc n -> Bool ..} = if Bool isComplex then [Doc n] -> Doc n forall ann. [Doc ann] -> Doc ann tupled [Doc n rawDocument] else Doc n rawDocument ignore :: HSDoc n -> Doc n ignore :: forall n. HSDoc n -> Doc n ignore HSDoc {Bool Doc n rawDocument :: forall n. HSDoc n -> Doc n isComplex :: forall n. HSDoc n -> Bool isComplex :: Bool rawDocument :: Doc n ..} = Doc n rawDocument data HSDoc n = HSDoc { forall n. HSDoc n -> Bool isComplex :: Bool, forall n. HSDoc n -> Doc n rawDocument :: Doc n } class Printer a where print :: a -> HSDoc ann instance IsString (HSDoc n) where fromString :: String -> HSDoc n fromString = Doc n -> HSDoc n forall n. Doc n -> HSDoc n pack (Doc n -> HSDoc n) -> (String -> Doc n) -> String -> HSDoc n forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Doc n forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty instance Printer TypeRef where print :: forall ann. TypeRef -> HSDoc ann print TypeRef {TypeName TypeWrapper typeConName :: TypeName typeWrappers :: TypeWrapper typeConName :: TypeRef -> TypeName typeWrappers :: TypeRef -> TypeWrapper ..} = TypeWrapper -> HSDoc ann -> HSDoc ann forall n. TypeWrapper -> HSDoc n -> HSDoc n wrapped TypeWrapper typeWrappers (TypeName -> HSDoc ann forall ann. TypeName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print TypeName typeConName) wrapped :: TypeWrapper -> HSDoc n -> HSDoc n wrapped :: forall n. TypeWrapper -> HSDoc n -> HSDoc n wrapped (TypeList TypeWrapper wrapper Bool notNull) = Bool -> HSDoc n -> HSDoc n forall n. Bool -> HSDoc n -> HSDoc n renderMaybe Bool notNull (HSDoc n -> HSDoc n) -> (HSDoc n -> HSDoc n) -> HSDoc n -> HSDoc n forall b c a. (b -> c) -> (a -> b) -> a -> c . HSDoc n -> HSDoc n forall n. HSDoc n -> HSDoc n renderList (HSDoc n -> HSDoc n) -> (HSDoc n -> HSDoc n) -> HSDoc n -> HSDoc n forall b c a. (b -> c) -> (a -> b) -> a -> c . TypeWrapper -> HSDoc n -> HSDoc n forall n. TypeWrapper -> HSDoc n -> HSDoc n wrapped TypeWrapper wrapper wrapped (BaseType Bool notNull) = Bool -> HSDoc n -> HSDoc n forall n. Bool -> HSDoc n -> HSDoc n renderMaybe Bool notNull instance Printer (Name t) where print :: forall ann. Name t -> HSDoc ann print = Doc ann -> HSDoc ann forall n. Doc n -> HSDoc n pack (Doc ann -> HSDoc ann) -> (Name t -> Doc ann) -> Name t -> HSDoc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (String -> Doc ann) -> (Name t -> String) -> Name t -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack (Text -> String) -> (Name t -> Text) -> Name t -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Name t -> Text forall a (t :: NAME). NamePacking a => Name t -> a forall (t :: NAME). Name t -> Text unpackName instance Printer Text where print :: forall ann. Text -> HSDoc ann print = Doc ann -> HSDoc ann forall n. Doc n -> HSDoc n pack (Doc ann -> HSDoc ann) -> (Text -> Doc ann) -> Text -> HSDoc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty instance Printer String where print :: forall n. String -> HSDoc n print = Doc ann -> HSDoc ann forall n. Doc n -> HSDoc n pack (Doc ann -> HSDoc ann) -> (String -> Doc ann) -> String -> HSDoc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty instance Printer DirectiveLocation where print :: forall ann. DirectiveLocation -> HSDoc ann print = String -> HSDoc ann forall a. IsString a => String -> a fromString (String -> HSDoc ann) -> (DirectiveLocation -> String) -> DirectiveLocation -> HSDoc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . DirectiveLocation -> String forall a. Show a => a -> String show instance Printer TH.Name where print :: forall ann. Name -> HSDoc ann print = Name Any -> HSDoc ann forall ann. Name Any -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print (Name Any -> HSDoc ann) -> (Name -> Name Any) -> Name -> HSDoc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Name -> Name Any forall a (t :: NAME). NamePacking a => a -> Name t forall (t :: NAME). Name -> Name t packName optional :: ([a] -> Doc n) -> [a] -> Doc n optional :: forall a n. ([a] -> Doc n) -> [a] -> Doc n optional [a] -> Doc n _ [] = Doc n "" optional [a] -> Doc n f [a] xs = Doc n " " Doc n -> Doc n -> Doc n forall a. Semigroup a => a -> a -> a <> [a] -> Doc n f [a] xs