pretty printer

src/Data/Pretty.hs

@@ -1,24 +1,30 @@
 module Data.Pretty
     ( Pretty(..)
-    , ISeq
-    , iNil
-    , iStr
-    , iAppend
+    , ISeq(..)
+    , iBracket
     )
     where
 ----------------------------------------------------------------------------------
+import Data.String      (IsString(..))
+----------------------------------------------------------------------------------
 
 class Pretty a where
     pretty :: a -> String
     prettyPrec :: Int -> a -> ISeq
 
     pretty = squash . prettyPrec 0
-    prettyPrec _ a = iBracket (iStr $ pretty a)
+    prettyPrec _ a = iBracket (IStr $ pretty a)
+    {-# MINIMAL pretty | prettyPrec #-}
 
 data ISeq where
     INil :: ISeq
     IStr :: String -> ISeq
     IAppend :: ISeq -> ISeq -> ISeq
+    IIndent :: ISeq -> ISeq
+    IBreak :: ISeq
+
+instance IsString ISeq where
+    fromString = IStr
 
 instance Semigroup ISeq where
     (<>) = IAppend
@@ -27,28 +33,16 @@ instance Monoid ISeq where
     mempty = INil
 
 squash :: ISeq -> String
-squash = flatten . pure
+squash a = flatten 0 [(a,0)]
 
-flatten :: [ISeq] -> String
-flatten (INil : ss)        = flatten ss
-flatten (IStr s : ss)      = s ++ flatten ss
-flatten (IAppend r s : ss) = flatten (r : s : ss)
-
-iNil :: ISeq
-iNil = INil
-
-iStr :: String -> ISeq
-iStr = IStr
-
-iAppend  :: ISeq -> ISeq -> ISeq
-iAppend = IAppend
-
-iIndent :: ISeq -> ISeq
-iIndent = id
-
-iBreak :: ISeq
-iBreak = iStr "\n"
+flatten :: Int -> [(ISeq, Int)] -> String
+flatten _ []                      = ""
+flatten c ((INil,        i) : ss) = flatten c ss
+flatten c ((IStr s,      i) : ss) = s ++ flatten (c + length s) ss
+flatten c ((IAppend r s, i) : ss) = flatten c ((r,i) : (s,i) : ss)
+flatten _ ((IBreak,      i) : ss) = '\n' : replicate i ' ' ++ flatten i ss
+flatten c ((IIndent s,   i) : ss) = flatten c ((s,c) : ss)
 
 iBracket :: ISeq -> ISeq
-iBracket s = iStr "(" `iAppend` s `iAppend` iStr ")"
+iBracket s = IStr "(" <> s <> IStr ")"