quox/tests/PrettyExtra.idr

32 lines
959 B
Idris
Raw Normal View History

2023-03-25 15:55:28 -04:00
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')]