Preliminary and kind of gross pretty-printing implementation

Data/SCargot/Pretty.hs

@@ -1,8 +1,19 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
-module Data.SCargot.Pretty where
+module Data.SCargot.Pretty
+         ( LayoutOptions(..)
+         , basicPrint
+         , flatPrint
+         , prettyPrintSExpr
+         ) where
 
+import           Data.Monoid ((<>))
+import           Data.Text (Text)
+import qualified Data.Text as T
+
+import           Data.SCargot.Repr
 
 -- | A 'LayoutOptions' value describes how to pretty-print a 'SExpr'.
 --   It describes how to print atoms, what horizontal space to fit
@@ -45,10 +56,10 @@ module Data.SCargot.Pretty where
 --   otherwise, subsequent lines are indented based on the size of the
 --   @car@ of the list.
 data LayoutOptions a = LayoutOptions
-  { atomPrinter  :: a -> Text -- ^ How to serialize a given atom to 'Text'.
-  , swingIndent  :: a -> Bool -- ^ Whether or not to swing
-  , indentAmount :: Int       -- ^ How much to indent after a swing
-  , maxWidth     :: Maybe Int -- ^ The maximum width (if any)
+  { atomPrinter  :: a -> Text       -- ^ How to serialize a given atom to 'Text'.
+  , swingIndent  :: SExpr a -> Bool -- ^ Whether or not to swing
+  , indentAmount :: Int             -- ^ How much to indent after a swing
+  , maxWidth     :: Maybe Int       -- ^ The maximum width (if any)
   }
 
 flatPrint :: (a -> Text) -> LayoutOptions a
@@ -67,7 +78,49 @@ basicPrint printer = LayoutOptions
   , maxWidth     = Just 80
   }
 
+-- Sort of like 'unlines' but without the trailing newline
+joinLines :: [Text] -> Text
+joinLines = T.intercalate "\n"
+
+-- Indents a line by n spaces
+indent :: Int -> Text -> Text
+indent n ts = T.replicate n " " <> ts
+
+-- Indents every line n spaces, and adds a newline to the beginning
+indentAll :: Int -> [Text] -> Text
+indentAll n = ("\n" <>) . joinLines . map (indent n)
+
+-- Indents every line but the first by some amount
+indentSubsequent :: Int -> [Text] -> Text
+indentSubsequent _ [] = ""
+indentSubsequent _ [t] = t
+indentSubsequent n (t:ts) = joinLines (t : go ts)
+  where go = map (indent n)
+
+-- oh god this code is so disgusting
+-- i'm sorry to everyone i let down by writing this
+-- i swear i'll do better in the future i promise i have to
+-- for my sake and for everyone's
 prettyPrintSExpr :: LayoutOptions a -> SExpr a -> Text
-prettyPrintSExpr LayoutOptions { .. } = go 0
-  where go _ SNil = "()"
-        go _ _    = undefined
+prettyPrintSExpr LayoutOptions { .. } = pHead 0
+  where pHead _   SNil         = "()"
+        pHead _   (SAtom a)    = atomPrinter a
+        pHead ind (SCons x xs) = gather ind x xs id
+        gather _   _ (SAtom _)    _ = error "no dotted pretty printing yet!"
+        gather ind h (SCons x xs) k = gather ind h xs (k . (x:))
+        gather ind h SNil         k = "(" <> hd <> body <> ")"
+          where hd   = indentSubsequent ind [pHead (ind+1) h]
+                lst  = k []
+                flat = T.unwords (map (pHead (ind+1)) lst)
+                headWidth = T.length hd + 1
+                indented
+                  | swingIndent h =
+                      indentAll (ind + indentAmount)
+                        (map (pHead (ind + indentAmount)) lst)
+                  | otherwise =
+                      indentSubsequent (ind + headWidth + 1)
+                        (map (pHead (ind + headWidth + 1)) lst)
+                body | length lst == 0                = ""
+                     | Just maxAmt <- maxWidth
+                     , (T.length flat + ind) > maxAmt = " " <> indented
+                     | otherwise                      = " " <> flat

s-cargot.cabal

@@ -18,12 +18,13 @@ library
                        Data.SCargot.Repr.Rich,
                        Data.SCargot.Repr.WellFormed,
                        Data.SCargot.General,
+                       Data.SCargot.Pretty,
                        Data.SCargot.Basic,
                        Data.SCargot.Comments,
                        Data.SCargot.HaskLike,
                        Data.SCargot.Tutorial
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.7 && <4.8, parsec, text, containers
+  build-depends:       base >=4.7 && <5, parsec, text, containers
   -- hs-source-dirs:
   default-language:    Haskell2010