Automatic multiline printing using prettyprinter

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"
         }
       }

spago.dhall

@@ -10,7 +10,7 @@
     , "node-path"
     , "node-fs-aff"
     , "ansi"
-    , "boxes"
+    , "prettyprinter"
     , "debug"
     ]
 , packages = ./packages.dhall

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

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)

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