32 lines
959 B
Idris
32 lines
959 B
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
|
||
|
|
|
||
|
|
export
|
||
|
|
renderSquash : Doc HL -> String
|
||
|
|
renderSquash doc = squash $ renderShow (layoutCompact doc) ""
|
||
|
|
|
||
|
|
export
|
||
|
|
testPretty : PrettyHL a => (dnames, tnames : SnocList BaseName) ->
|
||
|
|
a -> (uni, asc : String) ->
|
||
|
|
{default uni label : String} -> Test
|
||
|
|
testPretty dnames tnames t uni asc {label} = test {e = Info} label $ do
|
||
|
|
let uni = squash uni; asc = squash asc
|
||
|
|
uni' = renderSquash $ pretty0With True dnames tnames t
|
||
|
|
asc' = renderSquash $ pretty0With False dnames tnames t
|
||
|
|
unless (uni == uni') $ Left [("exp", uni), ("got", uni')]
|
||
|
|
unless (asc == asc') $ Left [("exp", asc), ("got", asc')]
|