46 lines
1.3 KiB
Idris
46 lines
1.3 KiB
Idris
module PrettyExtra
|
|
|
|
import public Quox.Pretty
|
|
import public Quox.Name
|
|
import TAP
|
|
|
|
export
|
|
squash : String -> String
|
|
squash = pack . squash' . unpack . trim where
|
|
squash' : List Char -> List Char
|
|
squash' [] = []
|
|
squash' (c :: cs) =
|
|
if isSpace c then ' ' :: squash' (dropWhile isSpace cs)
|
|
else c :: squash' cs
|
|
|
|
public export
|
|
Printer : Type -> Type
|
|
Printer a = {opts : _} -> a -> Eff Pretty (Doc opts)
|
|
|
|
export
|
|
renderSquash : ({opts : _} -> Doc opts) -> String
|
|
renderSquash doc = squash $ render (Opts 10000) doc
|
|
|
|
export
|
|
prettySquash : Printer a -> Flavor -> a -> String
|
|
prettySquash pr f x =
|
|
renderSquash $ runPrettyWith Outer f noHighlight 0 (pr x)
|
|
|
|
export
|
|
testPretty : Printer a -> a -> (uni, asc : String) ->
|
|
{default uni label : String} -> Test
|
|
testPretty pr t uni asc {label} = test {e = Info} label $ do
|
|
let uni = squash uni; asc = squash asc
|
|
uni' = prettySquash pr Unicode t
|
|
asc' = prettySquash pr Ascii t
|
|
unless (uni == uni') $ Left [("exp", uni), ("got", uni')]
|
|
unless (asc == asc') $ Left [("exp", asc), ("got", asc')]
|
|
|
|
export
|
|
runPrettyDef : Eff Pretty a -> a
|
|
runPrettyDef = runPrettyWith Outer Unicode noHighlight 0
|
|
|
|
export
|
|
prettyStr : ({opts : _} -> Eff Pretty (Doc opts)) -> String
|
|
prettyStr doc = render (Opts 60) $ runPrettyDef doc
|