rhi/quox
rhi/quox
1
0
Fork 0
Code Issues 15 Pull requests 1 Releases Wiki Activity

pokes in TAP

Browse source
This commit is contained in:
rhiannon morris 2022-05-04 00:49:18 +02:00
parent fa5beb4e2b
commit e13cd50175
1 changed files with 7 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
tests/src/TAP.idr
View file

@ -1,4 +1,5 @@
module TAP module TAP
-- [todo] extract this and Quox.Error to their own packages
import public Quox.Error import public Quox.Error
@ -45,7 +46,7 @@ All ToInfo es => ToInfo (OneOf es) where
export %inline ToInfo () where toInfo () = [] export %inline ToInfo () where toInfo () = []
export Show a => ToInfo (List (String, a)) where toInfo = map (map show) export %inline Show a => ToInfo (List (String, a)) where toInfo = map (map show)
export export
@ -121,15 +122,17 @@ export %inline
header : List a -> String header : List a -> String
header tests = "1..\{show $ length tests}" header tests = "1..\{show $ length tests}"
private
makePrefix : SnocList String -> String makePrefix : SnocList String -> String
makePrefix [<] = "" makePrefix [<] = ""
makePrefix (xs :< x) = foldr (\a, b => "\{a}/\{b}") x xs makePrefix (xs :< x) = foldr (\a, b => "\{a}/\{b}") x xs
private %inline
withPrefix : SnocList String -> TestBase -> Test withPrefix : SnocList String -> TestBase -> Test
withPrefix pfx b = One $ {label := "[\{makePrefix pfx}] \{b.label}"} b withPrefix pfx b = One $ {label := "[\{makePrefix pfx}] \{b.label}"} b
mutual mutual
export export %inline
flattenWith : SnocList String -> List Test -> List Test flattenWith : SnocList String -> List Test -> List Test
flattenWith pfx = concatMap (flatten1With pfx) flattenWith pfx = concatMap (flatten1With pfx)
@ -138,11 +141,11 @@ mutual
flatten1With pfx (One t) = [withPrefix pfx t] flatten1With pfx (One t) = [withPrefix pfx t]
flatten1With pfx (Group x ts) = flattenWith (pfx :< x) ts flatten1With pfx (Group x ts) = flattenWith (pfx :< x) ts
export export %inline
flatten : List Test -> List Test flatten : List Test -> List Test
flatten = flattenWith [<] flatten = flattenWith [<]
export export %inline
flatten1 : Test -> List Test flatten1 : Test -> List Test
flatten1 = flatten1With [<] flatten1 = flatten1With [<]