gdritter repos s-cargot / a94f8e9
Some minor refactors to improve building performance Getty Ritter 7 years ago
1 changed file(s) with 30 addition(s) and 20 deletion(s). Collapse all Expand all
+30
-20
Data/SCargot/Print.hs less more
194194 -- s-expressions, then we might as well consider it flat and let
195195 -- it take the whole line
196196 | Just strings <- T.traverse ppBasic (initial Seq.<| values) =
197 Seq.singleton (B.fromString "(" <> buildUnwords strings <> pTail rest)
197 Seq.singleton (B.singleton '(' <> buildUnwords strings <> pTail rest)
198198
199199 -- it's not "flat", so we might want to swing after the first thing
200200 | Swing <- iv =
206206 -- ...or after several things
207207 | SwingAfter n <- iv =
208208 let (hs, xs) = Seq.splitAt n (initial Seq.<| values)
209 hd = B.fromString "(" <> buildUnwords (F.foldMap go hs)
209 hd = B.singleton '(' <> buildUnwords (F.foldMap go hs)
210210 butLast = hd Seq.<| fmap doIndent (F.foldMap go xs)
211211 in handleTail rest butLast
212212
229229 -- with spaces and everything else gets indended the
230230 -- forementioned length
231231 y Seq.:< ys ->
232 let hd = B.fromString "(" <> buildUnwords (F.foldMap go (Seq.fromList [initial, y]))
232 let hd = B.singleton '(' <> buildUnwords (F.foldMap go (Seq.fromList [initial, y]))
233233 butLast = hd Seq.<| fmap (doIndentOf (fromIntegral len)) (F.foldMap go ys)
234234 in handleTail rest butLast
235235
242242 insertParen :: Seq.Seq B.Builder -> Seq.Seq B.Builder
243243 insertParen s = case Seq.viewl s of
244244 Seq.EmptyL -> s
245 x Seq.:< xs -> (B.fromString "(" <> x) Seq.<| xs
245 x Seq.:< xs -> (B.singleton '(' <> x) Seq.<| xs
246246
247247 handleTail :: Maybe Text -> Seq.Seq B.Builder -> Seq.Seq B.Builder
248248 handleTail Nothing = insertCloseParen
249249 handleTail (Just t) =
250 (Seq.|> (B.fromString " . " <> B.fromText t <> B.fromString ")"))
250 (Seq.|> (B.fromString " . " <> B.fromText t <> B.singleton ')'))
251251
252252 insertCloseParen :: Seq.Seq B.Builder -> Seq.Seq B.Builder
253253 insertCloseParen s = case Seq.viewr s of
254 Seq.EmptyR -> Seq.singleton (B.fromString ")")
255 xs Seq.:> x -> xs Seq.|> (x <> B.fromString ")")
254 Seq.EmptyR -> Seq.singleton (B.singleton ')')
255 xs Seq.:> x -> xs Seq.|> (x <> B.singleton ')')
256256
257257 buildUnwords sq =
258258 case Seq.viewl sq of
259259 Seq.EmptyL -> mempty
260 t Seq.:< ts -> t <> F.foldMap (\ x -> B.fromString " " <> x) ts
261
262 pTail Nothing = B.fromString ")"
263 pTail (Just t) = B.fromString " . " <> B.fromText t <> B.fromString ")"
260 t Seq.:< ts -> t <> F.foldMap (\ x -> B.singleton ' ' <> x) ts
261
262 pTail Nothing = B.singleton ')'
263 pTail (Just t) = B.fromString " . " <> B.fromText t <> B.singleton ')'
264264
265265 ppBasic (IAtom t) = Just (B.fromText t)
266266 ppBasic (IEmpty) = Just (B.fromString "()")
324324 setIndentStrategy st pr = pr { swingIndent = st }
325325
326326
327 spaceDot :: B.Builder
328 spaceDot = B.singleton ' ' <> B.singleton '.' <> B.singleton ' '
329
327330 -- Indents a line by n spaces
328331 indent :: Int -> B.Builder -> B.Builder
329 indent n ts = B.fromText (T.replicate n " ") <> ts
332 indent n ts =
333 mconcat [ B.singleton ' ' | _ <- [1..n]] <> ts
330334
331335
332336 -- Sort of like 'unlines' but without the trailing newline
386390 pp ind (IList i sz h values end) =
387391 -- we always are going to have a head, a (possibly empty) body,
388392 -- and a (possibly empty) tail in our list formats
389 B.fromString "(" <> hd <> body <> tl <> B.fromString ")"
393 B.singleton '(' <> hd <> body <> tl <> B.singleton ')'
390394 where
391395 -- the tail is either nothing, or the final dotted pair
392396 tl = case end of
416420 | length values == 0 = mempty
417421 -- if we can't fit the whole next s-expression on the same
418422 -- line, then we use the indented form
419 | sizeSum sz + ind > maxAmt = B.fromString " " <> indented
423 | sizeSum sz + ind > maxAmt = B.singleton ' ' <> indented
420424 | otherwise =
421425 -- otherwise we print the whole thing on one line!
422 B.fromString " " <> unwordsS (fmap (pp (ind + 1)) values)
426 B.singleton ' ' <> unwordsS (fmap (pp (ind + 1)) values)
423427
424428
425429 -- if we don't indent anything, then we can ignore a bunch of the
428432 flatPrintSExpr = B.toLazyText . pHead
429433 where
430434 pHead (SCons x xs) =
431 B.fromString "(" <> pHead x <> pTail xs
435 B.singleton '(' <> pHead x <> pTail xs
432436 pHead (SAtom t) =
433437 B.fromText t
434438 pHead SNil =
435 B.fromString "()"
439 B.singleton '(' <> B.singleton ')'
436440
437441 pTail (SCons x xs) =
438 B.fromString " " <> pHead x <> pTail xs
442 B.singleton ' ' <> pHead x <> pTail xs
439443 pTail (SAtom t) =
440 B.fromString " . " <> B.fromText t <> B.fromString ")"
444 spaceDot <>
445 B.fromText t <>
446 B.singleton ')'
441447 pTail SNil =
442 B.fromString ")"
448 B.singleton ')'
449
443450
444451 -- | Turn a single s-expression into a string according to a given
445452 -- 'SExprPrinter'.
447454 encodeOne s@(SExprPrinter { .. }) =
448455 TL.toStrict . prettyPrintSExpr (s { fromCarrier = id }) . fromCarrier
449456
457
450458 -- | Turn a list of s-expressions into a single string according to
451459 -- a given 'SExprPrinter'.
452460 encode :: SExprPrinter atom carrier -> [carrier] -> Text
453461 encode spec =
454462 T.intercalate "\n\n" . map (encodeOne spec)
455463
464
456465 -- | Turn a single s-expression into a lazy 'Text' according to a given
457466 -- 'SExprPrinter'.
458467 encodeOneLazy :: SExprPrinter atom carrier -> carrier -> TL.Text
459468 encodeOneLazy s@(SExprPrinter { .. }) =
460469 prettyPrintSExpr (s { fromCarrier = id }) . fromCarrier
461470
471
462472 -- | Turn a list of s-expressions into a lazy 'Text' according to
463473 -- a given 'SExprPrinter'.
464474 encodeLazy :: SExprPrinter atom carrier -> [carrier] -> TL.Text