diff --git a/packages.dhall b/packages.dhall index 9ae27df..d269a61 100644 --- a/packages.dhall +++ b/packages.dhall @@ -4,10 +4,14 @@ let upstream = let overrides = {=} let additions = - { boxes = + { prettyprinter = { dependencies = - [ "generics-rep", "prelude", "profunctor", "strings", "stringutils" ] - , repo = "https://github.com/srghma/purescript-boxes.git" + [ "prelude" + , "unfoldable" + , "console" + , "stringutils" + ] + , repo = "https://github.com/srghma/purescript-prettyprinter.git" , version = "master" } } diff --git a/spago.dhall b/spago.dhall index 0fffec5..d4ae7b7 100644 --- a/spago.dhall +++ b/spago.dhall @@ -10,7 +10,7 @@ , "node-path" , "node-fs-aff" , "ansi" - , "boxes" + , "prettyprinter" , "debug" ] , packages = ./packages.dhall diff --git a/src/Language/PS/CST.purs b/src/Language/PS/CST.purs index a436449..29af282 100644 --- a/src/Language/PS/CST.purs +++ b/src/Language/PS/CST.purs @@ -7,7 +7,7 @@ import Language.PS.CST.Types.Module (DataMembers(..), Export(..), Import(..), Im import Language.PS.CST.Types.QualifiedName (QualifiedName(..)) as Export import Language.PS.CST.Types.Leafs (ClassFundep(..), Comments(..), DeclDeriveType(..), Fixity(..), Ident(..), Label(..), ModuleName(..), OpName(..), OpNameType_TypeOpName, OpNameType_ValueOpName, ProperName(..), ProperNameType_ClassName, ProperNameType_ConstructorName, ProperNameType_KindName, ProperNameType_Namespace, ProperNameType_TypeName, RecordLabeled(..), kind OpNameType, kind ProperNameType) as Export import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved, quoteIfReserved, reservedNames) as Export -import Language.PS.CST.Printers (exprShouldBeOnNextLine, printBinder, printComments, printDeclaration, printDeclarations, printExpr, printGuarded, printInstanceBinding, printLetBinding, printMaybeComments, printModule, printModuleToString, printRecordLabeled, printRecordUpdate, printRecordUpdates, printValueBindingFields, shouldBeNoNewlineBetweenDeclarations, shouldBeNoNewlineBetweenInstanceBindings, shouldBeNoNewlineBetweenLetBindings) as Export +import Language.PS.CST.Printers (printBinder, printComments, printDeclaration, printDeclarations, printExpr, printGuarded, printInstanceBinding, printLetBinding, printMaybeComments, printModule, printModuleToString, printRecordLabeled, printRecordUpdate, printRecordUpdates, printValueBindingFields) as Export import Language.PS.CST.Sugar.Declaration (arrayType, booleanType, maybeType, numberType, stringType, typeRecord, typeRow) as Export import Language.PS.CST.Sugar.Leafs (emptyRow, mkModuleName, mkRowLabel, mkRowLabels) as Export import Language.PS.CST.Sugar.QualifiedName (nonQualifiedName, qualifiedName) as Export diff --git a/src/Language/PS/CST/Printers.purs b/src/Language/PS/CST/Printers.purs index 7f40e33..c05745e 100644 --- a/src/Language/PS/CST/Printers.purs +++ b/src/Language/PS/CST/Printers.purs @@ -1,76 +1,64 @@ module Language.PS.CST.Printers where -import Prelude (flip, map, show, (#), ($), (<#>), (<<<), (==)) +import Language.PS.CST.Printers.Utils +import Prelude +import Text.Pretty +import Text.Pretty.Symbols.String hiding (space) -import Language.PS.CST.Printers.PrintImports (printImports) -import Language.PS.CST.Printers.PrintModuleModuleNameAndExports (printModuleModuleNameAndExports) -import Language.PS.CST.Printers.TypeLevel (PrintType_Style(..), printConstraint, printDataCtor, printDataHead, printFixity, printFundep, printKind, printQualifiedName_AnyOpNameType, printQualifiedName_AnyProperNameType, printQualifiedName_Ident, printType, printTypeVarBinding) -import Language.PS.CST.Printers.Utils (emptyColumn, emptyRow, ifelse, lines, maybeWrapInParentheses, printAndConditionallyAddNewlinesBetween, twoSpaceIdentation, wrapInParentheses) -import Language.PS.CST.Types.Leafs (Comments(..), DeclDeriveType(..), RecordLabeled(..)) -import Language.PS.CST.Types.Declaration (Binder(..), Declaration(..), Expr(..), FixityOp(..), Foreign(..), Guarded(..), Instance, InstanceBinding(..), LetBinding(..), RecordUpdate(..), Type(..), ValueBindingFields) -import Language.PS.CST.Types.Module (Module(..)) -import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved, quoteIfReserved) - -import Data.Newtype (unwrap) +import Data.Array as Array +import Data.Array.NonEmpty (NonEmptyArray) +import Data.Array.NonEmpty as NonEmptyArray import Data.Either (Either(..)) -import Data.Foldable (any, null) +import Data.Foldable (any, intercalate, null) import Data.FunctorWithIndex (mapWithIndex) import Data.List (fromFoldable) as List import Data.Maybe (Maybe, maybe) -import Data.Array.NonEmpty (NonEmptyArray) -import Text.PrettyPrint.Boxes (Box, left, nullBox, punctuateH, punctuateV, text, vcat, vsep, (/+/), (//), (<<+>>), (<<>>)) -import Text.PrettyPrint.Boxes (render) as Text.PrettyPrint.Boxes +import Data.Newtype (unwrap) +import Data.NonEmpty (NonEmpty(..)) +import Debug.Trace (spy) +import Language.PS.CST.Printers.PrintImports (printImports) +import Language.PS.CST.Printers.PrintModuleModuleNameAndExports (printModuleModuleNameAndExports) +import Language.PS.CST.Printers.TypeLevel (printConstraint, printDataCtor, printDataHead, printFixity, printFundep, printKind, printQualifiedName_AnyOpNameType, printQualifiedName_AnyProperNameType, printQualifiedName_Ident, printType, printTypeVarBinding) +import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved, quoteIfReserved) +import Language.PS.CST.Types.Declaration (Binder(..), Declaration(..), Expr(..), FixityOp(..), Foreign(..), Guarded(..), Instance, InstanceBinding(..), LetBinding(..), RecordUpdate(..), Type(..), ValueBindingFields) +import Language.PS.CST.Types.Leafs (Comments(..), DeclDeriveType(..), RecordLabeled(..)) +import Language.PS.CST.Types.Module (Module(..)) +import Text.Pretty as Pretty +import Text.Pretty.Code.Purescript (encloseSep) -printModuleToString :: Module -> String -printModuleToString = Text.PrettyPrint.Boxes.render <<< printModule +printModuleToString :: Int -> Module -> String +printModuleToString width = Pretty.render width <<< printModule -printModule :: Module -> Box +printModule :: Module -> Doc String printModule (Module { moduleName, imports, exports, declarations }) = - lines - $ [ printModuleModuleNameAndExports moduleName exports - , printImports imports - , printDeclarations declarations - , emptyRow - ] - -shouldBeNoNewlineBetweenDeclarations :: Declaration -> Declaration -> Boolean -shouldBeNoNewlineBetweenDeclarations (DeclSignature { ident }) (DeclValue { valueBindingFields: { name } }) = ident == name -shouldBeNoNewlineBetweenDeclarations (DeclValue { valueBindingFields: { name } }) (DeclValue { valueBindingFields: { name: nameNext } }) = name == nameNext -shouldBeNoNewlineBetweenDeclarations _ _ = false - -shouldBeNoNewlineBetweenLetBindings :: LetBinding -> LetBinding -> Boolean -shouldBeNoNewlineBetweenLetBindings (LetBindingSignature { ident }) (LetBindingName { name }) = ident == name -shouldBeNoNewlineBetweenLetBindings (LetBindingName { name }) (LetBindingName { name: nameNext }) = name == nameNext -shouldBeNoNewlineBetweenLetBindings _ _ = false - -shouldBeNoNewlineBetweenInstanceBindings :: InstanceBinding -> InstanceBinding -> Boolean -shouldBeNoNewlineBetweenInstanceBindings (InstanceBindingSignature { ident }) (InstanceBindingName { name }) = ident == name -shouldBeNoNewlineBetweenInstanceBindings (InstanceBindingName { name }) (InstanceBindingName { name: nameNext }) = name == nameNext -shouldBeNoNewlineBetweenInstanceBindings _ _ = false - -printDeclarations :: Array (Declaration) -> Box -printDeclarations [] = nullBox -printDeclarations declarations = emptyRow // printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenDeclarations printDeclaration declarations - -printComments :: Comments -> Box -printComments (OneLineComments strings) = strings <#> (\x -> text "-- |" <<+>> text x) # vcat left -printComments (BlockComments strings) = text "{-" // (strings <#> (\x -> twoSpaceIdentation <<>> text x) # vcat left) // text "-}" - -printMaybeComments :: Maybe Comments -> Box -printMaybeComments = maybe nullBox printComments - -printDeclaration :: Declaration -> Box -printDeclaration (DeclData { comments, head, constructors: [] }) = printMaybeComments comments // printDataHead (text "data") head + concatWith (surroundOmittingEmpty (hardline <> hardline)) + [ printModuleModuleNameAndExports moduleName exports + , printImports imports + , printDeclarations declarations + ] <> hardline + +printDeclarations :: Array (Declaration) -> Doc String +printDeclarations declarations = printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenDeclarations printDeclaration declarations + +printComments :: Comments -> Doc String +printComments (OneLineComments strings) = strings <#> (\x -> text "-- |" <+> text x) # vcatOmittingEmpty +printComments (BlockComments strings) = text "{-" <> line <> indent 2 (vcatOmittingEmpty $ map text strings) <> line <> text "-}" + +printMaybeComments :: Maybe Comments -> Doc String -> Doc String +printMaybeComments comments doc = + vcatOmittingEmpty + [ maybe emptyDoc printComments comments + , doc + ] + +printDeclaration :: Declaration -> Doc String +printDeclaration (DeclData { comments, head, constructors: [] }) = printMaybeComments comments (printDataHead (text "data") head) printDeclaration (DeclData { comments, head, constructors }) = let - printedCtors = - constructors - <#> printDataCtor - # mapWithIndex (\i box -> ifelse (i == 0) (text "=") (text "|") <<+>> box) - <#> (twoSpaceIdentation <<>> _) - # vcat left - in - printMaybeComments comments // printDataHead (text "data") head // printedCtors + printedCtorsArray = map (align <<< printDataCtor) constructors + + printedCtors = align $ group $ concatWith (surroundOmittingEmpty line) $ Array.zipWith (<+>) ([text "="] <> Array.replicate (Array.length constructors - 1) (text "|")) printedCtorsArray + in printMaybeComments comments (group $ vcat [ printDataHead (text "data") head, flatAlt (text " ") (text " ") <> printedCtors ]) printDeclaration (DeclType { comments, head, type_ }) = let doWrap :: Type -> Boolean @@ -80,10 +68,9 @@ printDeclaration (DeclType { comments, head, type_ }) = doWrap (TypeConstrained _ _) = true doWrap _ = false - printedType :: Box - printedType = maybeWrapInParentheses (doWrap type_) $ printType PrintType_Multiline $ type_ - in - printMaybeComments comments // (printDataHead (text "type") head <<+>> text "=" <<+>> printedType) + printedType :: Doc String + printedType = maybeWrapInParentheses (doWrap type_) $ printType $ type_ + in printMaybeComments comments (printDataHead (text "type") head <+> text "=" <+> printedType) printDeclaration (DeclNewtype { comments, head, name, type_ }) = let doWrap :: Type -> Boolean @@ -94,25 +81,23 @@ printDeclaration (DeclNewtype { comments, head, name, type_ }) = doWrap (TypeConstrained _ _) = true doWrap _ = false - printedType :: Box - printedType = maybeWrapInParentheses (doWrap type_) $ printType PrintType_Multiline $ type_ - in - printMaybeComments comments // (printDataHead (text "newtype") head <<+>> text "=" <<+>> ((text <<< appendUnderscoreIfReserved <<< unwrap) name <<+>> printedType)) + printedType :: Doc String + printedType = maybeWrapInParentheses (doWrap type_) $ printType $ type_ + in printMaybeComments comments (printDataHead (text "newtype") head <+> text "=" <+> ((text <<< appendUnderscoreIfReserved <<< unwrap) name <+> printedType)) printDeclaration (DeclFixity { comments, fixityFields: { keyword, precedence, operator } }) = let - printFixityOp :: FixityOp -> Box - printFixityOp (FixityValue (Left qualifiedIdent) opName) = printQualifiedName_Ident qualifiedIdent <<+>> text "as" <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) opName - printFixityOp (FixityValue (Right qualifiedPropName) opName) = printQualifiedName_AnyProperNameType qualifiedPropName <<+>> text "as" <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) opName - printFixityOp (FixityType qualifiedPropName opName) = text "type" <<+>> printQualifiedName_AnyProperNameType qualifiedPropName <<+>> text "as" <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) opName - in - printMaybeComments comments // (printFixity keyword <<+>> text (show precedence) <<+>> printFixityOp operator) + printFixityOp :: FixityOp -> Doc String + printFixityOp (FixityValue (Left qualifiedIdent) opName) = printQualifiedName_Ident qualifiedIdent <+> text "as" <+> (text <<< appendUnderscoreIfReserved <<< unwrap) opName + printFixityOp (FixityValue (Right qualifiedPropName) opName) = printQualifiedName_AnyProperNameType qualifiedPropName <+> text "as" <+> (text <<< appendUnderscoreIfReserved <<< unwrap) opName + printFixityOp (FixityType qualifiedPropName opName) = text "type" <+> printQualifiedName_AnyProperNameType qualifiedPropName <+> text "as" <+> (text <<< appendUnderscoreIfReserved <<< unwrap) opName + in printMaybeComments comments (printFixity keyword <+> text (show precedence) <+> printFixityOp operator) printDeclaration (DeclForeign { comments, foreign_ }) = - printMaybeComments comments // - ( text "foreign" <<+>> text "import" <<+>> + printMaybeComments comments + ( text "foreign" <+> text "import" <+> case foreign_ of - (ForeignValue { ident, type_ }) -> (text <<< appendUnderscoreIfReserved <<< unwrap) ident <<+>> text "::" <<+>> printType PrintType_Multiline type_ - (ForeignData { name, kind_ }) -> text "data" <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) name <<+>> text "::" <<+>> printKind kind_ - (ForeignKind { name }) -> text "kind" <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) name + (ForeignValue { ident, type_ }) -> (text <<< appendUnderscoreIfReserved <<< unwrap) ident <+> text "::" <+> printType type_ + (ForeignData { name, kind_ }) -> text "data" <+> (text <<< appendUnderscoreIfReserved <<< unwrap) name <+> text "::" <+> printKind kind_ + (ForeignKind { name }) -> text "kind" <+> (text <<< appendUnderscoreIfReserved <<< unwrap) name ) printDeclaration (DeclDerive { comments, deriveType, head: { instName, instConstraints, instClass, instTypes } }) = let @@ -126,257 +111,242 @@ printDeclaration (DeclDerive { comments, deriveType, head: { instName, instConst deriveType' = case deriveType of - DeclDeriveType_Newtype -> emptyColumn <<>> text "newtype" - DeclDeriveType_Odrinary -> nullBox + DeclDeriveType_Newtype -> text "newtype" + DeclDeriveType_Odrinary -> emptyDoc constraints' = case instConstraints of - [] -> nullBox - [constraint] -> emptyColumn <<>> printConstraint constraint <<+>> text "=>" - constrainsts -> emptyColumn <<>> (wrapInParentheses $ punctuateH left (text ", ") $ map printConstraint constrainsts) <<+>> text "=>" + [] -> emptyDoc + [constraint] -> printConstraint constraint <+> text "=>" + constrainsts -> (align $ group $ encloseSep (text "(") (text ")") (text ", ") $ map printConstraint constrainsts) <+> text "=>" - types' = punctuateH left (emptyColumn) $ map (\type_ -> maybeWrapInParentheses (doWrap type_) $ printType PrintType_OneLine type_) instTypes + types' = concatWithNonEmpty (surround space) $ map (\type_ -> maybeWrapInParentheses (doWrap type_) $ printType type_) instTypes in - printMaybeComments comments // (text "derive" <<>> deriveType' <<+>> text "instance" <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) instName <<+>> text "::" <<>> constraints' <<+>> printQualifiedName_AnyProperNameType instClass <<+>> types') + printMaybeComments comments $ concatWith (surroundOmittingEmpty space) + [ text "derive" + , deriveType' + , text "instance" + , text $ appendUnderscoreIfReserved $ unwrap instName + , text "::" + , constraints' + , printQualifiedName_AnyProperNameType instClass + , types' + ] printDeclaration (DeclClass { comments, head: { name, vars, super, fundeps }, methods }) = let - printedVars = - if null vars - then nullBox - else emptyColumn <<>> (punctuateH left emptyColumn $ map printTypeVarBinding vars) - - printedSuper = - case super of - [] -> nullBox - [constraint] -> printConstraint constraint <<+>> text "<=" <<>> emptyColumn - constraints -> (wrapInParentheses $ punctuateH left (text ", ") $ map printConstraint constraints) <<+>> text "<=" <<>> emptyColumn - - printedFundeps = - if null fundeps - then nullBox - else emptyColumn <<>> text "|" <<+>> (fundeps # map printFundep # punctuateH left (text ", ")) - - printedHeader = text "class" <<+>> printedSuper <<>> (text <<< appendUnderscoreIfReserved <<< unwrap) name <<>> printedVars <<>> printedFundeps + printedHeader = concatWith (surroundOmittingEmpty space) + [ text "class" + , case super of + [] -> emptyDoc + [constraint] -> printConstraint constraint <+> text "<=" + constraints -> (align $ group $ encloseSep (text "(") (text ")") (text ", ") $ map printConstraint constraints) <+> text "<=" + , (text <<< appendUnderscoreIfReserved <<< unwrap) name + , case vars of + [] -> emptyDoc + _ -> align $ group $ concatWith (surroundOmittingEmpty line) $ map printTypeVarBinding vars + , case fundeps of + [] -> emptyDoc + _ -> text "|" <+> (align $ group $ concatWith (surroundOmittingEmpty (text ", ")) $ map printFundep $ fundeps) + ] in if null methods - then printMaybeComments comments // printedHeader + then printMaybeComments comments printedHeader else - printMaybeComments comments // - ( printedHeader <<+>> (text "where") - // (methods - <#> (\({ ident, type_ }) -> (text <<< appendUnderscoreIfReserved <<< unwrap) ident <<+>> text "::" <<+>> (printType PrintType_Multiline type_)) - <#> (twoSpaceIdentation <<>> _) - # vcat left - ) + printMaybeComments comments + ( printedHeader <+> (text "where") <> hardline <> + ( indent 2 + $ vcatOmittingEmpty + $ map (\({ ident, type_ }) -> (text <<< appendUnderscoreIfReserved <<< unwrap) ident <+> text "::" <+> printType type_) $ methods + ) ) -printDeclaration (DeclInstanceChain { comments, instances }) = +printDeclaration (DeclInstanceChain { comments, instances }) = printMaybeComments comments (concatWithNonEmpty (surroundOmittingEmpty (hardline <> hardline <> text "else" <> hardline <> hardline)) (map printInstance instances)) +printDeclaration (DeclSignature { comments, ident, type_ }) = printMaybeComments comments ((text <<< appendUnderscoreIfReserved <<< unwrap) ident <+> text "::" <+> printType type_) +printDeclaration (DeclValue { comments, valueBindingFields }) = printMaybeComments comments (printValueBindingFields valueBindingFields) + +printInstance :: Instance -> Doc String +printInstance instance_ = let - printInstance :: Instance -> Box - printInstance { head: { instName, instConstraints, instClass, instTypes }, body } = - let - head = text "instance" <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) instName <<+>> text "::" <<+>> printQualifiedName_AnyProperNameType instClass + head = text "instance" <+> (text <<< appendUnderscoreIfReserved <<< unwrap) instance_.head.instName <+> text "::" <+> printQualifiedName_AnyProperNameType instance_.head.instClass - doWrap :: Type -> Boolean - doWrap (TypeApp _ _) = true - doWrap (TypeForall _ _) = true - doWrap (TypeArr _ _) = true - doWrap (TypeOp _ _ _) = true - doWrap (TypeConstrained _ _) = true - doWrap _ = false + doWrap :: Type -> Boolean + doWrap (TypeApp _ _) = true + doWrap (TypeForall _ _) = true + doWrap (TypeArr _ _) = true + doWrap (TypeOp _ _ _) = true + doWrap (TypeConstrained _ _) = true + doWrap _ = false - tail = - if null instTypes - then nullBox - else emptyColumn <<>> (instTypes <#> (\type_ -> maybeWrapInParentheses (doWrap type_) (printType PrintType_OneLine type_)) # punctuateH left emptyColumn) + tail = + if null instance_.head.instTypes + then emptyDoc + else concatWithNonEmpty (surround line) $ map (\type_ -> maybeWrapInParentheses (doWrap type_) (printType type_)) instance_.head.instTypes - firstRow = head <<>> tail - in - if null body - then printMaybeComments comments // firstRow - else - let - printedBody = printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenInstanceBindings printInstanceBinding body - in - printMaybeComments comments - // (firstRow <<+>> text "where") - // (twoSpaceIdentation <<>> printedBody) - in instances <#> printInstance # punctuateV left (nullBox /+/ text "else" /+/ nullBox) -printDeclaration (DeclSignature { comments, ident, type_ }) = printMaybeComments comments // ((text <<< appendUnderscoreIfReserved <<< unwrap) ident <<+>> text "::" <<+>> printType PrintType_Multiline type_) -printDeclaration (DeclValue { comments, valueBindingFields }) = printMaybeComments comments // (printValueBindingFields valueBindingFields) + firstRow = group $ concatWith (surround line) [head, tail] + in + if null instance_.body + then firstRow + else + let + printedBody = printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenInstanceBindings printInstanceBinding instance_.body + in firstRow <+> text "where" <> line <> indent 2 printedBody -printInstanceBinding :: InstanceBinding -> Box -printInstanceBinding (InstanceBindingSignature { ident, type_ }) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident <<+>> text "::" <<+>> printType PrintType_Multiline type_ +printInstanceBinding :: InstanceBinding -> Doc String +printInstanceBinding (InstanceBindingSignature { ident, type_ }) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident <+> text "::" <+> printType type_ printInstanceBinding (InstanceBindingName valueBindingFields) = printValueBindingFields valueBindingFields -printValueBindingFields :: ValueBindingFields -> Box +printValueBindingFields :: ValueBindingFields -> Doc String printValueBindingFields { name, binders, guarded } = let printedBinders = if null binders - then nullBox - else (punctuateH left emptyColumn $ map printBinder binders) <<>> emptyColumn + then emptyDoc + else (vsep $ map printBinder binders) <> space - printedHead = (text <<< appendUnderscoreIfReserved <<< unwrap) name <<+>> printedBinders <<>> text "=" + printedHead = (text <<< appendUnderscoreIfReserved <<< unwrap) name <+> printedBinders <> text "=" in printGuarded printedHead guarded -printGuarded :: Box -> Guarded -> Box +printGuarded :: Doc String -> Guarded -> Doc String printGuarded printedHead guarded = case guarded of (Unconditional where_) -> case where_ of { expr, whereBindings: [] } -> if exprShouldBeOnNextLine expr - then printedHead // (twoSpaceIdentation <<>> printExpr expr) - else printedHead <<+>> printExpr expr + then printedHead <> line <>(indent 2 $ printExpr expr) + else printedHead <+> printExpr expr { expr, whereBindings } -> let - printedBindings = twoSpaceIdentation <<>> (text "where" // (printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenLetBindings printLetBinding whereBindings)) + printedBindings = indent 2 (text "where" <> line <>(printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenLetBindings printLetBinding whereBindings)) in if exprShouldBeOnNextLine expr - then printedHead // (twoSpaceIdentation <<>> printExpr expr) // printedBindings - else printedHead <<+>> printExpr expr // printedBindings - (Guarded _) -> nullBox -- TODO - -exprShouldBeOnNextLine :: Expr -> Boolean -exprShouldBeOnNextLine (ExprLet _) = true -exprShouldBeOnNextLine (ExprCase _) = true -exprShouldBeOnNextLine (ExprIf _) = true -exprShouldBeOnNextLine _ = false + then printedHead <> line <> (indent 2 $ printExpr expr) <> line <>printedBindings + else printedHead <+> printExpr expr <> line <>printedBindings + (Guarded _) -> emptyDoc -- TODO -printBinder :: Binder -> Box +printBinder :: Binder -> Doc String printBinder BinderWildcard = text "_" printBinder (BinderVar ident) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident -printBinder (BinderNamed { ident, binder }) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident <<>> text "@" <<>> (wrapInParentheses $ printBinder binder) +printBinder (BinderNamed { ident, binder }) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident <> text "@" <> (parens $ printBinder binder) printBinder (BinderConstructor { name, args: [] }) = printQualifiedName_AnyProperNameType name -printBinder (BinderConstructor { name, args }) = printQualifiedName_AnyProperNameType name <<+>> (punctuateH left emptyColumn $ map printBinder args) +printBinder (BinderConstructor { name, args }) = printQualifiedName_AnyProperNameType name <+> (vsep $ map printBinder args) printBinder (BinderBoolean boolean) = text $ show boolean printBinder (BinderChar char) = text $ show char printBinder (BinderString string) = text $ show string printBinder (BinderNumber (Left int)) = text $ show int printBinder (BinderNumber (Right number)) = text $ show number -printBinder (BinderArray binders) = text "[" <<>> (punctuateH left (text ", ") $ map printBinder binders) <<>> text "]" -printBinder (BinderRecord arrayRecordLabeledBinder) = punctuateH left (text ", ") $ map (printRecordLabeled printBinder) arrayRecordLabeledBinder -printBinder (BinderTyped binder type_) = printBinder binder <<+>> text "::" <<+>> printType PrintType_OneLine type_ -printBinder (BinderOp binderLeft operator binderRight) = printBinder binderLeft <<+>> printQualifiedName_AnyOpNameType operator <<+>> printBinder binderRight +printBinder (BinderArray binders) = text "[" <> (concatWith (surroundOmittingEmpty (text ", ")) $ map printBinder binders) <> text "]" +printBinder (BinderRecord arrayRecordLabeledBinder) = concatWith (surroundOmittingEmpty (text ", ")) $ map (printRecordLabeled printBinder) arrayRecordLabeledBinder +printBinder (BinderTyped binder type_) = printBinder binder <+> text "::" <+> printType type_ +printBinder (BinderOp binderLeft operator binderRight) = printBinder binderLeft <+> printQualifiedName_AnyOpNameType operator <+> printBinder binderRight -printRecordLabeled :: ∀ a . (a -> Box) -> RecordLabeled a -> Box +printRecordLabeled :: ∀ a . (a -> Doc String) -> RecordLabeled a -> Doc String printRecordLabeled _ (RecordPun ident) = (text <<< quoteIfReserved <<< unwrap) ident -printRecordLabeled print (RecordField label a) = (text <<< quoteIfReserved <<< unwrap) label <<>> text ":" <<+>> print a +printRecordLabeled print (RecordField label a) = (text <<< quoteIfReserved <<< unwrap) label <> text ":" <+> print a -printExpr :: Expr -> Box -printExpr (ExprHole hole) = text "?" <<>> (text <<< appendUnderscoreIfReserved <<< unwrap) hole -printExpr ExprSection = text "_" -printExpr (ExprIdent qualifiedIdent) = printQualifiedName_Ident qualifiedIdent -printExpr (ExprConstructor qualifiedPropName) = printQualifiedName_AnyProperNameType qualifiedPropName -printExpr (ExprBoolean boolean) = text $ show boolean -printExpr (ExprChar char) = text $ show char -printExpr (ExprString string) = text $ show string -printExpr (ExprNumber (Left int)) = text $ show int -printExpr (ExprNumber (Right num)) = text $ show num -printExpr (ExprArray array) = text "[" <<>> (punctuateH left (text ", ") $ map printExpr array) <<>> text "]" -printExpr (ExprRecord arrayRecordLabeled) = text "{" <<+>> (punctuateH left (text ", ") $ map (printRecordLabeled printExpr) arrayRecordLabeled) <<+>> text "}" -printExpr (ExprTyped expr type_) = printExpr expr <<+>> text "::" <<+>> printType PrintType_OneLine type_ -printExpr (ExprInfix exprLeft operator exprRight) = printExpr exprLeft <<+>> printExpr operator <<+>> printExpr exprRight -printExpr (ExprOp exprLeft operator exprRight) = printExpr exprLeft <<+>> printQualifiedName_AnyOpNameType operator <<+>> printExpr exprRight -printExpr (ExprOpName opName) = printQualifiedName_AnyOpNameType opName -printExpr (ExprNegate expr) = text "-" <<>> printExpr expr -printExpr (ExprRecordAccessor { recExpr, recPath }) = printExpr recExpr <<>> text "." <<>> (punctuateH left (text ".") $ map (text <<< appendUnderscoreIfReserved <<< unwrap) recPath) -printExpr (ExprRecordUpdate expr recordUpdates) = wrapInParentheses $ printExpr expr <<+>> printRecordUpdates recordUpdates -printExpr (ExprApp exprLeft exprRight) = +printExpr :: Expr -> Doc String +printExpr = let - doWrapRight = - case exprRight of - (ExprApp _ _) -> true -- always wrap right side application - (ExprInfix _ _ _) -> true - (ExprOp _ _ _) -> true - _ -> false - - printedLeft :: Box - printedLeft = printExpr exprLeft - - printedRight :: Box - printedRight = printExpr exprRight - - printed :: Box - printed = printedLeft <<+>> maybeWrapInParentheses doWrapRight printedRight - in - printed -printExpr (ExprLambda { binders, body }) = (wrapInParentheses $ punctuateH left emptyColumn $ map printBinder binders) <<+>> text "=" <<+>> printExpr body -printExpr (ExprIf { cond, true_, false_ }) = - let - printedCond = - if exprShouldBeOnNextLine cond - then text "if" // (twoSpaceIdentation <<>> printExpr cond) - else text "if" <<+>> printExpr cond - - printedTrue = - if exprShouldBeOnNextLine true_ - then twoSpaceIdentation <<>> (text "then" // (twoSpaceIdentation <<>> printExpr true_)) - else twoSpaceIdentation <<>> text "then" <<+>> printExpr true_ - - printedFalse = - if exprShouldBeOnNextLine false_ - then twoSpaceIdentation <<>> (text "else" // (twoSpaceIdentation <<>> printExpr false_)) - else twoSpaceIdentation <<>> text "else" <<+>> printExpr false_ - in - printedCond - // printedTrue - // printedFalse -printExpr (ExprCase { head, branches }) = - let - printBranch :: { binders :: NonEmptyArray Binder, body :: Guarded } -> Box - printBranch { binders, body } = + processTopLevel printExprImplementation' expr = + case expr of + (ExprApp _ _) -> align $ group $ printExprImplementation' expr + (ExprArray _) -> group $ printExprImplementation' expr + (ExprRecord _) -> group $ printExprImplementation' expr + _ -> printExprImplementation' expr + + printExprImplementation (ExprHole hole) = text "?" <> (text <<< appendUnderscoreIfReserved <<< unwrap) hole + printExprImplementation ExprSection = text "_" + printExprImplementation (ExprIdent qualifiedIdent) = printQualifiedName_Ident qualifiedIdent + printExprImplementation (ExprConstructor qualifiedPropName) = printQualifiedName_AnyProperNameType qualifiedPropName + printExprImplementation (ExprBoolean boolean) = text $ show boolean + printExprImplementation (ExprChar char) = text $ show char + printExprImplementation (ExprString string) = text $ show string + printExprImplementation (ExprNumber (Left int)) = text $ show int + printExprImplementation (ExprNumber (Right num)) = text $ show num + printExprImplementation (ExprArray array) = align $ encloseSep (text "[") (text "]") (text ", ") (map (processTopLevel printExprImplementation) array) + printExprImplementation (ExprRecord arrayRecordLabeled) = text "{" <+> (concatWith (surroundOmittingEmpty (text ", ")) $ map (printRecordLabeled printExprImplementation) arrayRecordLabeled) <+> text "}" + printExprImplementation (ExprTyped expr type_) = printExprImplementation expr <+> text "::" <+> printType type_ + printExprImplementation (ExprInfix exprLeft operator exprRight) = printExprImplementation exprLeft <+> printExprImplementation operator <+> printExprImplementation exprRight + printExprImplementation (ExprOp exprLeft operator exprRight) = printExprImplementation exprLeft <+> printQualifiedName_AnyOpNameType operator <+> printExprImplementation exprRight + printExprImplementation (ExprOpName opName) = printQualifiedName_AnyOpNameType opName + printExprImplementation (ExprNegate expr) = text "-" <> printExprImplementation expr + printExprImplementation (ExprRecordAccessor { recExpr, recPath }) = printExprImplementation recExpr <> text "." <> (concatWithNonEmpty (surround dot) $ map (text <<< appendUnderscoreIfReserved <<< unwrap) recPath) + printExprImplementation (ExprRecordUpdate expr recordUpdates) = parens $ printExprImplementation expr <+> printRecordUpdates recordUpdates + printExprImplementation (ExprApp exprLeft exprRight) = let - printedHead = (punctuateH left (text ", ") $ map printBinder binders) <<+>> text "->" - in printGuarded printedHead body - - headShouldBeMultiline = - head `flip any` ( - case _ of - ExprIf _ -> true - ExprCase _ -> true - ExprLet _ -> true - ExprDo _ -> true - ExprAdo _ -> true - _ -> false - ) - in - if headShouldBeMultiline - then text "case" - // ( - head - # List.fromFoldable - <#> printExpr - # mapWithIndex (\i box -> ifelse (i == 0) (twoSpaceIdentation <<>> box) (text ", " <<>> box)) - # vcat left - ) - // text "of" - // (twoSpaceIdentation <<>> (vcat left $ map printBranch branches)) - else text "case" <<+>> (punctuateH left (text ", ") $ map printExpr head) <<+>> text "of" // (twoSpaceIdentation <<>> (vcat left $ map printBranch branches)) -printExpr (ExprLet { bindings, body }) = - let - printedBindings = printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenLetBindings printLetBinding bindings + doWrapRight = + case exprRight of + (ExprApp _ _) -> true -- always wrap right side application + (ExprInfix _ _ _) -> true + (ExprOp _ _ _) -> true + _ -> false + in concatWith (surround line) $ [ printExprImplementation exprLeft, maybeWrapInParentheses doWrapRight (printExprImplementation exprRight) ] + printExprImplementation (ExprLambda { binders, body }) = (parens $ vsep $ map printBinder binders) <+> text "=" <+> printExprImplementation body + printExprImplementation (ExprIf { cond, true_, false_ }) = concatWith (surround line) + [ if exprShouldBeOnNextLine cond + then text "if" <> hardline <> (indent 2 $ printExprImplementation cond) + else text "if" <+> printExprImplementation cond + , if exprShouldBeOnNextLine true_ + then indent 2 $ text "then" <> hardline <> (indent 2 $ printExprImplementation true_) + else indent 2 $ text "then" <+> printExprImplementation true_ + , if exprShouldBeOnNextLine false_ + then indent 2 $ text "else" <> hardline <> (indent 2 $ printExprImplementation false_) + else indent 2 $ text "else" <+> printExprImplementation false_ + ] + printExprImplementation (ExprCase { head, branches }) = + let + headShouldBeMultiline = + head `flip any` ( + case _ of + ExprIf _ -> true + ExprCase _ -> true + ExprLet _ -> true + ExprDo _ -> true + ExprAdo _ -> true + _ -> false + ) - printedBody = printExpr body + headDocs :: Array (Doc String) + headDocs = NonEmptyArray.toArray $ map printExprImplementation head + in + if headShouldBeMultiline + then concatWith (surroundOmittingEmpty line) + [ text "case" + , concatWith (surroundOmittingEmpty line') $ + Array.zipWith + (<>) + ([text " "] <> Array.replicate (Array.length headDocs - 1) (text ", ")) + (map align headDocs) + , text "of" + , indent 2 $ vcatOmittingEmptyNonEmpty $ map printBranch branches + ] + else + text "case" <+> (concatWith (surround (text ", ")) headDocs) <+> text "of" + <> hardline <> + (indent 2 $ vcatOmittingEmptyNonEmpty $ map printBranch branches) + printExprImplementation (ExprLet { bindings, body }) = align $ concatWith (surroundOmittingEmpty hardline) + [ text "let" + , indent 2 (printAndConditionallyAddNewlinesBetween shouldBeNoNewlineBetweenLetBindings printLetBinding bindings) + , text " in" + , indent 2 (processTopLevel printExprImplementation body) + ] + printExprImplementation (ExprDo doStatements) = emptyDoc -- TODO + printExprImplementation (ExprAdo { statements, result }) = emptyDoc -- TODO + in processTopLevel printExprImplementation - printed = - text "let" - // (twoSpaceIdentation <<>> printedBindings) - // text "in" - // (twoSpaceIdentation <<>> printedBody) - in - printed -printExpr (ExprDo doStatements) = nullBox -- TODO -printExpr (ExprAdo { statements, result }) = nullBox -- TODO +printBranch :: { binders :: NonEmptyArray Binder, body :: Guarded } -> Doc String +printBranch { binders, body } = + let + printedHead = (concatWithNonEmpty (surround (text ", ")) $ map printBinder binders) <+> text "->" + in printGuarded printedHead body -printLetBinding :: LetBinding -> Box -printLetBinding (LetBindingSignature { ident, type_ }) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident <<+>> text "::" <<+>> printType PrintType_Multiline type_ +printLetBinding :: LetBinding -> Doc String +printLetBinding (LetBindingSignature { ident, type_ }) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident <+> text "::" <+> printType type_ printLetBinding (LetBindingName valueBindingFields) = printValueBindingFields valueBindingFields -printLetBinding (LetBindingPattern { binder, where_: { expr, whereBindings } }) = printBinder binder /+/ printExpr expr // text "where" // (vsep 1 left $ map printLetBinding whereBindings) +printLetBinding (LetBindingPattern { binder, where_: { expr, whereBindings } }) = printBinder binder <> hardline <> printExpr expr <> line <>text "where" <> line <>(vsep $ map printLetBinding whereBindings) -printRecordUpdates :: NonEmptyArray RecordUpdate -> Box -printRecordUpdates recordUpdates = text "{" <<+>> (punctuateH left (text ",") $ map printRecordUpdate recordUpdates) <<+>> text "}" +printRecordUpdates :: NonEmptyArray RecordUpdate -> Doc String +printRecordUpdates recordUpdates = text "{" <+> (concatWithNonEmpty (surround (text ",")) $ map printRecordUpdate recordUpdates) <+> text "}" -printRecordUpdate :: RecordUpdate -> Box -printRecordUpdate (RecordUpdateLeaf label expr) = (text <<< appendUnderscoreIfReserved <<< unwrap) label <<+>> text "=" <<+>> printExpr expr -printRecordUpdate (RecordUpdateBranch label recordUpdates) = (text <<< appendUnderscoreIfReserved <<< unwrap) label <<+>> text "=" <<+>> printRecordUpdates recordUpdates +printRecordUpdate :: RecordUpdate -> Doc String +printRecordUpdate (RecordUpdateLeaf label expr) = (text <<< appendUnderscoreIfReserved <<< unwrap) label <+> text "=" <+> printExpr expr +printRecordUpdate (RecordUpdateBranch label recordUpdates) = (text <<< appendUnderscoreIfReserved <<< unwrap) label <+> text "=" <+> printRecordUpdates recordUpdates diff --git a/src/Language/PS/CST/Printers/PrintImports.purs b/src/Language/PS/CST/Printers/PrintImports.purs index 9175aa4..087c66b 100644 --- a/src/Language/PS/CST/Printers/PrintImports.purs +++ b/src/Language/PS/CST/Printers/PrintImports.purs @@ -1,62 +1,67 @@ module Language.PS.CST.Printers.PrintImports where -import Prelude (map, ($), (-), (<#>), (<<<), (<>)) +import Prelude -import Language.PS.CST.Printers.Utils (emptyColumn, emptyRow, printConstructors, printModuleName, twoSpaceIdentation, wrapInParentheses) +import Language.PS.CST.Printers.Utils import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved) import Language.PS.CST.Types.Module (DataMembers(..), Import(..), ImportDecl(..)) -import Text.PrettyPrint.Boxes (Box, left, nullBox, text, vcat, vsep, (//), (<<+>>), (<<>>)) +import Data.Array as Array import Data.Foldable (length, null) import Data.Maybe (Maybe(..), fromMaybe, maybe) import Data.Newtype (unwrap) import Data.Unfoldable (replicate) +import Text.Pretty +import Text.Pretty as Pretty +import Text.Pretty.Symbols.String hiding (space) +import Text.Pretty.Code.Purescript (tupled, encloseSep) +import Data.Container.Class -printImports :: Array ImportDecl -> Box -printImports [] = nullBox -printImports imports = - emptyRow - // (vsep 0 left $ map printImport imports) +printImports :: Array ImportDecl -> Doc String +printImports imports = vsep $ map printImport imports -printImport :: ImportDecl -> Box +printImport :: ImportDecl -> Doc String printImport (ImportDecl { moduleName, names, qualification }) = let - head = text "import" <<+>> printModuleName moduleName + head = text "import" <+> printModuleName moduleName - qualification' = qualification <#> (\qualificationModuleName -> text "as" <<+>> printModuleName qualificationModuleName) - - prependSpace x = emptyColumn <<>> x + qualification' :: Doc String + qualification' = maybe emptyDoc (\qualificationModuleName -> text " as" <+> printModuleName qualificationModuleName) qualification in - if null names then - head <<>> maybe nullBox prependSpace qualification' -- in one line - else - let - printImportName :: Import -> Box - printImportName (ImportValue ident) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident - printImportName (ImportOp valueOpName) = wrapInParentheses $ (text <<< appendUnderscoreIfReserved <<< unwrap) valueOpName - printImportName (ImportType properNameTypeName maybeDataMembers) = + case names of + [] -> head <> qualification' -- in one line + _ -> let - printedProperNameTypeName :: Box - printedProperNameTypeName = (text <<< appendUnderscoreIfReserved <<< unwrap) properNameTypeName - - printedMaybeDataMembers :: Box - printedMaybeDataMembers = case maybeDataMembers of - Nothing -> nullBox - (Just DataAll) -> text "(..)" - (Just (DataEnumerated constructors)) -> wrapInParentheses $ printConstructors constructors - in - printedProperNameTypeName <<>> printedMaybeDataMembers - printImportName (ImportTypeOp opName) = text "type" <<+>> (wrapInParentheses $ (text <<< appendUnderscoreIfReserved <<< unwrap) $ opName) - printImportName (ImportClass properName) = text "class" <<+>> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) - printImportName (ImportKind properName) = text "kind" <<+>> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) + exports :: Array (Doc String) + exports = map printImportName names + + exports' = encloseSep (text "(") (text ")") (text ", ") exports - printedNamesColumn = vcat left $ map printImportName names + onV2OnFlatten1Space = flatAlt (text " ") (text " ") + in + group ( vcatOmittingEmpty + [ head + , nest 2 (onV2OnFlatten1Space <> align exports') + ] + ) + <> qualification' - commasColumn = vcat left $ [ text "(" ] <> replicate (length names - 1) (text ",") +printImportName :: Import -> Doc String +printImportName (ImportValue ident) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident +printImportName (ImportOp valueOpName) = parens $ (text <<< appendUnderscoreIfReserved <<< unwrap) valueOpName +printImportName (ImportType properNameTypeName maybeDataMembers) = + let + printedProperNameTypeName :: Doc String + printedProperNameTypeName = (text <<< appendUnderscoreIfReserved <<< unwrap) properNameTypeName - printedNames = twoSpaceIdentation <<>> commasColumn <<+>> printedNamesColumn - in - head - // printedNames - // (twoSpaceIdentation <<>> text ")" <<+>> fromMaybe nullBox qualification') + printedMaybeDataMembers :: Doc String + printedMaybeDataMembers = case maybeDataMembers of + Nothing -> emptyDoc + (Just DataAll) -> text "(..)" + (Just (DataEnumerated constructors)) -> parens $ printConstructors constructors + in + printedProperNameTypeName <> printedMaybeDataMembers +printImportName (ImportTypeOp opName) = text "type" <+> (parens $ (text <<< appendUnderscoreIfReserved <<< unwrap) $ opName) +printImportName (ImportClass properName) = text "class" <+> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) +printImportName (ImportKind properName) = text "kind" <+> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) diff --git a/src/Language/PS/CST/Printers/PrintModuleModuleNameAndExports.purs b/src/Language/PS/CST/Printers/PrintModuleModuleNameAndExports.purs index 2d51b8c..e516b80 100644 --- a/src/Language/PS/CST/Printers/PrintModuleModuleNameAndExports.purs +++ b/src/Language/PS/CST/Printers/PrintModuleModuleNameAndExports.purs @@ -1,47 +1,46 @@ module Language.PS.CST.Printers.PrintModuleModuleNameAndExports where -import Prelude (map, ($), (-), (<<<), (<>)) +import Prelude import Language.PS.CST.Types.Module (DataMembers(..), Export(..)) import Language.PS.CST.Types.Leafs (ModuleName) import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved) -import Language.PS.CST.Printers.Utils (printConstructors, printModuleName, twoSpaceIdentation, wrapInParentheses) +import Language.PS.CST.Printers.Utils -import Text.PrettyPrint.Boxes (Box, left, nullBox, text, vcat, (//), (<<+>>), (<<>>)) import Data.Newtype (unwrap) import Data.Foldable (length) import Data.Maybe (Maybe(..)) import Data.Unfoldable (replicate) +import Text.Pretty +import Text.Pretty.Code.Purescript (encloseSep) +import Text.Pretty.Symbols.String +import Data.Container.Class -printModuleModuleNameAndExports :: ModuleName -> Array Export -> Box -printModuleModuleNameAndExports moduleName [] = text "module" <<+>> printModuleName moduleName <<+>> text "where" +printModuleModuleNameAndExports :: ModuleName -> Array Export -> Doc String +printModuleModuleNameAndExports moduleName [] = text "module" <+> printModuleName moduleName <+> text "where" printModuleModuleNameAndExports moduleName exports = let - printedNamesColumn = vcat left $ map printExportName exports + printedNames = encloseSep (text "(") (text ")") (text ", ") (map printExportName exports) - commasColumn = vcat left $ [ text "(" ] <> replicate (length exports - 1) (text ",") - - printedNames = twoSpaceIdentation <<>> commasColumn <<+>> printedNamesColumn + onV2OnFlatten1Space = flatAlt (text " ") (text " ") in - text "module" <<+>> printModuleName moduleName - // printedNames - // (twoSpaceIdentation <<>> text ")" <<+>> text "where") + text "module" <+> printModuleName moduleName <> line' <> (nest 2 (onV2OnFlatten1Space <> printedNames <+> text "where")) -printExportName :: Export -> Box +printExportName :: Export -> Doc String printExportName (ExportValue ident) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident -printExportName (ExportOp valueOpName) = wrapInParentheses $ (text <<< appendUnderscoreIfReserved <<< unwrap) valueOpName +printExportName (ExportOp valueOpName) = parens $ (text <<< appendUnderscoreIfReserved <<< unwrap) valueOpName printExportName (ExportType properNameTypeName maybeDataMembers) = let - printedProperNameTypeName :: Box + printedProperNameTypeName :: Doc String printedProperNameTypeName = (text <<< appendUnderscoreIfReserved <<< unwrap) properNameTypeName - printedMaybeDataMembers :: Box + printedMaybeDataMembers :: Doc String printedMaybeDataMembers = case maybeDataMembers of - Nothing -> nullBox + Nothing -> emptyDoc (Just DataAll) -> text "(..)" - (Just (DataEnumerated constructors)) -> wrapInParentheses $ printConstructors constructors + (Just (DataEnumerated constructors)) -> parens $ printConstructors constructors in - printedProperNameTypeName <<>> printedMaybeDataMembers -printExportName (ExportTypeOp opName) = text "type" <<+>> (wrapInParentheses $ (text <<< appendUnderscoreIfReserved <<< unwrap) $ opName) -printExportName (ExportClass properName) = text "class" <<+>> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) -printExportName (ExportKind properName) = text "kind" <<+>> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) -printExportName (ExportModule moduleName) = text "module" <<+>> printModuleName moduleName + printedProperNameTypeName <> printedMaybeDataMembers +printExportName (ExportTypeOp opName) = text "type" <+> (parens $ (text <<< appendUnderscoreIfReserved <<< unwrap) $ opName) +printExportName (ExportClass properName) = text "class" <+> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) +printExportName (ExportKind properName) = text "kind" <+> ((text <<< appendUnderscoreIfReserved <<< unwrap) $ properName) +printExportName (ExportModule moduleName) = text "module" <+> printModuleName moduleName diff --git a/src/Language/PS/CST/Printers/TypeLevel.purs b/src/Language/PS/CST/Printers/TypeLevel.purs index ec3d2fa..0e2aa24 100644 --- a/src/Language/PS/CST/Printers/TypeLevel.purs +++ b/src/Language/PS/CST/Printers/TypeLevel.purs @@ -1,30 +1,32 @@ module Language.PS.CST.Printers.TypeLevel where -import Prelude (flip, identity, map, (#), ($), (<#>), (<<<), (==)) +import Data.Container.Class +import Language.PS.CST.Printers.Utils +import Prelude +import Text.Pretty hiding (space) +import Text.Pretty.Symbols.String -import Language.PS.CST.Printers.Utils (emptyColumn, ifelse, maybeWrapInParentheses, printModuleName, wrapInDoubleQuotes, wrapInParentheses) -import Language.PS.CST.Types.Declaration (Constraint(..), DataCtor(..), DataHead(..), Kind(..), Row, Type(..), TypeVarBinding(..)) -import Language.PS.CST.Types.QualifiedName (QualifiedName(..)) -import Language.PS.CST.Types.Leafs (ClassFundep(..), Fixity(..), Ident, Label, OpName, ProperName) -import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved, quoteIfReserved) - -import Data.Array (snoc) as Array +import Data.Array as Array import Data.Foldable (null) import Data.FunctorWithIndex (mapWithIndex) import Data.Identity (Identity(..)) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (unwrap) -import Text.PrettyPrint.Boxes (Box, left, punctuateH, text, vcat, (<<+>>), (<<>>)) +import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved, quoteIfReserved) +import Language.PS.CST.Types.Declaration (Constraint(..), DataCtor(..), DataHead(..), Kind(..), Row, Type(..), TypeVarBinding(..)) +import Language.PS.CST.Types.Leafs (ClassFundep(..), Fixity(..), Ident, Label, OpName, ProperName) +import Language.PS.CST.Types.QualifiedName (QualifiedName(..)) +import Text.Pretty (concatWith) -printFundep :: ClassFundep -> Box -printFundep (FundepDetermines lefts rights) = (punctuateH left emptyColumn $ map (text <<< appendUnderscoreIfReserved <<< unwrap) lefts) <<+>> text "->" <<+>> (punctuateH left emptyColumn $ map (text <<< appendUnderscoreIfReserved <<< unwrap) rights) +printFundep :: ClassFundep -> Doc String +printFundep (FundepDetermines lefts rights) = (vsep $ map (text <<< appendUnderscoreIfReserved <<< unwrap) lefts) <+> text "->" <+> (vsep $ map (text <<< appendUnderscoreIfReserved <<< unwrap) rights) -printFixity :: Fixity -> Box +printFixity :: Fixity -> Doc String printFixity Infix = text "infix" printFixity Infixl = text "infixl" printFixity Infixr = text "infixr" -printDataCtor :: DataCtor -> Box +printDataCtor :: DataCtor -> Doc String printDataCtor (DataCtor dataCtor) = let doWrap :: Type -> Boolean @@ -35,33 +37,29 @@ printDataCtor (DataCtor dataCtor) = doWrap (TypeConstrained _ _) = true doWrap _ = false - context = PrintType_Multiline - - printType' :: Type -> Box - printType' type_ = maybeWrapInParentheses (doWrap type_) $ printType context $ type_ + printType' :: Type -> Doc String + printType' type_ = maybeWrapInParentheses (doWrap type_) $ printType type_ name = (text <<< appendUnderscoreIfReserved <<< unwrap) dataCtor.dataCtorName fields = dataCtor.dataCtorFields <#> printType' - - printedFields = vcat left fields in - name <<+>> printedFields + group $ concatWith (surroundOmittingEmpty line) $ [name, concatWith (surroundOmittingEmpty line') $ fields] -printDataHead :: Box -> DataHead -> Box +printDataHead :: Doc String -> DataHead -> Doc String printDataHead reservedWord (DataHead dataHead) = let - head = reservedWord <<+>> (text <<< appendUnderscoreIfReserved <<< unwrap) dataHead.dataHdName + head = reservedWord <+> (text <<< appendUnderscoreIfReserved <<< unwrap) dataHead.dataHdName vars = map printTypeVarBinding dataHead.dataHdVars in - if null vars then head else head <<+>> punctuateH left (emptyColumn) vars + if null vars then head else head <+> vsep vars -printTypeVarBinding :: TypeVarBinding -> Box +printTypeVarBinding :: TypeVarBinding -> Doc String printTypeVarBinding (TypeVarName ident) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident -printTypeVarBinding (TypeVarKinded ident kind_) = wrapInParentheses $ (text <<< appendUnderscoreIfReserved <<< unwrap) ident <<+>> text "::" <<+>> printKind kind_ +printTypeVarBinding (TypeVarKinded ident kind_) = parens $ (text <<< appendUnderscoreIfReserved <<< unwrap) ident <+> text "::" <+> printKind kind_ -printKind :: Kind -> Box +printKind :: Kind -> Doc String printKind (KindName qualifiedKindName) = printQualifiedName_AnyProperNameType qualifiedKindName printKind (KindArr kindLeft_ kindRight_) = let @@ -71,140 +69,94 @@ printKind (KindArr kindLeft_ kindRight_) = printedLeft = printKind kindLeft_ - printedLeft' = if isComplex kindLeft_ then wrapInParentheses printedLeft else printedLeft + printedLeft' = if isComplex kindLeft_ then parens printedLeft else printedLeft in - printedLeft' <<+>> text "->" <<+>> printKind kindRight_ -printKind (KindRow kind_) = text "#" <<+>> printKind kind_ + printedLeft' <+> text "->" <+> printKind kindRight_ +printKind (KindRow kind_) = text "#" <+> printKind kind_ -printQualifiedName_Ident :: QualifiedName Ident -> Box +printQualifiedName_Ident :: QualifiedName Ident -> Doc String printQualifiedName_Ident (QualifiedName qualifiedName) = case qualifiedName.qualModule of Nothing -> (text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName - (Just moduleName) -> printModuleName moduleName <<>> text "." <<>> (text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName + (Just moduleName) -> printModuleName moduleName <> text "." <> (text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName -printQualifiedName_AnyProperNameType :: ∀ proxy. QualifiedName (ProperName proxy) -> Box +printQualifiedName_AnyProperNameType :: ∀ proxy. QualifiedName (ProperName proxy) -> Doc String printQualifiedName_AnyProperNameType (QualifiedName qualifiedName) = case qualifiedName.qualModule of Nothing -> (text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName - (Just moduleName) -> printModuleName moduleName <<>> text "." <<>> (text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName + (Just moduleName) -> printModuleName moduleName <> text "." <> (text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName -printQualifiedName_AnyOpNameType :: ∀ proxy. QualifiedName (OpName proxy) -> Box +printQualifiedName_AnyOpNameType :: ∀ proxy. QualifiedName (OpName proxy) -> Doc String printQualifiedName_AnyOpNameType (QualifiedName qualifiedName) = case qualifiedName.qualModule of Nothing -> (text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName - (Just moduleName) -> printModuleName moduleName <<>> text "." <<>> wrapInParentheses ((text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName) - --- Prefer multiline when first enter the rendering function, prefer one line when inside of row extensions (i.e. `MyExt + MyOtherExt` in `( foo :: Bar | MyExt + MyOtherExt )`) -data PrintType_Style - = PrintType_Multiline - | PrintType_OneLine - -printType :: PrintType_Style -> Type -> Box -printType printType_Style (TypeVar ident) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident -printType printType_Style (TypeConstructor qualifiedTypeName) = printQualifiedName_AnyProperNameType qualifiedTypeName -printType printType_Style TypeWildcard = text "_" -printType printType_Style (TypeHole ident) = text "?" <<>> (text <<< appendUnderscoreIfReserved <<< unwrap) ident -printType printType_Style (TypeString string) = wrapInDoubleQuotes $ text string -printType printType_Style (TypeRow row) = printRowLikeType printType_Style (text "(") (text ")") row -printType printType_Style (TypeRecord row) = printRowLikeType printType_Style (text "{") (text "}") row -printType printType_Style (TypeApp leftType rightType) = - let - doWrapRight = - case rightType of - (TypeApp _ _) -> true -- always wrap right side application - (TypeForall _ _) -> true - (TypeArr _ _) -> true - (TypeOp _ _ _) -> true - (TypeConstrained _ _) -> true - _ -> false - in unwrap do - -- traceM "--------------------------------" - -- traceM "printType_Style.printType_IsInsideOfApp" - -- traceM (printType_Style.printType_IsInsideOfApp) - -- traceM "doWrapRight" - -- traceM (doWrapRight) - -- traceM "leftType" - -- traceM leftType - -- traceM "rightType" - -- traceM rightType - let - printedLeft :: Box - printedLeft = printType PrintType_OneLine leftType - - printedRight :: Box - printedRight = printType PrintType_OneLine rightType - - printed :: Box - printed = printedLeft <<+>> maybeWrapInParentheses doWrapRight printedRight - Identity printed -printType printType_Style (TypeForall typeVarBindings type_) = - let - newContext = printType_Style - in - text "forall" <<+>> punctuateH left (emptyColumn) (map printTypeVarBinding typeVarBindings) <<+>> text "." <<+>> printType newContext type_ -printType printType_Style (TypeArr leftType rightType) = - let - newContext = printType_Style - in - printType newContext leftType <<+>> text "->" <<+>> printType newContext rightType -printType printType_Style (TypeKinded type_ kind_) = - let - newContext = printType_Style - in - wrapInParentheses $ printType newContext type_ <<+>> text "::" <<+>> printKind kind_ -printType printType_Style (TypeOp leftType qualifiedOpName rightType) = - let - newContext = printType_Style - in - printType newContext leftType <<+>> printQualifiedName_AnyOpNameType qualifiedOpName <<+>> printType newContext rightType -printType printType_Style (TypeConstrained constraint type_) = - let - newContext = PrintType_OneLine - in - printConstraint constraint <<+>> text "=>" <<+>> printType newContext type_ - -printConstraint :: Constraint -> Box + (Just moduleName) -> printModuleName moduleName <> text "." <> parens ((text <<< appendUnderscoreIfReserved <<< unwrap) qualifiedName.qualName) + +printType :: Type -> Doc String +printType = \type_ -> case type_ of + (TypeApp _ _) -> group $ printTypeImplementation type_ + (TypeForall _ _) -> group $ printTypeImplementation type_ + (TypeConstrained _ _) -> group $ printTypeImplementation type_ + (TypeArr _ _) -> group $ printTypeImplementation type_ + _ -> printTypeImplementation type_ + where + printTypeImplementation (TypeVar ident) = (text <<< appendUnderscoreIfReserved <<< unwrap) ident + printTypeImplementation (TypeConstructor qualifiedTypeName) = printQualifiedName_AnyProperNameType qualifiedTypeName + printTypeImplementation TypeWildcard = text "_" + printTypeImplementation (TypeHole ident) = text "?" <> (text <<< appendUnderscoreIfReserved <<< unwrap) ident + printTypeImplementation (TypeString string) = dquotes $ text string + printTypeImplementation (TypeRow row) = printRowLikeType (text "(") (text ")") row + printTypeImplementation (TypeRecord row) = printRowLikeType (text "{") (text "}") row + printTypeImplementation (TypeApp leftType rightType) = + let + doWrapRight = + case rightType of + (TypeApp _ _) -> true -- always wrap right side application + (TypeForall _ _) -> true + (TypeArr _ _) -> true + (TypeOp _ _ _) -> true + (TypeConstrained _ _) -> true + _ -> false + + printedLeft :: Doc String + printedLeft = printTypeImplementation leftType + + printedRight :: Doc String + printedRight = printTypeImplementation rightType + in align $ concatWith (surround line) $ [ printedLeft, maybeWrapInParentheses doWrapRight printedRight ] + printTypeImplementation (TypeForall typeVarBindings type_) = text "forall" <+> concatWithNonEmpty (surroundOmittingEmpty line) (map printTypeVarBinding typeVarBindings) <+> text "." <+> printTypeImplementation type_ + printTypeImplementation (TypeArr leftType rightType) = printTypeImplementation leftType <+> text "->" <+> printTypeImplementation rightType + printTypeImplementation (TypeKinded type_ kind_) = parens $ printTypeImplementation type_ <+> text "::" <+> printKind kind_ + printTypeImplementation (TypeOp leftType qualifiedOpName rightType) = printTypeImplementation leftType <+> printQualifiedName_AnyOpNameType qualifiedOpName <+> printTypeImplementation rightType + printTypeImplementation (TypeConstrained constraint type_) = printConstraint constraint <+> text "=>" <+> printTypeImplementation type_ + +printConstraint :: Constraint -> Doc String printConstraint (Constraint { className, args }) = - let - context = PrintType_OneLine - in - if null args - then printQualifiedName_AnyProperNameType className - else printQualifiedName_AnyProperNameType className <<+>> (punctuateH left (emptyColumn) $ map (printType context) args) + if null args + then printQualifiedName_AnyProperNameType className + else printQualifiedName_AnyProperNameType className <+> (align $ group $ concatWith (surround line) $ map printType args) -printRowLikeType :: PrintType_Style -> Box -> Box -> Row -> Box -printRowLikeType _ leftWrapper rightWrapper row@({ rowLabels: [], rowTail: Nothing }) = leftWrapper <<>> rightWrapper -printRowLikeType _ leftWrapper rightWrapper row@({ rowLabels: [], rowTail: Just rowTail }) = - let - context = PrintType_OneLine - in - leftWrapper <<+>> text "|" <<+>> printType context rowTail <<+>> rightWrapper -printRowLikeType PrintType_OneLine leftWrapper rightWrapper row@({ rowLabels, rowTail }) = +printRowLikeType :: Doc String -> Doc String -> Row -> Doc String +printRowLikeType leftWrapper rightWrapper row = let - context = PrintType_OneLine - - printedTail = rowTail <#> printType context <#> (text "|" <<+>> _) - - printedRowLabels = - rowLabels - <#> printRowLabel context - # punctuateH left (text ", ") - # maybe identity (\tail rowLine -> rowLine <<+>> tail) printedTail - # (\x -> leftWrapper <<+>> x <<+>> rightWrapper) - in - printedRowLabels -printRowLikeType PrintType_Multiline leftWrapper rightWrapper row = - let - context = PrintType_Multiline - - printedTail = row.rowTail <#> printType context <#> (text "|" <<+>> _) - - printedRowLabels = - row.rowLabels - <#> printRowLabel context - # mapWithIndex (\i box -> ifelse (i == 0) leftWrapper (text ",") <<+>> box) - # maybe identity (flip Array.snoc) printedTail - # flip Array.snoc rightWrapper - # vcat left - in - printedRowLabels - -printRowLabel :: PrintType_Style -> { label :: Label, type_ :: Type } -> Box -printRowLabel printType_Style { label, type_ } = (text <<< quoteIfReserved <<< unwrap) label <<+>> text "::" <<+>> printType printType_Style type_ + rowTail :: Doc String + rowTail = + maybe + emptyDoc + (\(rowTail' :: Type) -> text "|" <+> printType rowTail') + row.rowTail + + in case row.rowLabels of + [] -> + case rowTail of + Empty -> leftWrapper <> rightWrapper + _ -> group $ concatWith (surroundOmittingEmpty line) [leftWrapper, rowTail, rightWrapper] + _ -> + let + rowLabelDocs :: Array (Doc String) + rowLabelDocs = row.rowLabels <#> printRowLabel + in align $ group $ concatWith (surroundOmittingEmpty line) + [ concatWith (surroundOmittingEmpty line') $ (Array.zipWith (<>) ([leftWrapper <> space] <> Array.replicate (Array.length rowLabelDocs - 1) (text ", ")) (map align rowLabelDocs)) + , rowTail + , rightWrapper + ] + +printRowLabel :: { label :: Label, type_ :: Type } -> Doc String +printRowLabel { label, type_ } = (text <<< quoteIfReserved <<< unwrap) label <+> text "::" <+> printType type_ diff --git a/src/Language/PS/CST/Printers/Utils.purs b/src/Language/PS/CST/Printers/Utils.purs index c521fe7..7a74b42 100644 --- a/src/Language/PS/CST/Printers/Utils.purs +++ b/src/Language/PS/CST/Printers/Utils.purs @@ -1,49 +1,23 @@ module Language.PS.CST.Printers.Utils where +import Data.Container.Class +import Language.PS.CST.Types.Declaration +import Language.PS.CST.Types.Leafs +import Prelude +import Text.Pretty +import Text.Pretty.Symbols.String + import Data.Foldable (class Foldable) import Data.List (List(..), (:)) import Data.List (fromFoldable) as List import Data.Maybe (Maybe(..)) import Data.Newtype (unwrap) -import Language.PS.CST.Types.Leafs (ModuleName(..), ProperName, ProperNameType_ConstructorName) -import Prelude (identity, map, (#), (<<<), (>>>)) -import Text.PrettyPrint.Boxes (Box, emptyBox, hsep, left, nullBox, punctuateH, text, vsep, (//), (<<>>)) - -line :: ∀ f. Foldable f => f Box -> Box -line = hsep 1 left - -lines :: ∀ f. Foldable f => f Box -> Box -lines = vsep 0 left - -emptyRow :: Box -emptyRow = emptyBox 1 0 - -emptyColumn :: Box -emptyColumn = emptyBox 0 1 - -printModuleName :: ModuleName -> Box -printModuleName (ModuleName nonEmptyArray) = - nonEmptyArray - # map (unwrap >>> text) - # punctuateH left (text ".") -wrapInParentheses :: Box -> Box -wrapInParentheses x = text "(" <<>> x <<>> text ")" +printModuleName :: ModuleName -> Doc String +printModuleName (ModuleName nonEmptyArray) = concatWithNonEmpty (surroundOmittingEmpty dot) $ map (unwrap >>> text) nonEmptyArray -wrapInDoubleQuotes :: Box -> Box -wrapInDoubleQuotes x = text "\"" <<>> x <<>> text "\"" - -punctuateWithComma :: ∀ f. Foldable f => f Box -> Box -punctuateWithComma = punctuateH left (text ", ") - -twoSpaceIdentation :: Box -twoSpaceIdentation = emptyBox 0 2 - -printConstructors :: Array (ProperName ProperNameType_ConstructorName) -> Box -printConstructors = punctuateWithComma <<< map (text <<< unwrap) - -ifelse :: forall a. Boolean -> a -> a -> a -ifelse p a b = if p then a else b +printConstructors :: Array (ProperName ProperNameType_ConstructorName) -> Doc String +printConstructors = concatWith (surroundOmittingEmpty (text ", ")) <<< map (text <<< unwrap) foldWithPrev :: ∀ a b . (b -> Maybe a -> a -> b) -> b -> List a -> b foldWithPrev _ default' Nil = default' @@ -51,23 +25,37 @@ foldWithPrev fun default' list = foo default' Nothing list where foo acc _ Nil = acc foo acc prev (x : xs) = foo (fun acc prev x) (Just x) xs -maybeWrapInParentheses :: Boolean -> Box -> Box -maybeWrapInParentheses b = if b then wrapInParentheses else identity +maybeWrapInParentheses :: Boolean -> Doc String -> Doc String +maybeWrapInParentheses b = if b then parens else identity -printAndConditionallyAddNewlinesBetween :: ∀ a f . Foldable f => (a -> a -> Boolean) -> (a -> Box) -> f a -> Box -printAndConditionallyAddNewlinesBetween shouldBeNoNewlines print xs = +printAndConditionallyAddNewlinesBetween :: ∀ a f . Foldable f => (a -> a -> Boolean) -> (a -> Doc String) -> f a -> Doc String +printAndConditionallyAddNewlinesBetween shouldBeNoNewlines print = let - xs' :: List a - xs' = List.fromFoldable xs - - foldDeclaration :: Box -> Maybe a -> a -> Box - foldDeclaration accum Nothing current = accum // print current -- nullBox deactivates // - foldDeclaration accum (Just prev) current = accum // - if shouldBeNoNewlines prev current - then print current - else emptyRow // print current + foldDeclaration :: Doc String -> Maybe a -> a -> Doc String + foldDeclaration accum Nothing current = print current + foldDeclaration accum (Just prev) current = if shouldBeNoNewlines prev current + then accum <> line' <> print current + else accum <> line' <> hardline <> (print current) in - foldWithPrev foldDeclaration nullBox xs' - --- traceId :: forall t2. t2 -> t2 --- traceId a = trace a (const a) + foldWithPrev foldDeclaration emptyDoc <<< List.fromFoldable + +shouldBeNoNewlineBetweenDeclarations :: Declaration -> Declaration -> Boolean +shouldBeNoNewlineBetweenDeclarations (DeclSignature { ident }) (DeclValue { valueBindingFields: { name } }) = ident == name +shouldBeNoNewlineBetweenDeclarations (DeclValue { valueBindingFields: { name } }) (DeclValue { valueBindingFields: { name: nameNext } }) = name == nameNext +shouldBeNoNewlineBetweenDeclarations _ _ = false + +shouldBeNoNewlineBetweenLetBindings :: LetBinding -> LetBinding -> Boolean +shouldBeNoNewlineBetweenLetBindings (LetBindingSignature { ident }) (LetBindingName { name }) = ident == name +shouldBeNoNewlineBetweenLetBindings (LetBindingName { name }) (LetBindingName { name: nameNext }) = name == nameNext +shouldBeNoNewlineBetweenLetBindings _ _ = false + +shouldBeNoNewlineBetweenInstanceBindings :: InstanceBinding -> InstanceBinding -> Boolean +shouldBeNoNewlineBetweenInstanceBindings (InstanceBindingSignature { ident }) (InstanceBindingName { name }) = ident == name +shouldBeNoNewlineBetweenInstanceBindings (InstanceBindingName { name }) (InstanceBindingName { name: nameNext }) = name == nameNext +shouldBeNoNewlineBetweenInstanceBindings _ _ = false + +exprShouldBeOnNextLine :: Expr -> Boolean +exprShouldBeOnNextLine (ExprLet _) = true +exprShouldBeOnNextLine (ExprCase _) = true +exprShouldBeOnNextLine (ExprIf _) = true +exprShouldBeOnNextLine _ = false diff --git a/src/Language/PS/CST/Sugar/Declaration.purs b/src/Language/PS/CST/Sugar/Declaration.purs index d947e3c..996cb9e 100644 --- a/src/Language/PS/CST/Sugar/Declaration.purs +++ b/src/Language/PS/CST/Sugar/Declaration.purs @@ -4,7 +4,7 @@ import Language.PS.CST.Types.Declaration (Type(..)) import Language.PS.CST.Types.Leafs (ProperName(..)) import Language.PS.CST.Sugar.QualifiedName (nonQualifiedName) import Language.PS.CST.Sugar.Leafs (mkRowLabels) -import Prelude (($)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Tuple.Nested (type (/\)) diff --git a/src/Language/PS/CST/Sugar/Leafs.purs b/src/Language/PS/CST/Sugar/Leafs.purs index aad9d85..a56b314 100644 --- a/src/Language/PS/CST/Sugar/Leafs.purs +++ b/src/Language/PS/CST/Sugar/Leafs.purs @@ -1,7 +1,7 @@ module Language.PS.CST.Sugar.Leafs where import Language.PS.CST.Types.Leafs -import Prelude (map, (<<<)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty (NonEmptyArray) diff --git a/src/Language/PS/CST/Types/Leafs.purs b/src/Language/PS/CST/Types/Leafs.purs index 38d5c0d..2d7fe1b 100644 --- a/src/Language/PS/CST/Types/Leafs.purs +++ b/src/Language/PS/CST/Types/Leafs.purs @@ -1,6 +1,6 @@ module Language.PS.CST.Types.Leafs where -import Prelude (class Eq, class Functor, class Ord, class Show, mempty, pure, show, (<$>), (<>)) +import Prelude import Data.Array.NonEmpty (NonEmptyArray) import Data.Foldable (class Foldable, foldlDefault, foldrDefault) diff --git a/src/Language/PS/CST/Types/Module.purs b/src/Language/PS/CST/Types/Module.purs index 386b460..649904d 100644 --- a/src/Language/PS/CST/Types/Module.purs +++ b/src/Language/PS/CST/Types/Module.purs @@ -1,6 +1,6 @@ module Language.PS.CST.Types.Module where -import Prelude (class Eq, class Ord, class Show) +import Prelude import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) diff --git a/src/Language/PS/CST/Types/QualifiedName.purs b/src/Language/PS/CST/Types/QualifiedName.purs index 6c99e63..a33826d 100644 --- a/src/Language/PS/CST/Types/QualifiedName.purs +++ b/src/Language/PS/CST/Types/QualifiedName.purs @@ -1,6 +1,6 @@ module Language.PS.CST.Types.QualifiedName where -import Prelude (class Eq, class Functor, class Ord, class Show, show, (<>)) +import Prelude import Data.Maybe (Maybe) import Data.Newtype (class Newtype) diff --git a/src/Language/PS/SmartCST/ProcessModule.purs b/src/Language/PS/SmartCST/ProcessModule.purs index 80c060f..620de49 100644 --- a/src/Language/PS/SmartCST/ProcessModule.purs +++ b/src/Language/PS/SmartCST/ProcessModule.purs @@ -3,12 +3,12 @@ module Language.PS.SmartCST.ProcessModule where import Data.Tuple.Nested ((/\)) import Language.PS.CST.Types.Leafs (ModuleName) import Language.PS.CST.Types.Module (Export, ImportDecl(..)) -import Prelude ((/=), (<<<)) +import Prelude import Data.Array as Array import Language.PS.SmartCST.Types.Declaration as SmartCST.Declaration import Language.PS.SmartCST.ProcessSmartDeclaration as Language.PS.SmartCST.ProcessSmartDeclaration -import Text.PrettyPrint.Boxes (render) as Text.PrettyPrint.Boxes +import Text.Pretty as Text.Pretty import Language.PS.CST.Printers as Language.PS.CST.Printers import Language.PS.CST.Types.Module as Language.PS.CST.Types.Module @@ -32,5 +32,5 @@ moduleToCstModule (Module module_) = , declarations } -printModuleToString :: Module -> String -printModuleToString = Text.PrettyPrint.Boxes.render <<< Language.PS.CST.Printers.printModule <<< moduleToCstModule +printModuleToString :: Int -> Module -> String +printModuleToString width = Text.Pretty.render width <<< Language.PS.CST.Printers.printModule <<< moduleToCstModule diff --git a/src/Language/PS/SmartCST/ProcessSmartDeclaration.purs b/src/Language/PS/SmartCST/ProcessSmartDeclaration.purs index c3b7ed1..8dbf76b 100644 --- a/src/Language/PS/SmartCST/ProcessSmartDeclaration.purs +++ b/src/Language/PS/SmartCST/ProcessSmartDeclaration.purs @@ -8,7 +8,7 @@ import Language.PS.CST.Types.QualifiedName (QualifiedName(..)) import Language.PS.SmartCST.ProcessSmartDeclaration.Utils (findAndModifyOrNew) import Language.PS.SmartCST.Types.SmartQualifiedNameConstructor (SmartQualifiedNameConstructor(..)) import Language.PS.SmartCST.Types.SmartQualifiedName (SmartQualifiedName(..)) -import Prelude (bind, discard, flip, pure, (#), ($), (<$>), (<*>), (==)) +import Prelude import Control.Monad.Reader (ReaderT, ask, runReaderT) import Control.Monad.State (State, modify_, runState) diff --git a/src/Language/PS/SmartCST/Sugar/Declaration.purs b/src/Language/PS/SmartCST/Sugar/Declaration.purs index 307218f..3a8bfdc 100644 --- a/src/Language/PS/SmartCST/Sugar/Declaration.purs +++ b/src/Language/PS/SmartCST/Sugar/Declaration.purs @@ -4,7 +4,7 @@ import Language.PS.SmartCST.Types.Declaration (Type(..)) import Language.PS.SmartCST.Types.SmartQualifiedName (SmartQualifiedName(..)) import Language.PS.CST.Types.Leafs (ProperName(..)) import Language.PS.CST.Sugar.Leafs (mkModuleName, mkRowLabels) -import Prelude (($)) +import Prelude import Data.Array.NonEmpty as NonEmpty import Data.Maybe (Maybe(..)) diff --git a/src/Language/PS/SmartCST/Types/SmartQualifiedName.purs b/src/Language/PS/SmartCST/Types/SmartQualifiedName.purs index 3623684..07dcc2b 100644 --- a/src/Language/PS/SmartCST/Types/SmartQualifiedName.purs +++ b/src/Language/PS/SmartCST/Types/SmartQualifiedName.purs @@ -1,6 +1,6 @@ module Language.PS.SmartCST.Types.SmartQualifiedName where -import Prelude (class Functor) +import Prelude import Language.PS.CST.Types.Leafs (ModuleName) diff --git a/test/Golden/Application/Actual.purs b/test/Golden/Application/Actual.purs index bbaa1e9..b8c3bfc 100644 --- a/test/Golden/Application/Actual.purs +++ b/test/Golden/Application/Actual.purs @@ -4,7 +4,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/Array/Expected.txt b/test/Golden/Array/Expected.txt deleted file mode 100644 index da326b1..0000000 --- a/test/Golden/Array/Expected.txt +++ /dev/null @@ -1,68 +0,0 @@ -module Array where - -f :: Array { x :: Int, y :: Boolean } -f = - [ { x: 1 - , y: - true - } - , { x: 10, y: false } - , { x: 0 - , y: true - } - ] - -g :: Array Boolean -g = - [ ( true || false && true - ) - , ( true - || true - && true - || false - ) - ] - -h :: Array Int -h = [ 1, 2, 3, 4, 5, 6 ] - -i :: Array String -i = - [ "hello" - , """ -there""" - , "this" - , """ - is quite the `Array String` """ - ] - -j :: Array (Array (Array Int)) -j = - [ [ [ 1, 2, 3, 4, 5 ], [ 6, 7 ] ] - , [ [ 8 ] - , [ 9, 10 ] - ] - , [ [ 11 - , 12 - , 13 - ] - , 14 - ] - ] - -k :: Array (Array Int) -k = - [ identity - [ 1 - , 2 - , 3 - ] - , [ 4 - , 5 - , 6 - ] - `const` - [ 7 - , 8 - ] - ] diff --git a/test/Golden/Boolean/Actual.purs b/test/Golden/Boolean/Actual.purs index 0530c24..ccad9af 100644 --- a/test/Golden/Boolean/Actual.purs +++ b/test/Golden/Boolean/Actual.purs @@ -4,7 +4,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/Case/Actual.purs b/test/Golden/Case/Actual.purs index c663037..f8610bc 100644 --- a/test/Golden/Case/Actual.purs +++ b/test/Golden/Case/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/DeclClass/Actual.purs b/test/Golden/DeclClass/Actual.purs index 296fa5e..3dee096 100644 --- a/test/Golden/DeclClass/Actual.purs +++ b/test/Golden/DeclClass/Actual.purs @@ -4,7 +4,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/DeclData/Actual.purs b/test/Golden/DeclData/Actual.purs index d8b2df4..cfb815e 100644 --- a/test/Golden/DeclData/Actual.purs +++ b/test/Golden/DeclData/Actual.purs @@ -1,6 +1,6 @@ module Test.Golden.DeclData.Actual where -import Prelude (($)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty diff --git a/test/Golden/DeclData/Expected.txt b/test/Golden/DeclData/Expected.txt index 47ac54a..cce5bc7 100644 --- a/test/Golden/DeclData/Expected.txt +++ b/test/Golden/DeclData/Expected.txt @@ -4,6 +4,4 @@ module DeclData where line1 line2 -} -data Foo - = Bar - | Baz +data Foo = Bar | Baz diff --git a/test/Golden/DeclDataComplex/Actual.purs b/test/Golden/DeclDataComplex/Actual.purs index 1fdc797..ede74bd 100644 --- a/test/Golden/DeclDataComplex/Actual.purs +++ b/test/Golden/DeclDataComplex/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty import Data.Tuple.Nested ((/\)) -import Prelude (($)) +import Prelude dataMapMap :: Type -> Type -> Type dataMapMap x y = diff --git a/test/Golden/DeclDataComplex/Expected.txt b/test/Golden/DeclDataComplex/Expected.txt index da84e1c..6797396 100644 --- a/test/Golden/DeclDataComplex/Expected.txt +++ b/test/Golden/DeclDataComplex/Expected.txt @@ -1,55 +1,73 @@ module DeclDataComplex where data Foo - = Bar Boolean - { foo :: Number - , bar :: { baz :: Data.Map.Map String Number - } - , qwe :: { rty :: Data.Map.Map { asd :: Number } { foo :: Number, bar :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean } - , uio :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean - } - } - a - (Array a) - (Array { foo :: Number }) - _ - ?myhole - "PsString" - () - ( | MyExtension ) - ( rowField :: Number - ) - ( rowField :: Number - | MyExtension - ) - ( rowField :: Number - , rowField2 :: Number - ) - ( rowField :: Number - , rowField2 :: Number - | MyExtension - ) - ( rowField :: Number - , rowField2 :: Number - | MyExtension + MyOtherExtension - ) - ( rowField :: Number - , rowField2 :: Number - | MyExtension + MyOtherExtension { someField :: Number } - ) - ( rowField :: { foo :: Number - , bar :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean - , baz :: Complex A B C D E F G H - , qux :: Complex (A B C) D E (F G H) - , asd :: Complex A B (C (D E) F G) H - , qwe :: Complex (A B C) D E (F (G H)) + = Bar + Boolean + { foo :: Number + , bar :: { baz :: Data.Map.Map String Number } + , qwe :: { rty :: Data.Map.Map + { asd :: Number } + { foo :: Number + , bar :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean } - ) - (forall a (b :: # Type) . Array a) - (Array a -> Maybe a) - (Array ~> Maybe) - (forall f . Functor f => f ~> Maybe) - (MyClass f g k => MyClass2 { foo :: Number } => f) - (MyKindedType :: (CustomKind -> # Type) -> Type) - (MyKindedType :: CustomKind -> # Type -> Type) + , uio :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean + } + } + a + (Array a) + (Array { foo :: Number }) + _ + ?myhole + "PsString" + () + ( | MyExtension ) + ( rowField :: Number ) + ( rowField :: Number | MyExtension ) + ( rowField :: Number, rowField2 :: Number ) + ( rowField :: Number, rowField2 :: Number | MyExtension ) + ( rowField :: Number, rowField2 :: Number | MyExtension + MyOtherExtension ) + ( rowField :: Number + , rowField2 :: Number + | MyExtension + MyOtherExtension + { someField :: Number } + ) + ( rowField :: { foo :: Number + , bar :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean + , baz :: Complex A B C D E F G H + , qux :: Complex (A B C) D E (F G H) + , asd :: Complex A B (C (D E) F G) H + , qwe :: Complex (A B C) D E (F (G H)) + } + ) + (forall a (b :: # Type) . Array a) + (Array a -> Maybe a) + (Array ~> Maybe) + (forall f . Functor f => f ~> Maybe) + (MyClass f g k => MyClass2 { foo :: Number } => f) + (MyKindedType :: (CustomKind -> # Type) -> Type) + (MyKindedType :: CustomKind -> # Type -> Type) | Baz Prelude.Boolean diff --git a/test/Golden/DeclDerive/Actual.purs b/test/Golden/DeclDerive/Actual.purs index 9e509ac..7d2d4db 100644 --- a/test/Golden/DeclDerive/Actual.purs +++ b/test/Golden/DeclDerive/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty import Data.Tuple.Nested ((/\)) -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module @@ -78,5 +78,21 @@ actualModule = Module , instTypes: NonEmpty.singleton $ (TypeConstructor $ nonQualifiedName $ ProperName "Tuple") `TypeApp` (TypeVar $ Ident "a") `TypeApp` (TypeVar $ Ident "b") } } + , DeclDerive + { comments: Nothing + , deriveType: DeclDeriveType_Odrinary + , head: + { instName: Ident "foo" + , instConstraints: + [ Constraint { className: nonQualifiedName (ProperName "Foo"), args: [TypeVar $ Ident "a"] } + , Constraint { className: nonQualifiedName (ProperName "Bar"), args: [TypeVar $ Ident "b", TypeVar $ Ident "c"] } + , Constraint { className: nonQualifiedName (ProperName "Partial"), args: [] } + , Constraint { className: nonQualifiedName (ProperName "Partial1"), args: [] } + , Constraint { className: nonQualifiedName (ProperName "Partial2"), args: [] } + ] + , instClass: nonQualifiedName $ ProperName "Foo" + , instTypes: NonEmpty.singleton $ (TypeConstructor $ nonQualifiedName $ ProperName "Tuple") `TypeApp` (TypeVar $ Ident "a") `TypeApp` (TypeVar $ Ident "b") + } + } ] } diff --git a/test/Golden/DeclDerive/Expected.txt b/test/Golden/DeclDerive/Expected.txt index 9ff098c..58f9c6d 100644 --- a/test/Golden/DeclDerive/Expected.txt +++ b/test/Golden/DeclDerive/Expected.txt @@ -9,3 +9,10 @@ derive instance foo :: Foo Bar { foo :: Number } derive instance foo :: Foo a => Foo (Array a) derive instance foo :: (Foo a, Bar b c, Partial) => Foo (Tuple a b) + +derive instance foo :: ( Foo a + , Bar b c + , Partial + , Partial1 + , Partial2 + ) => Foo (Tuple a b) diff --git a/test/Golden/DeclFixity/Actual.purs b/test/Golden/DeclFixity/Actual.purs index cfac27d..14be55c 100644 --- a/test/Golden/DeclFixity/Actual.purs +++ b/test/Golden/DeclFixity/Actual.purs @@ -4,7 +4,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude import Data.Either (Either(..)) actualModule :: Module diff --git a/test/Golden/DeclForeign/Actual.purs b/test/Golden/DeclForeign/Actual.purs index 308a72b..95349ad 100644 --- a/test/Golden/DeclForeign/Actual.purs +++ b/test/Golden/DeclForeign/Actual.purs @@ -1,7 +1,7 @@ module Test.Golden.DeclForeign.Actual where import Language.PS.CST -import Prelude (($)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty diff --git a/test/Golden/DeclForeign/Expected.txt b/test/Golden/DeclForeign/Expected.txt index b35d055..6bde07b 100644 --- a/test/Golden/DeclForeign/Expected.txt +++ b/test/Golden/DeclForeign/Expected.txt @@ -4,4 +4,6 @@ foreign import kind Foo foreign import data Foo :: # Type -> Type -foreign import main_ :: forall e . Eff ( console :: CONSOLE, foo :: FOO | e ) Unit +foreign import main_ :: forall e . Eff + ( console :: CONSOLE, foo :: FOO | e ) + Unit diff --git a/test/Golden/DeclNewtype/Actual.purs b/test/Golden/DeclNewtype/Actual.purs index 78a0217..7ac394c 100644 --- a/test/Golden/DeclNewtype/Actual.purs +++ b/test/Golden/DeclNewtype/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty import Data.Tuple.Nested ((/\)) -import Prelude (($)) +import Prelude head :: DataHead head = diff --git a/test/Golden/DeclNewtype/Expected.txt b/test/Golden/DeclNewtype/Expected.txt index cf9a3e4..ccb3f7b 100644 --- a/test/Golden/DeclNewtype/Expected.txt +++ b/test/Golden/DeclNewtype/Expected.txt @@ -3,10 +3,29 @@ module DeclNewtype where newtype Foo = Foo Boolean newtype Foo = Foo { foo :: Number - , bar :: { baz :: Data.Map.Map String Number - } - , qwe :: { rty :: Data.Map.Map { asd :: Number } { foo :: Number, bar :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean } - , uio :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean + , bar :: { baz :: Data.Map.Map String Number } + , qwe :: { rty :: Data.Map.Map + { asd :: Number } + { foo :: Number + , bar :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean + } + , uio :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean } } @@ -26,21 +45,13 @@ newtype Foo = Foo () newtype Foo = Foo ( | MyExtension ) -newtype Foo = Foo ( rowField :: Number - ) +newtype Foo = Foo ( rowField :: Number ) -newtype Foo = Foo ( rowField :: Number - | MyExtension - ) +newtype Foo = Foo ( rowField :: Number | MyExtension ) -newtype Foo = Foo ( rowField :: Number - , rowField2 :: Number - ) +newtype Foo = Foo ( rowField :: Number, rowField2 :: Number ) -newtype Foo = Foo ( rowField :: Number - , rowField2 :: Number - | MyExtension - ) +newtype Foo = Foo ( rowField :: Number, rowField2 :: Number | MyExtension ) newtype Foo = Foo ( rowField :: Number , rowField2 :: Number @@ -49,11 +60,20 @@ newtype Foo = Foo ( rowField :: Number newtype Foo = Foo ( rowField :: Number , rowField2 :: Number - | MyExtension + MyOtherExtension { someField :: Number } + | MyExtension + MyOtherExtension + { someField :: Number } ) newtype Foo = Foo ( rowField :: { foo :: Number - , bar :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean + , bar :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean , baz :: Complex A B C D F G H , qux :: Complex (A B C) D (F G H) } diff --git a/test/Golden/DeclType/Actual.purs b/test/Golden/DeclType/Actual.purs index 4f3ed73..8499b42 100644 --- a/test/Golden/DeclType/Actual.purs +++ b/test/Golden/DeclType/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty import Data.Tuple.Nested ((/\)) -import Prelude (($)) +import Prelude head :: DataHead head = diff --git a/test/Golden/DeclType/Expected.txt b/test/Golden/DeclType/Expected.txt index df86741..bf66040 100644 --- a/test/Golden/DeclType/Expected.txt +++ b/test/Golden/DeclType/Expected.txt @@ -3,10 +3,29 @@ module DeclType where type Foo = Boolean type Foo = { foo :: Number - , bar :: { baz :: Data.Map.Map String Number - } - , qwe :: { rty :: Data.Map.Map { asd :: Number } { foo :: Number, bar :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean } - , uio :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean + , bar :: { baz :: Data.Map.Map String Number } + , qwe :: { rty :: Data.Map.Map + { asd :: Number } + { foo :: Number + , bar :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean + } + , uio :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean } } @@ -26,21 +45,13 @@ type Foo = () type Foo = ( | MyExtension ) -type Foo = ( rowField :: Number - ) +type Foo = ( rowField :: Number ) -type Foo = ( rowField :: Number - | MyExtension - ) +type Foo = ( rowField :: Number | MyExtension ) -type Foo = ( rowField :: Number - , rowField2 :: Number - ) +type Foo = ( rowField :: Number, rowField2 :: Number ) -type Foo = ( rowField :: Number - , rowField2 :: Number - | MyExtension - ) +type Foo = ( rowField :: Number, rowField2 :: Number | MyExtension ) type Foo = ( rowField :: Number , rowField2 :: Number @@ -49,11 +60,20 @@ type Foo = ( rowField :: Number type Foo = ( rowField :: Number , rowField2 :: Number - | MyExtension + MyOtherExtension { someField :: Number } + | MyExtension + MyOtherExtension + { someField :: Number } ) type Foo = ( rowField :: { foo :: Number - , bar :: Data.Map.Map (Data.Map.Map (Data.Map.Map Number Boolean) (Data.Map.Map Number Boolean)) Boolean + , bar :: Data.Map.Map + (Data.Map.Map + (Data.Map.Map + Number + Boolean) + (Data.Map.Map + Number + Boolean)) + Boolean , baz :: Complex A B C D F G H , qux :: Complex (A B C) D (F G H) } diff --git a/test/Golden/Exports/Actual.purs b/test/Golden/Exports/Actual.purs index f9ba6ed..63ef753 100644 --- a/test/Golden/Exports/Actual.purs +++ b/test/Golden/Exports/Actual.purs @@ -2,7 +2,7 @@ module Test.Golden.Exports.Actual where import Language.PS.CST -import Prelude (map, ($)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty diff --git a/test/Golden/ExprArray/Actual.purs b/test/Golden/ExprArray/Actual.purs new file mode 100644 index 0000000..8291e14 --- /dev/null +++ b/test/Golden/ExprArray/Actual.purs @@ -0,0 +1,82 @@ +module Test.Golden.ExprArray.Actual where + +import Language.PS.CST +import Prelude + +import Data.Array.NonEmpty as NonEmpty +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.Tuple.Nested (type (/\), (/\)) + +declValue name type_ expr = + [ DeclSignature + { comments: Nothing + , ident: Ident name + , type_ + } + , DeclValue + { comments: Nothing + , valueBindingFields: + { name: Ident name + , binders: [] + , guarded: Unconditional + { expr + , whereBindings: [] + } + } + } + ] + +actualModule :: Module +actualModule = Module + { moduleName: mkModuleName $ NonEmpty.singleton "Array" + , imports: [] + , exports: [] + , declarations: + ( declValue + "f" + ( (TypeConstructor $ nonQualifiedName (ProperName "Array")) + `TypeApp` + (TypeRecord + { rowLabels: + mkRowLabels + [ "x" /\ TypeConstructor (nonQualifiedName (ProperName "Int")) + , "y" /\ TypeConstructor (nonQualifiedName (ProperName "Boolean")) + ] + , rowTail: Nothing + } + ) + ) + ( ExprArray + [ ExprRecord [ RecordField (Label "x") (ExprNumber (Left 1)), RecordField (Label "y") (ExprBoolean true) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 10)), RecordField (Label "y") (ExprBoolean false) ] + ] + ) + ) <> + ( declValue + "f" + ( (TypeConstructor $ nonQualifiedName (ProperName "Array")) + `TypeApp` + (TypeRecord + { rowLabels: + mkRowLabels + [ "x" /\ TypeConstructor (nonQualifiedName (ProperName "Int")) + , "y" /\ TypeConstructor (nonQualifiedName (ProperName "Boolean")) + ] + , rowTail: Nothing + } + ) + ) + ( ExprArray + [ ExprRecord [ RecordField (Label "x") (ExprNumber (Left 1)), RecordField (Label "y") (ExprBoolean true) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 10)), RecordField (Label "y") (ExprBoolean false) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 0)), RecordField (Label "y") (ExprBoolean true) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 1)), RecordField (Label "y") (ExprBoolean true) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 1)), RecordField (Label "y") (ExprBoolean true) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 1)), RecordField (Label "y") (ExprBoolean true) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 1)), RecordField (Label "y") (ExprBoolean true) ] + , ExprRecord [ RecordField (Label "x") (ExprNumber (Left 1)), RecordField (Label "y") (ExprBoolean true) ] + ] + ) + ) + } diff --git a/test/Golden/ExprArray/Expected.txt b/test/Golden/ExprArray/Expected.txt new file mode 100644 index 0000000..d443bb7 --- /dev/null +++ b/test/Golden/ExprArray/Expected.txt @@ -0,0 +1,15 @@ +module Array where + +f :: Array { x :: Int, y :: Boolean } +f = [{ x: 1, y: true }, { x: 10, y: false }] + +f :: Array { x :: Int, y :: Boolean } +f = [ { x: 1, y: true } + , { x: 10, y: false } + , { x: 0, y: true } + , { x: 1, y: true } + , { x: 1, y: true } + , { x: 1, y: true } + , { x: 1, y: true } + , { x: 1, y: true } + ] diff --git a/test/Golden/ExprRecord/Actual.purs b/test/Golden/ExprRecord/Actual.purs index 9dde1aa..cd892c4 100644 --- a/test/Golden/ExprRecord/Actual.purs +++ b/test/Golden/ExprRecord/Actual.purs @@ -2,7 +2,7 @@ module Test.Golden.ExprRecord.Actual where import Language.PS.CST (Declaration(..), Expr(..), Guarded(..), Ident(..), Label(..), Module(..), ProperName(..), RecordLabeled(..), mkModuleName, nonQualifiedName) -import Prelude (($), (<#>), (<>)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty diff --git a/test/Golden/Html/Actual.purs b/test/Golden/Html/Actual.purs new file mode 100644 index 0000000..bed16a4 --- /dev/null +++ b/test/Golden/Html/Actual.purs @@ -0,0 +1,110 @@ +module Test.Golden.Html.Actual where + +import Language.PS.CST +import Prelude + +import Data.Array.NonEmpty as NonEmpty +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.Tuple.Nested (type (/\), (/\)) + +declValue name type_ expr = + [ DeclSignature + { comments: Nothing + , ident: Ident name + , type_ + } + , DeclValue + { comments: Nothing + , valueBindingFields: + { name: Ident name + , binders: [] + , guarded: Unconditional + { expr + , whereBindings: [] + } + } + } + ] + +exprIdent n = ExprIdent (nonQualifiedName (Ident n)) + +actualModule :: Module +actualModule = Module + { moduleName: mkModuleName $ NonEmpty.singleton "Array" + , imports: [] + , exports: [] + , declarations: + ( declValue + "html" + ( TypeConstructor $ nonQualifiedName (ProperName "HTML") ) + ( exprIdent "div" + `ExprApp` + ExprArray + [ exprIdent "class_" `ExprApp` exprIdent "main" + , exprIdent "id" `ExprApp` ExprString "zero" + ] + `ExprApp` + ExprArray + [ exprIdent "div" + `ExprApp` + ExprArray + [ exprIdent "class_" `ExprApp` exprIdent "main" + , exprIdent "id" `ExprApp` ExprString "zero" + ] + `ExprApp` + ExprArray + [ exprIdent "div" + `ExprApp` + ExprArray + [ exprIdent "class_" `ExprApp` exprIdent "main" + , exprIdent "id" `ExprApp` ExprString "zero" + ] + `ExprApp` + ExprArray + [ + ] + , exprIdent "div" + `ExprApp` + ExprArray + [ exprIdent "class_" `ExprApp` exprIdent "main" + , exprIdent "id" `ExprApp` ExprString "zero" + ] + `ExprApp` + ExprArray + [ + ] + ] + , exprIdent "div" + `ExprApp` + ExprArray + [ exprIdent "class_" `ExprApp` exprIdent "main" + , exprIdent "id" `ExprApp` ExprString "zero" + ] + `ExprApp` + ExprArray + [ exprIdent "div" + `ExprApp` + ExprArray + [ exprIdent "class_" `ExprApp` exprIdent "main" + , exprIdent "id" `ExprApp` ExprString "zero" + ] + `ExprApp` + ExprArray + [ + ] + , exprIdent "div" + `ExprApp` + ExprArray + [ exprIdent "class_" `ExprApp` exprIdent "main" + , exprIdent "id" `ExprApp` ExprString "zero" + ] + `ExprApp` + ExprArray + [ + ] + ] + ] + ) + ) + } diff --git a/test/Golden/Html/Expected.txt b/test/Golden/Html/Expected.txt new file mode 100644 index 0000000..d486f11 --- /dev/null +++ b/test/Golden/Html/Expected.txt @@ -0,0 +1,22 @@ +module Array where + +html :: HTML +html = div + [ class_ main + , id "zero" + ] + [ div + [ class_ main + , id "zero" + ] + [ div [class_ main, id "zero"] [] + , div [class_ main, id "zero"] [] + ] + , div + [ class_ main + , id "zero" + ] + [ div [class_ main, id "zero"] [] + , div [class_ main, id "zero"] [] + ] + ] diff --git a/test/Golden/If/Actual.purs b/test/Golden/If/Actual.purs index f92a9cd..e749937 100644 --- a/test/Golden/If/Actual.purs +++ b/test/Golden/If/Actual.purs @@ -2,7 +2,7 @@ module Test.Golden.If.Actual where import Language.PS.CST -import Prelude (($)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty diff --git a/test/Golden/Imports/Actual.purs b/test/Golden/Imports/Actual.purs index 29aeb7d..b8e0f9d 100644 --- a/test/Golden/Imports/Actual.purs +++ b/test/Golden/Imports/Actual.purs @@ -1,6 +1,6 @@ module Test.Golden.Imports.Actual where -import Prelude (map, ($)) +import Prelude import Data.Maybe (Maybe(..)) import Language.PS.CST @@ -34,7 +34,7 @@ actualModule = Module , ImportValue (Ident "compose") , ImportOp (OpName "&&") ] - , qualification: Nothing + , qualification: Just $ mkModuleName $ NonEmpty.cons' "CustomPrelude" [] } , ImportDecl { moduleName: mkModuleName $ NonEmpty.cons' "Data" ["Array"] diff --git a/test/Golden/Imports/Expected.txt b/test/Golden/Imports/Expected.txt index 301cd45..9e1f41f 100644 --- a/test/Golden/Imports/Expected.txt +++ b/test/Golden/Imports/Expected.txt @@ -1,9 +1,7 @@ module Foo where import Prelude -import Data.Maybe - ( Maybe - ) +import Data.Maybe (Maybe) import Prelude ( class EuclideanRing , kind MyKind @@ -13,9 +11,6 @@ import Prelude , Void , compose , (&&) - ) -import Data.Array - ( head - , tail - ) as Array + ) as CustomPrelude +import Data.Array (head, tail) as Array import Data.List as My.Data.List diff --git a/test/Golden/Instance/Actual.purs b/test/Golden/Instance/Actual.purs index ab596d2..9f22c8b 100644 --- a/test/Golden/Instance/Actual.purs +++ b/test/Golden/Instance/Actual.purs @@ -2,7 +2,7 @@ module Test.Golden.Instance.Actual where import Language.PS.CST -import Prelude (($)) +import Prelude import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty diff --git a/test/Golden/Instance/Expected.txt b/test/Golden/Instance/Expected.txt index f7ef566..36e248e 100644 --- a/test/Golden/Instance/Expected.txt +++ b/test/Golden/Instance/Expected.txt @@ -5,7 +5,7 @@ instance fooBaz :: Foo Baz instance fooBaz :: Foo Baz where foo :: Number foo = append foo bar - + bar :: Number bar = append (foo bar) diff --git a/test/Golden/InstanceChain/Actual.purs b/test/Golden/InstanceChain/Actual.purs index 9c7b5ab..0a29248 100644 --- a/test/Golden/InstanceChain/Actual.purs +++ b/test/Golden/InstanceChain/Actual.purs @@ -4,7 +4,7 @@ import Language.PS.CST import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/InstanceChain/Expected.txt b/test/Golden/InstanceChain/Expected.txt index b785e60..c45cc73 100644 --- a/test/Golden/InstanceChain/Expected.txt +++ b/test/Golden/InstanceChain/Expected.txt @@ -7,7 +7,7 @@ else instance fooBaz :: Foo Baz where foo :: Number foo = append foo bar - + bar :: Number bar = append (foo bar) diff --git a/test/Golden/MultilinePatternMatchingInLet/Actual.purs b/test/Golden/MultilinePatternMatchingInLet/Actual.purs index 938696d..763a87b 100644 --- a/test/Golden/MultilinePatternMatchingInLet/Actual.purs +++ b/test/Golden/MultilinePatternMatchingInLet/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/MultilinePatternMatchingInLet/Expected.txt b/test/Golden/MultilinePatternMatchingInLet/Expected.txt index 93f12c6..47fcaec 100644 --- a/test/Golden/MultilinePatternMatchingInLet/Expected.txt +++ b/test/Golden/MultilinePatternMatchingInLet/Expected.txt @@ -6,5 +6,5 @@ myfunc 1 = psModuleFile :: ModulePath -> Int psModuleFile Path = 1 psModuleFile Name = 2 - in + in psModuleFile 1 diff --git a/test/Golden/MultilinePatternMatchingInLet2/Actual.purs b/test/Golden/MultilinePatternMatchingInLet2/Actual.purs index 9a3f31f..48cea04 100644 --- a/test/Golden/MultilinePatternMatchingInLet2/Actual.purs +++ b/test/Golden/MultilinePatternMatchingInLet2/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/MultilinePatternMatchingInLet2/Expected.txt b/test/Golden/MultilinePatternMatchingInLet2/Expected.txt index 79cd5db..6b7fde6 100644 --- a/test/Golden/MultilinePatternMatchingInLet2/Expected.txt +++ b/test/Golden/MultilinePatternMatchingInLet2/Expected.txt @@ -6,9 +6,9 @@ myfunc 1 = psModuleFile :: ModulePath -> Int psModuleFile Path = 1 psModuleFile Name = 2 - + psModuleFile2 :: ModulePath -> Int psModuleFile2 Path = 1 psModuleFile2 Name = 2 - in + in psModuleFile 1 diff --git a/test/Golden/MultilinePatternMatchingInWhere/Actual.purs b/test/Golden/MultilinePatternMatchingInWhere/Actual.purs index 86cf22f..48529a5 100644 --- a/test/Golden/MultilinePatternMatchingInWhere/Actual.purs +++ b/test/Golden/MultilinePatternMatchingInWhere/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/MultilinePatternMatchingInWhere2/Actual.purs b/test/Golden/MultilinePatternMatchingInWhere2/Actual.purs index ebefbc5..766376e 100644 --- a/test/Golden/MultilinePatternMatchingInWhere2/Actual.purs +++ b/test/Golden/MultilinePatternMatchingInWhere2/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/MultilinePatternMatchingInWhere2/Expected.txt b/test/Golden/MultilinePatternMatchingInWhere2/Expected.txt index d4f4e27..b2ee091 100644 --- a/test/Golden/MultilinePatternMatchingInWhere2/Expected.txt +++ b/test/Golden/MultilinePatternMatchingInWhere2/Expected.txt @@ -6,7 +6,7 @@ myfunc 1 = psModuleFile 1 psModuleFile :: ModulePath -> Int psModuleFile Path = 1 psModuleFile Name = 2 - + psModuleFile2 :: ModulePath -> Int psModuleFile2 Path = 1 psModuleFile2 Name = 2 diff --git a/test/Golden/MultilinePatternMatchingInWhereAndLet2/Actual.purs b/test/Golden/MultilinePatternMatchingInWhereAndLet2/Actual.purs index 5fe45c9..f001b9d 100644 --- a/test/Golden/MultilinePatternMatchingInWhereAndLet2/Actual.purs +++ b/test/Golden/MultilinePatternMatchingInWhereAndLet2/Actual.purs @@ -5,7 +5,7 @@ import Language.PS.CST import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Array.NonEmpty as NonEmpty -import Prelude (($)) +import Prelude actualModule :: Module actualModule = Module diff --git a/test/Golden/MultilinePatternMatchingInWhereAndLet2/Expected.txt b/test/Golden/MultilinePatternMatchingInWhereAndLet2/Expected.txt index d448fc5..f9f6148 100644 --- a/test/Golden/MultilinePatternMatchingInWhereAndLet2/Expected.txt +++ b/test/Golden/MultilinePatternMatchingInWhereAndLet2/Expected.txt @@ -6,17 +6,17 @@ myfunc 1 = psModuleFile :: ModulePath -> Int psModuleFile Path = 1 psModuleFile Name = 2 - + psModuleFile2 :: ModulePath -> Int psModuleFile2 Path = 1 psModuleFile2 Name = 2 - in + in psModuleFile 1 where psModuleFile :: ModulePath -> Int psModuleFile Path = 1 psModuleFile Name = 2 - + psModuleFile2 :: ModulePath -> Int psModuleFile2 Path = 1 psModuleFile2 Name = 2 diff --git a/test/Main.purs b/test/Main.purs index 78b47c2..c2bfc56 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -1,45 +1,52 @@ module Test.Main where -import Effect (Effect) -import Effect.Aff (Aff, launchAff_) -import Language.PS.CST (Module) -import Prelude (Unit, bind, flip, pure, ($)) +import Prelude import Control.Parallel (parTraverse) +import Data.String.Regex as String +import Data.String.Regex.Flags as String +import Data.String.Regex.Unsafe as String import Data.Traversable (traverse_) +import Debug.Trace (traceM) +import Effect (Effect) +import Effect.Aff (Aff, launchAff_) import Effect.Class (liftEffect) +import Effect.Console (log) +import Language.PS.CST (Module) import Language.PS.CST.Printers as Language.PS.CST.Printers import Node.Encoding (Encoding(..)) import Node.FS.Aff (readTextFile) import Node.Path as Node.Path import Test.Ansidiff (textShouldMatch) +import Test.Golden.Application.Actual as Test.Golden.Application.Actual +import Test.Golden.Boolean.Actual as Test.Golden.Boolean.Actual +import Test.Golden.Case.Actual as Test.Golden.Case.Actual +import Test.Golden.DeclClass.Actual as Test.Golden.DeclClass.Actual +import Test.Golden.DeclData.Actual as Test.Golden.DeclData.Actual +import Test.Golden.DeclDataComplex.Actual as Test.Golden.DeclDataComplex.Actual +import Test.Golden.DeclDerive.Actual as Test.Golden.DeclDerive.Actual +import Test.Golden.DeclFixity.Actual as Test.Golden.DeclFixity.Actual +import Test.Golden.DeclForeign.Actual as Test.Golden.DeclForeign.Actual +import Test.Golden.DeclNewtype.Actual as Test.Golden.DeclNewtype.Actual +import Test.Golden.DeclType.Actual as Test.Golden.DeclType.Actual +import Test.Golden.Exports.Actual as Test.Golden.Exports.Actual +import Test.Golden.ExprRecord.Actual as Test.Golden.ExprRecord.Actual +import Test.Golden.ExprArray.Actual as Test.Golden.ExprArray.Actual +import Test.Golden.Html.Actual as Test.Golden.Html.Actual +import Test.Golden.If.Actual as Test.Golden.If.Actual +import Test.Golden.Imports.Actual as Test.Golden.Imports.Actual +import Test.Golden.Instance.Actual as Test.Golden.Instance.Actual +import Test.Golden.InstanceChain.Actual as Test.Golden.InstanceChain.Actual +import Test.Golden.MultilinePatternMatchingInLet.Actual as Test.Golden.MultilinePatternMatchingInLet.Actual +import Test.Golden.MultilinePatternMatchingInLet2.Actual as Test.Golden.MultilinePatternMatchingInLet2.Actual +import Test.Golden.MultilinePatternMatchingInWhere.Actual as Test.Golden.MultilinePatternMatchingInWhere.Actual +import Test.Golden.MultilinePatternMatchingInWhere2.Actual as Test.Golden.MultilinePatternMatchingInWhere2.Actual +import Test.Golden.MultilinePatternMatchingInWhereAndLet2.Actual as Test.Golden.MultilinePatternMatchingInWhereAndLet2.Actual import Test.Spec as Test.Spec +import Test.Spec.Assertions (shouldEqual) import Test.Spec.Reporter as Test.Spec.Reporter import Test.Spec.Runner as Test.Spec.Runner -import Test.Golden.DeclType.Actual as Test.Golden.DeclType.Actual -import Test.Golden.DeclNewtype.Actual as Test.Golden.DeclNewtype.Actual -import Test.Golden.DeclData.Actual as Test.Golden.DeclData.Actual -import Test.Golden.DeclDataComplex.Actual as Test.Golden.DeclDataComplex.Actual -import Test.Golden.DeclFixity.Actual as Test.Golden.DeclFixity.Actual -import Test.Golden.DeclForeign.Actual as Test.Golden.DeclForeign.Actual -import Test.Golden.DeclDerive.Actual as Test.Golden.DeclDerive.Actual -import Test.Golden.DeclClass.Actual as Test.Golden.DeclClass.Actual -import Test.Golden.Imports.Actual as Test.Golden.Imports.Actual -import Test.Golden.Exports.Actual as Test.Golden.Exports.Actual -import Test.Golden.Boolean.Actual as Test.Golden.Boolean.Actual -import Test.Golden.Application.Actual as Test.Golden.Application.Actual -import Test.Golden.MultilinePatternMatchingInLet.Actual as Test.Golden.MultilinePatternMatchingInLet.Actual -import Test.Golden.MultilinePatternMatchingInLet2.Actual as Test.Golden.MultilinePatternMatchingInLet2.Actual -import Test.Golden.MultilinePatternMatchingInWhere.Actual as Test.Golden.MultilinePatternMatchingInWhere.Actual -import Test.Golden.MultilinePatternMatchingInWhere2.Actual as Test.Golden.MultilinePatternMatchingInWhere2.Actual -import Test.Golden.MultilinePatternMatchingInWhereAndLet2.Actual as Test.Golden.MultilinePatternMatchingInWhereAndLet2.Actual -import Test.Golden.Case.Actual as Test.Golden.Case.Actual -import Test.Golden.If.Actual as Test.Golden.If.Actual -import Test.Golden.Instance.Actual as Test.Golden.Instance.Actual -import Test.Golden.InstanceChain.Actual as Test.Golden.InstanceChain.Actual -import Test.Golden.ExprRecord.Actual as Test.Golden.ExprRecord.Actual - type GoldenTest = { name :: String , actualModule :: Module @@ -75,6 +82,8 @@ goldenTests = , { name: "Instance", actualModule: Test.Golden.Instance.Actual.actualModule } , { name: "InstanceChain", actualModule: Test.Golden.InstanceChain.Actual.actualModule } , { name: "ExprRecord", actualModule: Test.Golden.ExprRecord.Actual.actualModule } + , { name: "ExprArray", actualModule: Test.Golden.ExprArray.Actual.actualModule } + , { name: "Html", actualModule: Test.Golden.Html.Actual.actualModule } ] addText :: GoldenTest -> Aff GoldenTestWithExpected @@ -90,7 +99,14 @@ mkAllTests tests = traverse_ mkTest tests mkTest :: GoldenTestWithExpected -> Test.Spec.Spec Unit mkTest test = Test.Spec.it test.name do let - actualParsed = Language.PS.CST.Printers.printModuleToString test.actualModule + actualParsed = + -- | String.replace (String.unsafeRegex "\\s+$" String.multiline) "" $ + Language.PS.CST.Printers.printModuleToString 80 test.actualModule + + -- | liftEffect $ log actualParsed + -- | traceM actualParsed + -- | traceM test.expected + -- | actualParsed `shouldEqual` test.expected actualParsed `textShouldMatch` test.expected main :: Effect Unit