module Curry.Syntax.ShowModule (showModule) where
import Curry.Base.Ident
import Curry.Base.Position
import Curry.Syntax.Type
showModule :: Show a => Module a -> String
showModule m = showsModule m "\n"
showsModule :: Show a => Module a -> ShowS
showsModule (Module ps mident espec imps decls)
= showsString "Module "
. showsList (\p -> showsPragma p . newline) ps . space
. showsModuleIdent mident . newline
. showsMaybe showsExportSpec espec . newline
. showsList (\i -> showsImportDecl i . newline) imps
. showsList (\d -> showsDecl d . newline) decls
showsPragma :: ModulePragma -> ShowS
showsPragma (LanguagePragma pos exts)
= showsString "(LanguagePragma "
. showsPosition pos . space
. showsList showsExtension exts
. showsString ")"
showsPragma (OptionsPragma pos mbTool args)
= showsString "(OptionsPragma "
. showsPosition pos . space
. showsMaybe shows mbTool
. shows args
. showsString ")"
showsExtension :: Extension -> ShowS
showsExtension (KnownExtension p e)
= showsString "(KnownExtension "
. showsPosition p . space
. shows e
. showString ")"
showsExtension (UnknownExtension p s)
= showsString "(UnknownExtension "
. showsPosition p . space
. shows s
. showString ")"
showsExportSpec :: ExportSpec -> ShowS
showsExportSpec (Exporting pos exports)
= showsString "(Exporting "
. showsPosition pos . space
. showsList showsExport exports
. showsString ")"
showsExport :: Export -> ShowS
showsExport (Export qident)
= showsString "(Export "
. showsQualIdent qident
. showsString ")"
showsExport (ExportTypeWith qident ids)
= showsString "(ExportTypeWith "
. showsQualIdent qident . space
. showsList showsIdent ids
. showsString ")"
showsExport (ExportTypeAll qident)
= showsString "(ExportTypeAll "
. showsQualIdent qident
. showsString ")"
showsExport (ExportModule m)
= showsString "(ExportModule "
. showsModuleIdent m
. showsString ")"
showsImportDecl :: ImportDecl -> ShowS
showsImportDecl (ImportDecl pos mident quali mmident mimpspec)
= showsString "(ImportDecl "
. showsPosition pos . space
. showsModuleIdent mident . space
. shows quali . space
. showsMaybe showsModuleIdent mmident . space
. showsMaybe showsImportSpec mimpspec
. showsString ")"
showsImportSpec :: ImportSpec -> ShowS
showsImportSpec (Importing pos imports)
= showsString "(Importing "
. showsPosition pos . space
. showsList showsImport imports
. showsString ")"
showsImportSpec (Hiding pos imports)
= showsString "(Hiding "
. showsPosition pos . space
. showsList showsImport imports
. showsString ")"
showsImport :: Import -> ShowS
showsImport (Import ident)
= showsString "(Import "
. showsIdent ident
. showsString ")"
showsImport (ImportTypeWith ident idents)
= showsString "(ImportTypeWith "
. showsIdent ident . space
. showsList showsIdent idents
. showsString ")"
showsImport (ImportTypeAll ident)
= showsString "(ImportTypeAll "
. showsIdent ident
. showsString ")"
showsDecl :: Show a => Decl a -> ShowS
showsDecl (InfixDecl pos infx prec idents)
= showsString "(InfixDecl "
. showsPosition pos . space
. shows infx . space
. showsMaybe shows prec . space
. showsList showsIdent idents
. showsString ")"
showsDecl (DataDecl pos ident idents consdecls classes)
= showsString "(DataDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsList showsIdent idents . space
. showsList showsConsDecl consdecls . space
. showsList showsQualIdent classes
. showsString ")"
showsDecl (ExternalDataDecl pos ident idents)
= showsString "(ExternalDataDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsList showsIdent idents
. showsString ")"
showsDecl (NewtypeDecl pos ident idents newconsdecl classes)
= showsString "(NewtypeDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsList showsIdent idents . space
. showsNewConsDecl newconsdecl . space
. showsList showsQualIdent classes
. showsString ")"
showsDecl (TypeDecl pos ident idents typ)
= showsString "(TypeDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsList showsIdent idents . space
. showsTypeExpr typ
. showsString ")"
showsDecl (TypeSig pos idents qtype)
= showsString "(TypeSig "
. showsPosition pos . space
. showsList showsIdent idents . space
. showsQualTypeExpr qtype
. showsString ")"
showsDecl (FunctionDecl pos a ident eqs)
= showsString "(FunctionDecl "
. showsPosition pos . space
. showsPrec 11 a . space
. showsIdent ident . space
. showsList showsEquation eqs
. showsString ")"
showsDecl (ExternalDecl pos vars)
= showsString "(ExternalDecl "
. showsPosition pos . space
. showsList showsVar vars
. showsString ")"
showsDecl (PatternDecl pos cons rhs)
= showsString "(PatternDecl "
. showsPosition pos . space
. showsConsTerm cons . space
. showsRhs rhs
. showsString ")"
showsDecl (FreeDecl pos vars)
= showsString "(FreeDecl "
. showsPosition pos . space
. showsList showsVar vars
. showsString ")"
showsDecl (DefaultDecl pos types)
= showsString "(DefaultDecl "
. showsPosition pos . space
. showsList showsTypeExpr types
. showsString ")"
showsDecl (ClassDecl pos context cls clsvar decls)
= showsString "(ClassDecl "
. showsPosition pos . space
. showsContext context . space
. showsIdent cls . space
. showsIdent clsvar . space
. showsList showsDecl decls
. showsString ")"
showsDecl (InstanceDecl pos context qcls inst decls)
= showsString "(InstanceDecl "
. showsPosition pos . space
. showsContext context . space
. showsQualIdent qcls . space
. showsInstanceType inst . space
. showsList showsDecl decls
. showsString ")"
showsContext :: Context -> ShowS
showsContext constraints
= showsList showsConstraint constraints
showsConstraint :: Constraint -> ShowS
showsConstraint (Constraint qcls ty)
= showsString "(Constraint "
. showsQualIdent qcls . space
. showsTypeExpr ty
. showsString ")"
showsInstanceType :: InstanceType -> ShowS
showsInstanceType = showsTypeExpr
showsConsDecl :: ConstrDecl -> ShowS
showsConsDecl (ConstrDecl pos idents context ident types)
= showsString "(ConstrDecl "
. showsPosition pos . space
. showsList showsIdent idents . space
. showsContext context . space
. showsIdent ident . space
. showsList showsTypeExpr types
. showsString ")"
showsConsDecl (ConOpDecl pos idents context ty1 ident ty2)
= showsString "(ConOpDecl "
. showsPosition pos . space
. showsList showsIdent idents . space
. showsContext context . space
. showsTypeExpr ty1 . space
. showsIdent ident . space
. showsTypeExpr ty2
. showsString ")"
showsConsDecl (RecordDecl pos idents context ident fs)
= showsString "(RecordDecl "
. showsPosition pos . space
. showsList showsIdent idents . space
. showsContext context . space
. showsIdent ident . space
. showsList showsFieldDecl fs
. showsString ")"
showsFieldDecl :: FieldDecl -> ShowS
showsFieldDecl (FieldDecl pos labels ty)
= showsString "(FieldDecl "
. showsPosition pos . space
. showsList showsIdent labels . space
. showsTypeExpr ty
. showsString ")"
showsNewConsDecl :: NewConstrDecl -> ShowS
showsNewConsDecl (NewConstrDecl pos ident typ)
= showsString "(NewConstrDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsTypeExpr typ
. showsString ")"
showsNewConsDecl (NewRecordDecl pos ident fld)
= showsString "(NewRecordDecl "
. showsPosition pos . space
. showsIdent ident . space
. showsPair showsIdent showsTypeExpr fld
. showsString ")"
showsQualTypeExpr :: QualTypeExpr -> ShowS
showsQualTypeExpr (QualTypeExpr context typ)
= showsString "(QualTypeExpr "
. showsContext context . space
. showsTypeExpr typ
. showsString ")"
showsTypeExpr :: TypeExpr -> ShowS
showsTypeExpr (ConstructorType qident)
= showsString "(ConstructorType "
. showsQualIdent qident . space
. showsString ")"
showsTypeExpr (ApplyType type1 type2)
= showsString "(ApplyType "
. showsTypeExpr type1 . space
. showsTypeExpr type2 . space
. showsString ")"
showsTypeExpr (VariableType ident)
= showsString "(VariableType "
. showsIdent ident
. showsString ")"
showsTypeExpr (TupleType types)
= showsString "(TupleType "
. showsList showsTypeExpr types
. showsString ")"
showsTypeExpr (ListType typ)
= showsString "(ListType "
. showsTypeExpr typ
. showsString ")"
showsTypeExpr (ArrowType dom ran)
= showsString "(ArrowType "
. showsTypeExpr dom . space
. showsTypeExpr ran
. showsString ")"
showsTypeExpr (ParenType ty)
= showsString "(ParenType "
. showsTypeExpr ty
. showsString ")"
showsTypeExpr (ForallType vars ty)
= showsString "(ForallType "
. showsList showsIdent vars
. showsTypeExpr ty
. showsString ")"
showsEquation :: Show a => Equation a -> ShowS
showsEquation (Equation pos lhs rhs)
= showsString "(Equation "
. showsPosition pos . space
. showsLhs lhs . space
. showsRhs rhs
. showsString ")"
showsLhs :: Show a => Lhs a -> ShowS
showsLhs (FunLhs ident conss)
= showsString "(FunLhs "
. showsIdent ident . space
. showsList showsConsTerm conss
. showsString ")"
showsLhs (OpLhs cons1 ident cons2)
= showsString "(OpLhs "
. showsConsTerm cons1 . space
. showsIdent ident . space
. showsConsTerm cons2
. showsString ")"
showsLhs (ApLhs lhs conss)
= showsString "(ApLhs "
. showsLhs lhs . space
. showsList showsConsTerm conss
. showsString ")"
showsRhs :: Show a => Rhs a -> ShowS
showsRhs (SimpleRhs pos expr decls)
= showsString "(SimpleRhs "
. showsPosition pos . space
. showsExpression expr . space
. showsList showsDecl decls
. showsString ")"
showsRhs (GuardedRhs cexps decls)
= showsString "(GuardedRhs "
. showsList showsCondExpr cexps . space
. showsList showsDecl decls
. showsString ")"
showsCondExpr :: Show a => CondExpr a -> ShowS
showsCondExpr (CondExpr pos exp1 exp2)
= showsString "(CondExpr "
. showsPosition pos . space
. showsExpression exp1 . space
. showsExpression exp2
. showsString ")"
showsLiteral :: Literal -> ShowS
showsLiteral (Char c)
= showsString "(Char "
. shows c
. showsString ")"
showsLiteral (Int n)
= showsString "(Int "
. shows n
. showsString ")"
showsLiteral (Float x)
= showsString "(Float "
. shows x
. showsString ")"
showsLiteral (String s)
= showsString "(String "
. shows s
. showsString ")"
showsConsTerm :: Show a => Pattern a -> ShowS
showsConsTerm (LiteralPattern a lit)
= showsString "(LiteralPattern "
. showsPrec 11 a . space
. showsLiteral lit
. showsString ")"
showsConsTerm (NegativePattern a lit)
= showsString "(NegativePattern "
. showsPrec 11 a . space
. showsLiteral lit
. showsString ")"
showsConsTerm (VariablePattern a ident)
= showsString "(VariablePattern "
. showsPrec 11 a . space
. showsIdent ident
. showsString ")"
showsConsTerm (ConstructorPattern a qident conss)
= showsString "(ConstructorPattern "
. showsPrec 11 a . space
. showsQualIdent qident . space
. showsList showsConsTerm conss
. showsString ")"
showsConsTerm (InfixPattern a cons1 qident cons2)
= showsString "(InfixPattern "
. showsPrec 11 a . space
. showsConsTerm cons1 . space
. showsQualIdent qident . space
. showsConsTerm cons2
. showsString ")"
showsConsTerm (ParenPattern cons)
= showsString "(ParenPattern "
. showsConsTerm cons
. showsString ")"
showsConsTerm (TuplePattern conss)
= showsString "(TuplePattern "
. showsList showsConsTerm conss
. showsString ")"
showsConsTerm (ListPattern a conss)
= showsString "(ListPattern "
. showsPrec 11 a . space
. showsList showsConsTerm conss
. showsString ")"
showsConsTerm (AsPattern ident cons)
= showsString "(AsPattern "
. showsIdent ident . space
. showsConsTerm cons
. showsString ")"
showsConsTerm (LazyPattern cons)
= showsString "(LazyPattern "
. showsConsTerm cons
. showsString ")"
showsConsTerm (FunctionPattern a qident conss)
= showsString "(FunctionPattern "
. showsPrec 11 a . space
. showsQualIdent qident . space
. showsList showsConsTerm conss
. showsString ")"
showsConsTerm (InfixFuncPattern a cons1 qident cons2)
= showsString "(InfixFuncPattern "
. showsPrec 11 a . space
. showsConsTerm cons1 . space
. showsQualIdent qident . space
. showsConsTerm cons2
. showsString ")"
showsConsTerm (RecordPattern a qident cfields)
= showsString "(RecordPattern "
. showsPrec 11 a . space
. showsQualIdent qident . space
. showsList (showsField showsConsTerm) cfields . space
. showsString ")"
showsExpression :: Show a => Expression a -> ShowS
showsExpression (Literal a lit)
= showsString "(Literal "
. showsPrec 11 a . space
. showsLiteral lit
. showsString ")"
showsExpression (Variable a qident)
= showsString "(Variable "
. showsPrec 11 a . space
. showsQualIdent qident
. showsString ")"
showsExpression (Constructor a qident)
= showsString "(Constructor "
. showsPrec 11 a . space
. showsQualIdent qident
. showsString ")"
showsExpression (Paren expr)
= showsString "(Paren "
. showsExpression expr
. showsString ")"
showsExpression (Typed expr qtype)
= showsString "(Typed "
. showsExpression expr . space
. showsQualTypeExpr qtype
. showsString ")"
showsExpression (Tuple exps)
= showsString "(Tuple "
. showsList showsExpression exps
. showsString ")"
showsExpression (List a exps)
= showsString "(List "
. showsPrec 11 a . space
. showsList showsExpression exps
. showsString ")"
showsExpression (ListCompr expr stmts)
= showsString "(ListCompr "
. showsExpression expr . space
. showsList showsStatement stmts
. showsString ")"
showsExpression (EnumFrom expr)
= showsString "(EnumFrom "
. showsExpression expr
. showsString ")"
showsExpression (EnumFromThen exp1 exp2)
= showsString "(EnumFromThen "
. showsExpression exp1 . space
. showsExpression exp2
. showsString ")"
showsExpression (EnumFromTo exp1 exp2)
= showsString "(EnumFromTo "
. showsExpression exp1 . space
. showsExpression exp2
. showsString ")"
showsExpression (EnumFromThenTo exp1 exp2 exp3)
= showsString "(EnumFromThenTo "
. showsExpression exp1 . space
. showsExpression exp2 . space
. showsExpression exp3
. showsString ")"
showsExpression (UnaryMinus expr)
= showsString "(UnaryMinus "
. showsExpression expr
. showsString ")"
showsExpression (Apply exp1 exp2)
= showsString "(Apply "
. showsExpression exp1 . space
. showsExpression exp2
. showsString ")"
showsExpression (InfixApply exp1 op exp2)
= showsString "(InfixApply "
. showsExpression exp1 . space
. showsInfixOp op . space
. showsExpression exp2
. showsString ")"
showsExpression (LeftSection expr op)
= showsString "(LeftSection "
. showsExpression expr . space
. showsInfixOp op
. showsString ")"
showsExpression (RightSection op expr)
= showsString "(RightSection "
. showsInfixOp op . space
. showsExpression expr
. showsString ")"
showsExpression (Lambda conss expr)
= showsString "(Lambda "
. showsList showsConsTerm conss . space
. showsExpression expr
. showsString ")"
showsExpression (Let decls expr)
= showsString "(Let "
. showsList showsDecl decls . space
. showsExpression expr
. showsString ")"
showsExpression (Do stmts expr)
= showsString "(Do "
. showsList showsStatement stmts . space
. showsExpression expr
. showsString ")"
showsExpression (IfThenElse exp1 exp2 exp3)
= showsString "(IfThenElse "
. showsExpression exp1 . space
. showsExpression exp2 . space
. showsExpression exp3
. showsString ")"
showsExpression (Case ct expr alts)
= showsString "(Case "
. showsCaseType ct . space
. showsExpression expr . space
. showsList showsAlt alts
. showsString ")"
showsExpression (RecordUpdate expr efields)
= showsString "(RecordUpdate "
. showsExpression expr . space
. showsList (showsField showsExpression) efields
. showsString ")"
showsExpression (Record a qident efields)
= showsString "(Record "
. showsPrec 11 a . space
. showsQualIdent qident . space
. showsList (showsField showsExpression) efields
. showsString ")"
showsInfixOp :: Show a => InfixOp a -> ShowS
showsInfixOp (InfixOp a qident)
= showsString "(InfixOp "
. showsPrec 11 a . space
. showsQualIdent qident
. showsString ")"
showsInfixOp (InfixConstr a qident)
= showsString "(InfixConstr "
. showsPrec 11 a . space
. showsQualIdent qident
. showsString ")"
showsStatement :: Show a => Statement a -> ShowS
showsStatement (StmtExpr expr)
= showsString "(StmtExpr "
. showsExpression expr
. showsString ")"
showsStatement (StmtDecl decls)
= showsString "(StmtDecl "
. showsList showsDecl decls
. showsString ")"
showsStatement (StmtBind cons expr)
= showsString "(StmtBind "
. showsConsTerm cons . space
. showsExpression expr
. showsString ")"
showsCaseType :: CaseType -> ShowS
showsCaseType Rigid = showsString "Rigid"
showsCaseType Flex = showsString "Flex"
showsAlt :: Show a => Alt a -> ShowS
showsAlt (Alt pos cons rhs)
= showsString "(Alt "
. showsPosition pos . space
. showsConsTerm cons . space
. showsRhs rhs
. showsString ")"
showsField :: (a -> ShowS) -> Field a -> ShowS
showsField sa (Field pos ident a)
= showsString "(Field "
. showsPosition pos . space
. showsQualIdent ident . space
. sa a
. showsString ")"
showsVar :: Show a => Var a -> ShowS
showsVar (Var a ident)
= showsString "(Var "
. showsPrec 11 a . space
. showsIdent ident
. showsString ")"
showsPosition :: Position -> ShowS
showsPosition Position { line = l, column = c } = showsPair shows shows (l, c)
showsPosition _ = showsString "(0,0)"
showsString :: String -> ShowS
showsString = (++)
space :: ShowS
space = showsString " "
newline :: ShowS
newline = showsString "\n"
showsMaybe :: (a -> ShowS) -> Maybe a -> ShowS
showsMaybe shs = maybe (showsString "Nothing")
(\x -> showsString "(Just " . shs x . showsString ")")
showsList :: (a -> ShowS) -> [a] -> ShowS
showsList _ [] = showsString "[]"
showsList shs (x:xs)
= showsString "["
. foldl (\sys y -> sys . showsString "," . shs y) (shs x) xs
. showsString "]"
showsPair :: (a -> ShowS) -> (b -> ShowS) -> (a,b) -> ShowS
showsPair sa sb (a,b)
= showsString "(" . sa a . showsString "," . sb b . showsString ")"
showsIdent :: Ident -> ShowS
showsIdent (Ident p x n)
= showsString "(Ident " . showsPosition p . space
. shows x . space . shows n . showsString ")"
showsQualIdent :: QualIdent -> ShowS
showsQualIdent (QualIdent mident ident)
= showsString "(QualIdent "
. showsMaybe showsModuleIdent mident
. space
. showsIdent ident
. showsString ")"
showsModuleIdent :: ModuleIdent -> ShowS
showsModuleIdent (ModuleIdent pos ss)
= showsString "(ModuleIdent "
. showsPosition pos . space
. showsList (showsQuotes showsString) ss
. showsString ")"
showsQuotes :: (a -> ShowS) -> a -> ShowS
showsQuotes sa a
= showsString "\"" . sa a . showsString "\""