{-# 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 = forall n. Doc n -> HSDoc n pack forall a b. (a -> b) -> a -> b $ forall n. HSDoc n -> Doc n rawDocument HSDoc n a forall ann. Doc ann -> Doc ann -> Doc ann <+> forall n. HSDoc n -> Doc n rawDocument HSDoc n op forall ann. Doc ann -> Doc ann -> Doc ann <+> 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 = forall n. Bool -> Doc n -> HSDoc n HSDoc Bool True forall a b. (a -> b) -> a -> b $ forall n. HSDoc n -> Doc n unpack HSDoc n a forall ann. Doc ann -> Doc ann -> Doc ann <+> 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 = forall n. Bool -> Doc n -> HSDoc n HSDoc Bool True (forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' (\Doc n b HSDoc n a -> Doc n b forall ann. Doc ann -> Doc ann -> Doc ann <+> forall n. HSDoc n -> Doc n unpack HSDoc n a) (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 = forall a. a -> a id renderMaybe Bool False = forall n. HSDoc n -> HSDoc n -> HSDoc n (.<>) HSDoc n "Maybe" renderList :: HSDoc n -> HSDoc n renderList :: forall n. HSDoc n -> HSDoc n renderList = forall n. Doc n -> HSDoc n pack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall ann. [Doc ann] -> Doc ann list forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall n. HSDoc n -> Doc n rawDocument print' :: Printer a => a -> Doc n print' :: forall a n. Printer a => a -> Doc n print' = forall n. HSDoc n -> Doc n unpack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a ann. Printer a => a -> HSDoc ann print pack :: Doc n -> HSDoc n pack :: forall n. Doc n -> HSDoc n pack = 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 isComplex :: forall n. HSDoc n -> Bool rawDocument :: Doc n isComplex :: Bool rawDocument :: forall n. HSDoc n -> Doc n ..} = if Bool isComplex then 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 :: Doc n isComplex :: Bool isComplex :: forall n. HSDoc n -> Bool rawDocument :: forall n. HSDoc n -> 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 = forall n. Doc n -> HSDoc n pack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a ann. Pretty a => a -> Doc ann pretty instance Printer TypeRef where print :: forall ann. TypeRef -> HSDoc ann print TypeRef {TypeWrapper TypeName typeConName :: TypeRef -> TypeName typeWrappers :: TypeRef -> TypeWrapper typeWrappers :: TypeWrapper typeConName :: TypeName ..} = forall n. TypeWrapper -> HSDoc n -> HSDoc n wrapped TypeWrapper typeWrappers (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) = forall n. Bool -> HSDoc n -> HSDoc n renderMaybe Bool notNull forall b c a. (b -> c) -> (a -> b) -> a -> c . forall n. HSDoc n -> HSDoc n renderList forall b c a. (b -> c) -> (a -> b) -> a -> c . forall n. TypeWrapper -> HSDoc n -> HSDoc n wrapped TypeWrapper wrapper wrapped (BaseType Bool notNull) = forall n. Bool -> HSDoc n -> HSDoc n renderMaybe Bool notNull instance Printer (Name t) where print :: forall ann. Name t -> HSDoc ann print = forall n. Doc n -> HSDoc n pack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a ann. Pretty a => a -> Doc ann pretty forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> String T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a (t :: NAME). NamePacking a => Name t -> a unpackName instance Printer Text where print :: forall ann. Text -> HSDoc ann print = forall n. Doc n -> HSDoc n pack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a ann. Pretty a => a -> Doc ann pretty instance Printer String where print :: forall n. String -> HSDoc n print = forall n. Doc n -> HSDoc n pack forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a ann. Pretty a => a -> Doc ann pretty instance Printer DirectiveLocation where print :: forall ann. DirectiveLocation -> HSDoc ann print = forall a. IsString a => String -> a fromString forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Show a => a -> String show instance Printer TH.Name where print :: forall ann. Name -> HSDoc ann print = forall a ann. Printer a => a -> HSDoc ann print forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a (t :: NAME). NamePacking a => a -> 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 " " forall a. Semigroup a => a -> a -> a <> [a] -> Doc n f [a] xs