gdritter repos s-cargot / 62f6c67
Add much more efficient special-case for flat s-expr serialization Getty Ritter 6 years ago
1 changed file(s) with 99 addition(s) and 33 deletion(s). Collapse all Expand all
+99
-33
Data/SCargot/Print.hs less more
2222 import Data.Monoid ((<>))
2323 import Data.Text (Text)
2424 import qualified Data.Text as T
25 import qualified Data.Text.Lazy as TL
26 import qualified Data.Text.Lazy.Builder as B
2527
2628 import Data.SCargot.Repr
2729
176178 -- | Pretty-print a 'SExpr' according to the options in a
177179 -- 'LayoutOptions' value.
178180 prettyPrintSExpr :: SExprPrinter a (SExpr a) -> SExpr a -> Text
179 prettyPrintSExpr SExprPrinter { .. } = pHead 0
180 where pHead _ SNil = "()"
181 pHead _ (SAtom a) = atomPrinter a
182 pHead ind (SCons x xs) = gather ind x xs id
183 gather ind h (SCons x xs) k = gather ind h xs (k . (x:))
184 gather ind h end k = "(" <> hd <> body <> tl <> ")"
185 where tl = case end of
186 SNil -> ""
187 SAtom a -> " . " <> atomPrinter a
188 SCons _ _ -> error "[unreachable]"
189 hd = indentSubsequent ind [pHead (ind+1) h]
190 lst = k []
191 flat = T.unwords (map (pHead (ind+1)) lst)
192 headWidth = T.length hd + 1
193 indented =
194 case swingIndent h of
195 SwingAfter n ->
196 let (l, ls) = splitAt n lst
197 t = T.unwords (map (pHead (ind+1)) l)
198 ts = indentAll (ind + indentAmount)
199 (map (pHead (ind + indentAmount)) ls)
200 in t <> ts
201 Swing ->
202 indentAll (ind + indentAmount)
203 (map (pHead (ind + indentAmount)) lst)
204 Align ->
205 indentSubsequent (ind + headWidth + 1)
206 (map (pHead (ind + headWidth + 1)) lst)
207 body
208 | length lst == 0 = ""
209 | Just maxAmt <- maxWidth
210 , T.length flat + ind > maxAmt = " " <> indented
211 | otherwise = " " <> flat
181 prettyPrintSExpr pr@SExprPrinter { .. } expr = case maxWidth of
182 Nothing -> flatPrintSExpr (fmap atomPrinter (fromCarrier expr))
183 Just _ -> indentPrintSExpr pr expr
184
185 indentPrintSExpr :: SExprPrinter a (SExpr a) -> SExpr a -> Text
186 indentPrintSExpr SExprPrinter { .. } = pHead 0
187 where
188 pHead _ SNil = "()"
189 pHead _ (SAtom a) = atomPrinter a
190 pHead ind (SCons x xs) = gather ind x xs id
191 gather ind h (SCons x xs) k = gather ind h xs (k . (x:))
192 gather ind h end k = "(" <> hd <> body <> tl <> ")"
193 where tl = case end of
194 SNil -> ""
195 SAtom a -> " . " <> atomPrinter a
196 SCons _ _ -> error "[unreachable]"
197 hd = indentSubsequent ind [pHead (ind+1) h]
198 lst = k []
199 flat = T.unwords (map (pHead (ind+1)) lst)
200 headWidth = T.length hd + 1
201 indented =
202 case swingIndent h of
203 SwingAfter n ->
204 let (l, ls) = splitAt n lst
205 t = T.unwords (map (pHead (ind+1)) l)
206 ts = indentAll (ind + indentAmount)
207 (map (pHead (ind + indentAmount)) ls)
208 in t <> ts
209 Swing ->
210 indentAll (ind + indentAmount)
211 (map (pHead (ind + indentAmount)) lst)
212 Align ->
213 indentSubsequent (ind + headWidth + 1)
214 (map (pHead (ind + headWidth + 1)) lst)
215 body
216 | length lst == 0 = ""
217 | Just maxAmt <- maxWidth
218 , T.length flat + ind > maxAmt = " " <> indented
219 | otherwise = " " <> flat
220
221 -- where
222 -- -- this is the base-case that knows how to print empty lists and
223 -- -- atoms
224 -- pHead _ SNil = B.fromString "()"
225 -- pHead _ (SAtom a) = B.fromText a
226 -- pHead ind (SCons x xs) = gather ind x xs id 0
227
228 -- -- otherwise, we trawl through the list grabbing every element...
229 -- gather ind h (SCons x xs) k r = gather ind h xs (k . (x:)) (r + T.length x)
230 -- gather ind h end k r = B.fromString "(" <> hd <> body <> tl <> B.fromString ")"
231 -- where
232 -- tl = case end of
233 -- SNil -> mempty
234 -- SAtom a -> B.fromString " . " <> B.fromText a
235 -- SCons _ _ -> error "[unreachable]"
236 -- hd = indentSubsequent ind [pHead (ind+1) h]
237 -- lst = k []
238 -- flat = T.unwords (map (pHead (ind+1)) lst)
239 -- headWidth = T.length hd + 1
240 -- indented =
241 -- case swingIndent h of
242 -- SwingAfter n ->
243 -- let (l, ls) = splitAt n lst
244 -- t = T.unwords (map (pHead (ind+1)) l)
245 -- ts = indentAll (ind + indentAmount)
246 -- (map (pHead (ind + indentAmount)) ls)
247 -- in t <> ts
248 -- Swing ->
249 -- indentAll (ind + indentAmount)
250 -- (map (pHead (ind + indentAmount)) lst)
251 -- Align ->
252 -- indentSubsequent (ind + headWidth + 1)
253 -- (map (pHead (ind + headWidth + 1)) lst)
254 -- body
255 -- | length lst == 0 = B.fromString ""
256 -- | Just maxAmt <- maxWidth
257 -- , T.length flat + ind > maxAmt = B.fromString " " <> indented
258 -- | otherwise = B.fromString " " <> flat
259
260 -- if we don't indent anything, then we can ignore a bunch of the
261 -- details above
262 flatPrintSExpr :: SExpr Text -> Text
263 flatPrintSExpr = TL.toStrict . B.toLazyText . pHead
264 where
265 pHead (SCons x xs) =
266 B.fromString "(" <> pHead x <> pTail xs
267 pHead (SAtom t) =
268 B.fromText t
269 pHead SNil =
270 B.fromString "()"
271
272 pTail (SCons x xs) =
273 B.fromString " " <> pHead x <> pTail xs
274 pTail (SAtom t) =
275 B.fromString " . " <> B.fromText t <> B.fromString ")"
276 pTail SNil =
277 B.fromString ")"
212278
213279 -- | Turn a single s-expression into a string according to a given
214280 -- 'SExprPrinter'.