{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.CodeGen.Internal.AST ( CodeGenConstructor (..), CodeGenField (..), CodeGenType (..), CodeGenTypeName (..), DerivingClass (..), FIELD_TYPE_WRAPPER (..), TypeValue (..), fromTypeName, getFullName, ModuleDefinition (..), TypeClassInstance (..), AssociatedType (..), MethodArgument (..), printTHName, PrintableValue (..), ) where import qualified Data.HashMap.Lazy as HM import Data.Morpheus.CodeGen.Internal.Name (camelCaseTypeName) import Data.Morpheus.CodeGen.Printer import Data.Morpheus.Types.Internal.AST ( DirectiveLocation, FieldName, TypeName, TypeRef, TypeWrapper, unpackName, ) import qualified Data.Set as S import qualified Data.Text as T import Language.Haskell.TH.Syntax (Lift) import qualified Language.Haskell.TH.Syntax as TH import Prettyprinter ( Doc, Pretty (..), comma, enclose, hsep, indent, line, list, nest, pretty, punctuate, space, tupled, vsep, (<+>), ) import Relude hiding (Show, optional, print, show) import Prelude (Show (..)) data DerivingClass = SHOW | GENERIC | CLASS_EQ deriving (Int -> DerivingClass -> ShowS [DerivingClass] -> ShowS DerivingClass -> String (Int -> DerivingClass -> ShowS) -> (DerivingClass -> String) -> ([DerivingClass] -> ShowS) -> Show DerivingClass forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> DerivingClass -> ShowS showsPrec :: Int -> DerivingClass -> ShowS $cshow :: DerivingClass -> String show :: DerivingClass -> String $cshowList :: [DerivingClass] -> ShowS showList :: [DerivingClass] -> ShowS Show) instance Pretty DerivingClass where pretty :: forall ann. DerivingClass -> Doc ann pretty DerivingClass SHOW = Doc ann "Show" pretty DerivingClass GENERIC = Doc ann "Generic" pretty DerivingClass CLASS_EQ = Doc ann "Eq" data TypeValue = TypeValueObject TypeName [(FieldName, TypeValue)] | TypeValueNumber Double | TypeValueString Text | TypeValueBool Bool | TypeValueList [TypeValue] | TypedValueMaybe (Maybe TypeValue) | PrintableTypeValue PrintableValue deriving (Int -> TypeValue -> ShowS [TypeValue] -> ShowS TypeValue -> String (Int -> TypeValue -> ShowS) -> (TypeValue -> String) -> ([TypeValue] -> ShowS) -> Show TypeValue forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> TypeValue -> ShowS showsPrec :: Int -> TypeValue -> ShowS $cshow :: TypeValue -> String show :: TypeValue -> String $cshowList :: [TypeValue] -> ShowS showList :: [TypeValue] -> ShowS Show) renderField :: (FieldName, TypeValue) -> Doc n renderField :: forall n. (FieldName, TypeValue) -> Doc n renderField (FieldName fName, TypeValue fValue) = Text -> Doc n forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (FieldName -> Text forall a (t :: NAME). NamePacking a => Name t -> a forall (t :: NAME). Name t -> Text unpackName FieldName fName :: Text) Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc n "=" Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> TypeValue -> Doc n forall a ann. Pretty a => a -> Doc ann forall ann. TypeValue -> Doc ann pretty TypeValue fValue instance Pretty TypeValue where pretty :: forall ann. TypeValue -> Doc ann pretty (TypeValueObject TypeName name [(FieldName, TypeValue)] xs) = Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (TypeName -> Text forall a (t :: NAME). NamePacking a => Name t -> a forall (t :: NAME). Name t -> Text unpackName TypeName name :: Text) Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann "{" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep (Doc ann -> [Doc ann] -> [Doc ann] forall ann. Doc ann -> [Doc ann] -> [Doc ann] punctuate Doc ann "," (((FieldName, TypeValue) -> Doc ann) -> [(FieldName, TypeValue)] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map (FieldName, TypeValue) -> Doc ann forall n. (FieldName, TypeValue) -> Doc n renderField [(FieldName, TypeValue)] xs)) Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann "}" pretty (TypeValueNumber Double x) = Double -> Doc ann forall ann. Double -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Double x pretty (TypeValueString Text x) = String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (Text -> String forall a. Show a => a -> String show Text x :: String) pretty (TypeValueBool Bool x) = Bool -> Doc ann forall ann. Bool -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Bool x pretty (TypedValueMaybe (Just TypeValue x)) = Doc ann "Just" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> TypeValue -> Doc ann forall a ann. Pretty a => a -> Doc ann forall ann. TypeValue -> Doc ann pretty TypeValue x pretty (TypedValueMaybe Maybe TypeValue Nothing) = Doc ann "Nothing" pretty (TypeValueList [TypeValue] xs) = [TypeValue] -> Doc ann forall ann. [TypeValue] -> Doc ann forall a ann. Pretty a => [a] -> Doc ann prettyList [TypeValue] xs pretty (PrintableTypeValue PrintableValue x) = PrintableValue -> Doc ann forall a ann. Pretty a => a -> Doc ann forall ann. PrintableValue -> Doc ann pretty PrintableValue x data CodeGenType = CodeGenType { CodeGenType -> CodeGenTypeName cgTypeName :: CodeGenTypeName, CodeGenType -> [CodeGenConstructor] cgConstructors :: [CodeGenConstructor], CodeGenType -> [DerivingClass] cgDerivations :: [DerivingClass] } deriving (Int -> CodeGenType -> ShowS [CodeGenType] -> ShowS CodeGenType -> String (Int -> CodeGenType -> ShowS) -> (CodeGenType -> String) -> ([CodeGenType] -> ShowS) -> Show CodeGenType forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CodeGenType -> ShowS showsPrec :: Int -> CodeGenType -> ShowS $cshow :: CodeGenType -> String show :: CodeGenType -> String $cshowList :: [CodeGenType] -> ShowS showList :: [CodeGenType] -> ShowS Show) isNewType :: CodeGenType -> Bool isNewType :: CodeGenType -> Bool isNewType CodeGenType {cgConstructors :: CodeGenType -> [CodeGenConstructor] cgConstructors = [CodeGenConstructor {constructorFields :: CodeGenConstructor -> [CodeGenField] constructorFields = [CodeGenField _]}]} = Bool True isNewType CodeGenType _ = Bool False instance Pretty CodeGenType where pretty :: forall ann. CodeGenType -> Doc ann pretty t :: CodeGenType t@CodeGenType {[CodeGenConstructor] [DerivingClass] CodeGenTypeName cgTypeName :: CodeGenType -> CodeGenTypeName cgConstructors :: CodeGenType -> [CodeGenConstructor] cgDerivations :: CodeGenType -> [DerivingClass] cgTypeName :: CodeGenTypeName cgConstructors :: [CodeGenConstructor] cgDerivations :: [DerivingClass] ..} = (if CodeGenType -> Bool isNewType CodeGenType t then Doc ann "newtype" else Doc ann "data") Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> HSDoc ann -> Doc ann forall n. HSDoc n -> Doc n ignore (CodeGenTypeName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann forall ann. CodeGenTypeName -> HSDoc ann print CodeGenTypeName cgTypeName) Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> [CodeGenConstructor] -> Doc ann forall {a} {ann}. Printer a => [a] -> Doc ann renderConstructors [CodeGenConstructor] cgConstructors Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann indent Int 2 ([DerivingClass] -> Doc ann forall ann. [DerivingClass] -> Doc ann renderDeriving [DerivingClass] cgDerivations) Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line where renderConstructors :: [a] -> Doc ann renderConstructors [a cons] = (Doc ann " =" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+>) (Doc ann -> Doc ann) -> Doc ann -> Doc ann forall a b. (a -> b) -> a -> b $ a -> Doc ann forall a n. Printer a => a -> Doc n print' a cons renderConstructors [a] conses = Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc ann -> Doc ann) -> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . (Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <>) (Doc ann -> Doc ann) -> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep ([Doc ann] -> Doc ann) -> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc ann] -> [Doc ann] forall {ann}. [Doc ann] -> [Doc ann] prefixVariants ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall a b. (a -> b) -> a -> b $ (a -> Doc ann) -> [a] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map a -> Doc ann forall a n. Printer a => a -> Doc n print' [a] conses prefixVariants :: [Doc ann] -> [Doc ann] prefixVariants (Doc ann x : [Doc ann] xs) = Doc ann "=" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann x Doc ann -> [Doc ann] -> [Doc ann] forall a. a -> [a] -> [a] : (Doc ann -> Doc ann) -> [Doc ann] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map (Doc ann "|" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+>) [Doc ann] xs prefixVariants [] = [] renderDeriving :: [DerivingClass] -> Doc n renderDeriving :: forall ann. [DerivingClass] -> Doc ann renderDeriving = (Doc n "deriving" Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+>) (Doc n -> Doc n) -> ([DerivingClass] -> Doc n) -> [DerivingClass] -> Doc n forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc n] -> Doc n forall ann. [Doc ann] -> Doc ann tupled ([Doc n] -> Doc n) -> ([DerivingClass] -> [Doc n]) -> [DerivingClass] -> Doc n forall b c a. (b -> c) -> (a -> b) -> a -> c . (DerivingClass -> Doc n) -> [DerivingClass] -> [Doc n] forall a b. (a -> b) -> [a] -> [b] map DerivingClass -> Doc n forall a ann. Pretty a => a -> Doc ann forall ann. DerivingClass -> Doc ann pretty data CodeGenConstructor = CodeGenConstructor { CodeGenConstructor -> CodeGenTypeName constructorName :: CodeGenTypeName, CodeGenConstructor -> [CodeGenField] constructorFields :: [CodeGenField] } deriving (Int -> CodeGenConstructor -> ShowS [CodeGenConstructor] -> ShowS CodeGenConstructor -> String (Int -> CodeGenConstructor -> ShowS) -> (CodeGenConstructor -> String) -> ([CodeGenConstructor] -> ShowS) -> Show CodeGenConstructor forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CodeGenConstructor -> ShowS showsPrec :: Int -> CodeGenConstructor -> ShowS $cshow :: CodeGenConstructor -> String show :: CodeGenConstructor -> String $cshowList :: [CodeGenConstructor] -> ShowS showList :: [CodeGenConstructor] -> ShowS Show) instance Printer CodeGenConstructor where print :: forall ann. CodeGenConstructor -> HSDoc ann print CodeGenConstructor {constructorFields :: CodeGenConstructor -> [CodeGenField] constructorFields = [CodeGenField {fieldName :: CodeGenField -> FieldName fieldName = FieldName "_", Bool [FIELD_TYPE_WRAPPER] TypeName fieldType :: TypeName wrappers :: [FIELD_TYPE_WRAPPER] fieldIsNullable :: Bool fieldType :: CodeGenField -> TypeName wrappers :: CodeGenField -> [FIELD_TYPE_WRAPPER] fieldIsNullable :: CodeGenField -> Bool ..}], CodeGenTypeName constructorName :: CodeGenConstructor -> CodeGenTypeName constructorName :: CodeGenTypeName ..} = Doc ann -> HSDoc ann forall n. Doc n -> HSDoc n pack (CodeGenTypeName -> Doc ann forall a n. Printer a => a -> Doc n print' CodeGenTypeName constructorName Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> HSDoc ann -> Doc ann forall n. HSDoc n -> Doc n unpack ((FIELD_TYPE_WRAPPER -> HSDoc ann -> HSDoc ann) -> HSDoc ann -> [FIELD_TYPE_WRAPPER] -> HSDoc ann forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr FIELD_TYPE_WRAPPER -> HSDoc ann -> HSDoc ann forall n. FIELD_TYPE_WRAPPER -> HSDoc n -> HSDoc n renderWrapper (TypeName -> HSDoc ann forall ann. TypeName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print TypeName fieldType) [FIELD_TYPE_WRAPPER] wrappers)) print CodeGenConstructor {constructorFields :: CodeGenConstructor -> [CodeGenField] constructorFields = [], CodeGenTypeName constructorName :: CodeGenConstructor -> CodeGenTypeName constructorName :: CodeGenTypeName ..} = CodeGenTypeName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann forall ann. CodeGenTypeName -> HSDoc ann print CodeGenTypeName constructorName print CodeGenConstructor {[CodeGenField] CodeGenTypeName constructorFields :: CodeGenConstructor -> [CodeGenField] constructorName :: CodeGenConstructor -> CodeGenTypeName constructorName :: CodeGenTypeName constructorFields :: [CodeGenField] ..} = do let fields :: [Doc ann] fields = (CodeGenField -> Doc ann) -> [CodeGenField] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map (HSDoc ann -> Doc ann forall n. HSDoc n -> Doc n unpack (HSDoc ann -> Doc ann) -> (CodeGenField -> HSDoc ann) -> CodeGenField -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . CodeGenField -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann forall ann. CodeGenField -> HSDoc ann print) [CodeGenField] constructorFields Doc ann -> HSDoc ann forall n. Doc n -> HSDoc n pack (CodeGenTypeName -> Doc ann forall a n. Printer a => a -> Doc n print' CodeGenTypeName constructorName Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann renderSet [Doc ann] fields) where renderSet :: [Doc ann] -> Doc ann renderSet = Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc ann -> Doc ann) -> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Doc ann -> Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann -> Doc ann enclose Doc ann "\n{ " Doc ann "\n}" (Doc ann -> Doc ann) -> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann nest Int 2 (Doc ann -> Doc ann) -> ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep ([Doc ann] -> Doc ann) -> ([Doc ann] -> [Doc ann]) -> [Doc ann] -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Doc ann -> [Doc ann] -> [Doc ann] forall ann. Doc ann -> [Doc ann] -> [Doc ann] punctuate Doc ann forall ann. Doc ann comma data CodeGenField = CodeGenField { CodeGenField -> FieldName fieldName :: FieldName, CodeGenField -> TypeName fieldType :: TypeName, CodeGenField -> [FIELD_TYPE_WRAPPER] wrappers :: [FIELD_TYPE_WRAPPER], CodeGenField -> Bool fieldIsNullable :: Bool } deriving (Int -> CodeGenField -> ShowS [CodeGenField] -> ShowS CodeGenField -> String (Int -> CodeGenField -> ShowS) -> (CodeGenField -> String) -> ([CodeGenField] -> ShowS) -> Show CodeGenField forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CodeGenField -> ShowS showsPrec :: Int -> CodeGenField -> ShowS $cshow :: CodeGenField -> String show :: CodeGenField -> String $cshowList :: [CodeGenField] -> ShowS showList :: [CodeGenField] -> ShowS Show) instance Printer CodeGenField where print :: forall ann. CodeGenField -> HSDoc ann print CodeGenField {Bool [FIELD_TYPE_WRAPPER] TypeName FieldName fieldName :: CodeGenField -> FieldName fieldType :: CodeGenField -> TypeName wrappers :: CodeGenField -> [FIELD_TYPE_WRAPPER] fieldIsNullable :: CodeGenField -> Bool fieldName :: FieldName fieldType :: TypeName wrappers :: [FIELD_TYPE_WRAPPER] fieldIsNullable :: Bool ..} = HSDoc ann -> HSDoc ann -> HSDoc ann -> HSDoc ann forall n. HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n infix' (FieldName -> HSDoc ann forall ann. FieldName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print FieldName fieldName) HSDoc ann "::" ((FIELD_TYPE_WRAPPER -> HSDoc ann -> HSDoc ann) -> HSDoc ann -> [FIELD_TYPE_WRAPPER] -> HSDoc ann forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr FIELD_TYPE_WRAPPER -> HSDoc ann -> HSDoc ann forall n. FIELD_TYPE_WRAPPER -> HSDoc n -> HSDoc n renderWrapper (TypeName -> HSDoc ann forall ann. TypeName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print TypeName fieldType) [FIELD_TYPE_WRAPPER] wrappers) data FIELD_TYPE_WRAPPER = MONAD | SUBSCRIPTION TH.Name | PARAMETRIZED | ARG TypeName | TAGGED_ARG TH.Name FieldName TypeRef | GQL_WRAPPER TypeWrapper deriving (Int -> FIELD_TYPE_WRAPPER -> ShowS [FIELD_TYPE_WRAPPER] -> ShowS FIELD_TYPE_WRAPPER -> String (Int -> FIELD_TYPE_WRAPPER -> ShowS) -> (FIELD_TYPE_WRAPPER -> String) -> ([FIELD_TYPE_WRAPPER] -> ShowS) -> Show FIELD_TYPE_WRAPPER forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> FIELD_TYPE_WRAPPER -> ShowS showsPrec :: Int -> FIELD_TYPE_WRAPPER -> ShowS $cshow :: FIELD_TYPE_WRAPPER -> String show :: FIELD_TYPE_WRAPPER -> String $cshowList :: [FIELD_TYPE_WRAPPER] -> ShowS showList :: [FIELD_TYPE_WRAPPER] -> ShowS Show) renderWrapper :: FIELD_TYPE_WRAPPER -> HSDoc n -> HSDoc n renderWrapper :: forall n. FIELD_TYPE_WRAPPER -> HSDoc n -> HSDoc n renderWrapper FIELD_TYPE_WRAPPER PARAMETRIZED = (HSDoc n -> HSDoc n -> HSDoc n forall n. HSDoc n -> HSDoc n -> HSDoc n .<> HSDoc n "m") renderWrapper FIELD_TYPE_WRAPPER MONAD = (HSDoc n "m" HSDoc n -> HSDoc n -> HSDoc n forall n. HSDoc n -> HSDoc n -> HSDoc n .<>) renderWrapper SUBSCRIPTION {} = HSDoc n -> HSDoc n forall a. a -> a id renderWrapper (GQL_WRAPPER TypeWrapper typeWrappers) = TypeWrapper -> HSDoc n -> HSDoc n forall n. TypeWrapper -> HSDoc n -> HSDoc n wrapped TypeWrapper typeWrappers renderWrapper (ARG TypeName name) = HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n forall n. HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n infix' (TypeName -> HSDoc n forall ann. TypeName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print TypeName name) HSDoc n "->" renderWrapper (TAGGED_ARG Name _ FieldName name TypeRef typeRef) = HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n forall n. HSDoc n -> HSDoc n -> HSDoc n -> HSDoc n infix' (Name Any -> [HSDoc n] -> HSDoc n forall (t :: NAME) n. Name t -> [HSDoc n] -> HSDoc n apply Name Any "Arg" [String -> HSDoc n forall ann. String -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print (FieldName -> String forall a. Show a => a -> String show FieldName name :: String), TypeRef -> HSDoc n forall ann. TypeRef -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print TypeRef typeRef]) HSDoc n "->" data CodeGenTypeName = CodeGenTypeName { CodeGenTypeName -> [FieldName] namespace :: [FieldName], CodeGenTypeName -> [Text] typeParameters :: [Text], CodeGenTypeName -> TypeName typename :: TypeName } deriving (Int -> CodeGenTypeName -> ShowS [CodeGenTypeName] -> ShowS CodeGenTypeName -> String (Int -> CodeGenTypeName -> ShowS) -> (CodeGenTypeName -> String) -> ([CodeGenTypeName] -> ShowS) -> Show CodeGenTypeName forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> CodeGenTypeName -> ShowS showsPrec :: Int -> CodeGenTypeName -> ShowS $cshow :: CodeGenTypeName -> String show :: CodeGenTypeName -> String $cshowList :: [CodeGenTypeName] -> ShowS showList :: [CodeGenTypeName] -> ShowS Show) getFullName :: CodeGenTypeName -> TypeName getFullName :: CodeGenTypeName -> TypeName getFullName CodeGenTypeName {[Text] [FieldName] TypeName namespace :: CodeGenTypeName -> [FieldName] typeParameters :: CodeGenTypeName -> [Text] typename :: CodeGenTypeName -> TypeName namespace :: [FieldName] typeParameters :: [Text] typename :: TypeName ..} = [FieldName] -> TypeName -> TypeName forall (t :: NAME). [Name t] -> TypeName -> TypeName camelCaseTypeName [FieldName] namespace TypeName typename fromTypeName :: TypeName -> CodeGenTypeName fromTypeName :: TypeName -> CodeGenTypeName fromTypeName = [FieldName] -> [Text] -> TypeName -> CodeGenTypeName CodeGenTypeName [] [] instance Printer CodeGenTypeName where print :: forall ann. CodeGenTypeName -> HSDoc ann print CodeGenTypeName cgName = Bool -> Doc ann -> HSDoc ann forall n. Bool -> Doc n -> HSDoc n HSDoc (Bool -> Bool not (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ [Text] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (CodeGenTypeName -> [Text] typeParameters CodeGenTypeName cgName)) (Doc ann -> HSDoc ann) -> Doc ann -> HSDoc ann forall a b. (a -> b) -> a -> b $ Text -> [Text] -> Doc ann forall ann. Text -> [Text] -> Doc ann parametrizedType (TypeName -> Text forall a (t :: NAME). NamePacking a => Name t -> a forall (t :: NAME). Name t -> Text unpackName (CodeGenTypeName -> TypeName getFullName CodeGenTypeName cgName)) (CodeGenTypeName -> [Text] typeParameters CodeGenTypeName cgName) parametrizedType :: Text -> [Text] -> Doc ann parametrizedType :: forall ann. Text -> [Text] -> Doc ann parametrizedType Text tName [Text] typeParameters = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall a b. (a -> b) -> a -> b $ (Text -> Doc ann) -> [Text] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty ([Text] -> [Doc ann]) -> [Text] -> [Doc ann] forall a b. (a -> b) -> a -> b $ Text tName Text -> [Text] -> [Text] forall a. a -> [a] -> [a] : [Text] typeParameters data ModuleDefinition dec = ModuleDefinition { forall dec. ModuleDefinition dec -> Text moduleName :: Text, forall dec. ModuleDefinition dec -> [(Text, [Text])] imports :: [(Text, [Text])], forall dec. ModuleDefinition dec -> [Text] extensions :: [Text], forall dec. ModuleDefinition dec -> [dec] types :: [dec] } instance Pretty dec => Pretty (ModuleDefinition dec) where pretty :: forall ann. ModuleDefinition dec -> Doc ann pretty ModuleDefinition {[dec] [(Text, [Text])] [Text] Text moduleName :: forall dec. ModuleDefinition dec -> Text imports :: forall dec. ModuleDefinition dec -> [(Text, [Text])] extensions :: forall dec. ModuleDefinition dec -> [Text] types :: forall dec. ModuleDefinition dec -> [dec] moduleName :: Text imports :: [(Text, [Text])] extensions :: [Text] types :: [dec] ..} = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep ((Text -> Doc ann) -> [Text] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map Text -> Doc ann forall ann. Text -> Doc ann renderExtension ([Text] -> [Text] forall a. Ord a => [a] -> [a] sort [Text] extensions)) Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann "module" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Text moduleName Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann "where" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep (((Text, [Text]) -> Doc ann) -> [(Text, [Text])] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map (Text, [Text]) -> Doc ann forall ann. (Text, [Text]) -> Doc ann renderImport ([(Text, [Text])] -> [Doc ann]) -> [(Text, [Text])] -> [Doc ann] forall a b. (a -> b) -> a -> b $ [(Text, [Text])] -> [(Text, [Text])] organizeImports [(Text, [Text])] imports) Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep ((Doc ann -> Bool) -> [Doc ann] -> [Doc ann] forall a. (a -> Bool) -> [a] -> [a] filter Doc ann -> Bool forall a. Doc a -> Bool notEmpty ([Doc ann] -> [Doc ann]) -> [Doc ann] -> [Doc ann] forall a b. (a -> b) -> a -> b $ (dec -> Doc ann) -> [dec] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map dec -> Doc ann forall ann. dec -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty [dec] types) notEmpty :: Doc a -> Bool notEmpty :: forall a. Doc a -> Bool notEmpty Doc a x = Bool -> Bool not (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ String -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null (Doc a -> String forall a. Show a => a -> String show Doc a x :: String) renderExtension :: Text -> Doc ann renderExtension :: forall ann. Text -> Doc ann renderExtension Text txt | Text -> Text -> Bool T.isPrefixOf Text "{-#" Text txt = Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Text txt | Bool otherwise = Doc ann "{-#" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann "LANGUAGE" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Text txt Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann "#-}" organizeImports :: [(Text, [Text])] -> [(Text, [Text])] organizeImports :: [(Text, [Text])] -> [(Text, [Text])] organizeImports [(Text, [Text])] xs = ((Text, [Text]) -> Text) -> [(Text, [Text])] -> [(Text, [Text])] forall b a. Ord b => (a -> b) -> [a] -> [a] sortWith (Text, [Text]) -> Text forall a b. (a, b) -> a fst ([(Text, [Text])] -> [(Text, [Text])]) -> [(Text, [Text])] -> [(Text, [Text])] forall a b. (a -> b) -> a -> b $ HashMap Text [Text] -> [(Text, [Text])] forall k v. HashMap k v -> [(k, v)] HM.toList (HashMap Text [Text] -> [(Text, [Text])]) -> HashMap Text [Text] -> [(Text, [Text])] forall a b. (a -> b) -> a -> b $ (Set Text -> [Text]) -> HashMap Text (Set Text) -> HashMap Text [Text] forall a b. (a -> b) -> HashMap Text a -> HashMap Text b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ([Text] -> [Text] forall a. Ord a => [a] -> [a] sort ([Text] -> [Text]) -> (Set Text -> [Text]) -> Set Text -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . Set Text -> [Text] forall a. Set a -> [a] forall (t :: * -> *) a. Foldable t => t a -> [a] toList) ([(Text, [Text])] -> HashMap Text (Set Text) groupImports [(Text, [Text])] xs) groupImports :: [(Text, [Text])] -> HashMap Text (Set Text) groupImports :: [(Text, [Text])] -> HashMap Text (Set Text) groupImports = ((Text, [Text]) -> HashMap Text (Set Text) -> HashMap Text (Set Text)) -> HashMap Text (Set Text) -> [(Text, [Text])] -> HashMap Text (Set Text) forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (Text, [Text]) -> HashMap Text (Set Text) -> HashMap Text (Set Text) insertImport HashMap Text (Set Text) forall a. Monoid a => a mempty insertImport :: (Text, [Text]) -> HashMap Text (Set Text) -> HashMap Text (Set Text) insertImport :: (Text, [Text]) -> HashMap Text (Set Text) -> HashMap Text (Set Text) insertImport (Text moduleName, [Text] names) = (Maybe (Set Text) -> Maybe (Set Text)) -> Text -> HashMap Text (Set Text) -> HashMap Text (Set Text) forall k v. (Eq k, Hashable k) => (Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v HM.alter Maybe (Set Text) -> Maybe (Set Text) f Text moduleName where f :: Maybe (Set Text) -> Maybe (Set Text) f Maybe (Set Text) x = Set Text -> Maybe (Set Text) forall a. a -> Maybe a Just ([Text] -> Set Text forall a. Ord a => [a] -> Set a S.fromList [Text] names Set Text -> Set Text -> Set Text forall a. Semigroup a => a -> a -> a <> Set Text -> Maybe (Set Text) -> Set Text forall a. a -> Maybe a -> a fromMaybe Set Text forall a. Monoid a => a mempty Maybe (Set Text) x) renderImport :: (Text, [Text]) -> Doc ann renderImport :: forall ann. (Text, [Text]) -> Doc ann renderImport (Text src, [Text] ls) = Doc ann "import" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty Text src Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> [Text] -> Doc ann forall ann. [Text] -> Doc ann renderImportList [Text] ls renderImportList :: [Text] -> Doc ann renderImportList :: forall ann. [Text] -> Doc ann renderImportList [Text "*"] = Doc ann "" renderImportList [Text] xs = Doc ann forall ann. Doc ann space Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann tupled ((Text -> Doc ann) -> [Text] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map Text -> Doc ann forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty [Text] xs) data TypeClassInstance body = TypeClassInstance { forall body. TypeClassInstance body -> Name typeClassName :: TH.Name, forall body. TypeClassInstance body -> [(Name, Name)] typeClassContext :: [(TH.Name, TH.Name)], forall body. TypeClassInstance body -> CodeGenTypeName typeClassTarget :: CodeGenTypeName, forall body. TypeClassInstance body -> [(Name, AssociatedType)] assoc :: [(TH.Name, AssociatedType)], forall body. TypeClassInstance body -> [(Name, MethodArgument, body)] typeClassMethods :: [(TH.Name, MethodArgument, body)] } deriving (Int -> TypeClassInstance body -> ShowS [TypeClassInstance body] -> ShowS TypeClassInstance body -> String (Int -> TypeClassInstance body -> ShowS) -> (TypeClassInstance body -> String) -> ([TypeClassInstance body] -> ShowS) -> Show (TypeClassInstance body) forall body. Show body => Int -> TypeClassInstance body -> ShowS forall body. Show body => [TypeClassInstance body] -> ShowS forall body. Show body => TypeClassInstance body -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: forall body. Show body => Int -> TypeClassInstance body -> ShowS showsPrec :: Int -> TypeClassInstance body -> ShowS $cshow :: forall body. Show body => TypeClassInstance body -> String show :: TypeClassInstance body -> String $cshowList :: forall body. Show body => [TypeClassInstance body] -> ShowS showList :: [TypeClassInstance body] -> ShowS Show) instance Pretty a => Pretty (TypeClassInstance a) where pretty :: forall ann. TypeClassInstance a -> Doc ann pretty TypeClassInstance {[(Name, Name)] [(Name, AssociatedType)] [(Name, MethodArgument, a)] Name CodeGenTypeName typeClassName :: forall body. TypeClassInstance body -> Name typeClassContext :: forall body. TypeClassInstance body -> [(Name, Name)] typeClassTarget :: forall body. TypeClassInstance body -> CodeGenTypeName assoc :: forall body. TypeClassInstance body -> [(Name, AssociatedType)] typeClassMethods :: forall body. TypeClassInstance body -> [(Name, MethodArgument, body)] typeClassName :: Name typeClassContext :: [(Name, Name)] typeClassTarget :: CodeGenTypeName assoc :: [(Name, AssociatedType)] typeClassMethods :: [(Name, MethodArgument, a)] ..} = Doc ann "instance" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> ([Text] -> Doc ann) -> [Text] -> Doc ann forall a n. ([a] -> Doc n) -> [a] -> Doc n optional [Text] -> Doc ann forall ann. [Text] -> Doc ann renderTypeableConstraints (CodeGenTypeName -> [Text] typeParameters CodeGenTypeName typeClassTarget) Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Name -> Doc ann forall ann. Name -> Doc ann printTHName Name typeClassName Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann typeHead Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann "where" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Int -> Doc ann -> Doc ann forall ann. Int -> Doc ann -> Doc ann indent Int 2 ([Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann vsep (((Name, AssociatedType) -> Doc ann) -> [(Name, AssociatedType)] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map (Name, AssociatedType) -> Doc ann renderAssoc [(Name, AssociatedType)] assoc [Doc ann] -> [Doc ann] -> [Doc ann] forall a. Semigroup a => a -> a -> a <> ((Name, MethodArgument, a) -> Doc ann) -> [(Name, MethodArgument, a)] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map (Name, MethodArgument, a) -> Doc ann forall {a} {a} {ann}. (Pretty a, Pretty a) => (Name, a, a) -> Doc ann renderMethodD [(Name, MethodArgument, a)] typeClassMethods)) Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann forall ann. Doc ann line where typeHead :: Doc ann typeHead = HSDoc ann -> Doc ann forall n. HSDoc n -> Doc n unpack (CodeGenTypeName -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann forall ann. CodeGenTypeName -> HSDoc ann print CodeGenTypeName typeClassTarget) renderAssoc :: (Name, AssociatedType) -> Doc ann renderAssoc (Name name, AssociatedType a) = Doc ann "type" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Name -> Doc ann forall ann. Name -> Doc ann printTHName Name name Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann typeHead Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc ann "=" Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> AssociatedType -> Doc ann forall a ann. Pretty a => a -> Doc ann forall ann. AssociatedType -> Doc ann pretty AssociatedType a renderMethodD :: (Name, a, a) -> Doc ann renderMethodD (Name name, a args, a method) = Name -> Doc ann forall ann. Name -> Doc ann printTHName Name name Doc ann -> Doc ann -> Doc ann forall ann. Doc ann -> Doc ann -> Doc ann <+> a -> Doc ann forall ann. a -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty a args Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann "=" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> a -> Doc ann forall ann. a -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty a method renderTypeableConstraints :: [Text] -> Doc n renderTypeableConstraints :: forall ann. [Text] -> Doc ann renderTypeableConstraints [Text] xs = [Doc n] -> Doc n forall ann. [Doc ann] -> Doc ann tupled ((Text -> Doc n) -> [Text] -> [Doc n] forall a b. (a -> b) -> [a] -> [b] map ((Doc n "Typeable" Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+>) (Doc n -> Doc n) -> (Text -> Doc n) -> Text -> Doc n forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Doc n forall ann. Text -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty) [Text] xs) Doc n -> Doc n -> Doc n forall ann. Doc ann -> Doc ann -> Doc ann <+> Doc n "=>" data AssociatedType = AssociatedTypeName TH.Name | AssociatedLocations [DirectiveLocation] deriving (Int -> AssociatedType -> ShowS [AssociatedType] -> ShowS AssociatedType -> String (Int -> AssociatedType -> ShowS) -> (AssociatedType -> String) -> ([AssociatedType] -> ShowS) -> Show AssociatedType forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> AssociatedType -> ShowS showsPrec :: Int -> AssociatedType -> ShowS $cshow :: AssociatedType -> String show :: AssociatedType -> String $cshowList :: [AssociatedType] -> ShowS showList :: [AssociatedType] -> ShowS Show) printTHName :: TH.Name -> Doc ann printTHName :: forall ann. Name -> Doc ann printTHName = HSDoc ann -> Doc ann forall n. HSDoc n -> Doc n ignore (HSDoc ann -> Doc ann) -> (Name -> HSDoc ann) -> Name -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . Name -> HSDoc ann forall ann. Name -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print printPromotedLocation :: DirectiveLocation -> Doc ann printPromotedLocation :: forall ann. DirectiveLocation -> Doc ann printPromotedLocation = (Doc ann "'" Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <>) (Doc ann -> Doc ann) -> (DirectiveLocation -> Doc ann) -> DirectiveLocation -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . HSDoc ann -> Doc ann forall n. HSDoc n -> Doc n ignore (HSDoc ann -> Doc ann) -> (DirectiveLocation -> HSDoc ann) -> DirectiveLocation -> Doc ann forall b c a. (b -> c) -> (a -> b) -> a -> c . DirectiveLocation -> HSDoc ann forall ann. DirectiveLocation -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print instance Pretty AssociatedType where pretty :: forall ann. AssociatedType -> Doc ann pretty (AssociatedTypeName Name x) = Name -> Doc ann forall ann. Name -> Doc ann printTHName Name x pretty (AssociatedLocations [DirectiveLocation] x) = [Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann list ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall a b. (a -> b) -> a -> b $ (DirectiveLocation -> Doc ann) -> [DirectiveLocation] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map DirectiveLocation -> Doc ann forall ann. DirectiveLocation -> Doc ann printPromotedLocation [DirectiveLocation] x data MethodArgument = NoArgument | ProxyArgument | DestructArgument TH.Name [TH.Name] deriving (Int -> MethodArgument -> ShowS [MethodArgument] -> ShowS MethodArgument -> String (Int -> MethodArgument -> ShowS) -> (MethodArgument -> String) -> ([MethodArgument] -> ShowS) -> Show MethodArgument forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> MethodArgument -> ShowS showsPrec :: Int -> MethodArgument -> ShowS $cshow :: MethodArgument -> String show :: MethodArgument -> String $cshowList :: [MethodArgument] -> ShowS showList :: [MethodArgument] -> ShowS Show) instance Pretty MethodArgument where pretty :: forall ann. MethodArgument -> Doc ann pretty MethodArgument NoArgument = Doc ann "" pretty MethodArgument ProxyArgument = Doc ann "_ " pretty (DestructArgument Name x [Name] xs) = HSDoc ann -> Doc ann forall n. HSDoc n -> Doc n unpack (Name -> HSDoc ann forall ann. Name -> HSDoc ann forall a ann. Printer a => a -> HSDoc ann print Name x HSDoc ann -> HSDoc ann -> HSDoc ann forall n. HSDoc n -> HSDoc n -> HSDoc n .<> Doc ann -> HSDoc ann forall n. Doc n -> HSDoc n pack ([Doc ann] -> Doc ann forall ann. [Doc ann] -> Doc ann hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann forall a b. (a -> b) -> a -> b $ (Name -> Doc ann) -> [Name] -> [Doc ann] forall a b. (a -> b) -> [a] -> [b] map Name -> Doc ann forall ann. Name -> Doc ann printTHName [Name] xs)) Doc ann -> Doc ann -> Doc ann forall a. Semigroup a => a -> a -> a <> Doc ann " " data PrintableValue where PrintableValue :: forall a. (Show a, Lift a) => a -> PrintableValue instance Show PrintableValue where show :: PrintableValue -> String show (PrintableValue a a) = a -> String forall a. Show a => a -> String show a a instance Pretty PrintableValue where pretty :: forall ann. PrintableValue -> Doc ann pretty (PrintableValue a x) = String -> Doc ann forall ann. String -> Doc ann forall a ann. Pretty a => a -> Doc ann pretty (a -> String forall a. Show a => a -> String show a x)