| 1 | 1 |
{-# LANGUAGE RecordWildCards #-}
|
| 2 | 2 |
{-# LANGUAGE OverloadedStrings #-}
|
| 3 |
{-# LANGUAGE ScopedTypeVariables #-}
|
| 3 | 4 |
|
| 4 | |
module Data.SCargot.Pretty where
|
| 5 |
module Data.SCargot.Pretty
|
| 6 |
( LayoutOptions(..)
|
| 7 |
, basicPrint
|
| 8 |
, flatPrint
|
| 9 |
, prettyPrintSExpr
|
| 10 |
) where
|
| 5 | 11 |
|
| 12 |
import Data.Monoid ((<>))
|
| 13 |
import Data.Text (Text)
|
| 14 |
import qualified Data.Text as T
|
| 15 |
|
| 16 |
import Data.SCargot.Repr
|
| 6 | 17 |
|
| 7 | 18 |
-- | A 'LayoutOptions' value describes how to pretty-print a 'SExpr'.
|
| 8 | 19 |
-- It describes how to print atoms, what horizontal space to fit
|
|
| 45 | 56 |
-- otherwise, subsequent lines are indented based on the size of the
|
| 46 | 57 |
-- @car@ of the list.
|
| 47 | 58 |
data LayoutOptions a = LayoutOptions
|
| 48 | |
{ atomPrinter :: a -> Text -- ^ How to serialize a given atom to 'Text'.
|
| 49 | |
, swingIndent :: a -> Bool -- ^ Whether or not to swing
|
| 50 | |
, indentAmount :: Int -- ^ How much to indent after a swing
|
| 51 | |
, maxWidth :: Maybe Int -- ^ The maximum width (if any)
|
| 59 |
{ atomPrinter :: a -> Text -- ^ How to serialize a given atom to 'Text'.
|
| 60 |
, swingIndent :: SExpr a -> Bool -- ^ Whether or not to swing
|
| 61 |
, indentAmount :: Int -- ^ How much to indent after a swing
|
| 62 |
, maxWidth :: Maybe Int -- ^ The maximum width (if any)
|
| 52 | 63 |
}
|
| 53 | 64 |
|
| 54 | 65 |
flatPrint :: (a -> Text) -> LayoutOptions a
|
|
| 67 | 78 |
, maxWidth = Just 80
|
| 68 | 79 |
}
|
| 69 | 80 |
|
| 81 |
-- Sort of like 'unlines' but without the trailing newline
|
| 82 |
joinLines :: [Text] -> Text
|
| 83 |
joinLines = T.intercalate "\n"
|
| 84 |
|
| 85 |
-- Indents a line by n spaces
|
| 86 |
indent :: Int -> Text -> Text
|
| 87 |
indent n ts = T.replicate n " " <> ts
|
| 88 |
|
| 89 |
-- Indents every line n spaces, and adds a newline to the beginning
|
| 90 |
indentAll :: Int -> [Text] -> Text
|
| 91 |
indentAll n = ("\n" <>) . joinLines . map (indent n)
|
| 92 |
|
| 93 |
-- Indents every line but the first by some amount
|
| 94 |
indentSubsequent :: Int -> [Text] -> Text
|
| 95 |
indentSubsequent _ [] = ""
|
| 96 |
indentSubsequent _ [t] = t
|
| 97 |
indentSubsequent n (t:ts) = joinLines (t : go ts)
|
| 98 |
where go = map (indent n)
|
| 99 |
|
| 100 |
-- oh god this code is so disgusting
|
| 101 |
-- i'm sorry to everyone i let down by writing this
|
| 102 |
-- i swear i'll do better in the future i promise i have to
|
| 103 |
-- for my sake and for everyone's
|
| 70 | 104 |
prettyPrintSExpr :: LayoutOptions a -> SExpr a -> Text
|
| 71 | |
prettyPrintSExpr LayoutOptions { .. } = go 0
|
| 72 | |
where go _ SNil = "()"
|
| 73 | |
go _ _ = undefined
|
| 105 |
prettyPrintSExpr LayoutOptions { .. } = pHead 0
|
| 106 |
where pHead _ SNil = "()"
|
| 107 |
pHead _ (SAtom a) = atomPrinter a
|
| 108 |
pHead ind (SCons x xs) = gather ind x xs id
|
| 109 |
gather _ _ (SAtom _) _ = error "no dotted pretty printing yet!"
|
| 110 |
gather ind h (SCons x xs) k = gather ind h xs (k . (x:))
|
| 111 |
gather ind h SNil k = "(" <> hd <> body <> ")"
|
| 112 |
where hd = indentSubsequent ind [pHead (ind+1) h]
|
| 113 |
lst = k []
|
| 114 |
flat = T.unwords (map (pHead (ind+1)) lst)
|
| 115 |
headWidth = T.length hd + 1
|
| 116 |
indented
|
| 117 |
| swingIndent h =
|
| 118 |
indentAll (ind + indentAmount)
|
| 119 |
(map (pHead (ind + indentAmount)) lst)
|
| 120 |
| otherwise =
|
| 121 |
indentSubsequent (ind + headWidth + 1)
|
| 122 |
(map (pHead (ind + headWidth + 1)) lst)
|
| 123 |
body | length lst == 0 = ""
|
| 124 |
| Just maxAmt <- maxWidth
|
| 125 |
, (T.length flat + ind) > maxAmt = " " <> indented
|
| 126 |
| otherwise = " " <> flat
|