github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 17:04:47 +03:00
Code Issues Projects Releases Wiki Activity

Spike out an Arbitrary instance for BranchElement.

Browse Source
This commit is contained in:
Rob Rix 2016-05-20 21:59:46 -04:00
parent 419bcfe776
commit 919f32a650
1 changed files with 12 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
test/AlignmentSpec.hs
View File

@ -211,6 +211,18 @@ instance Arbitrary Child where
shrink Child {..} | null childContents, null childMargin = [] shrink Child {..} | null childContents, null childMargin = []
| otherwise = Child childKey <$> "" : shrinkList (const []) childContents <*> "" : shrinkList (const []) childMargin | otherwise = Child childKey <$> "" : shrinkList (const []) childContents <*> "" : shrinkList (const []) childMargin
instance Arbitrary BranchElement where
arbitrary = oneof [ Child' <$> key <*> joinTheseOf contents
, Margin <$> joinTheseOf margin ]
where key = listOf1 (elements (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']))
contents = listOf (padding '*')
margin = listOf (padding '-')
padding char = frequency [ (10, pure char)
, (1, pure '\n') ]
joinTheseOf g = oneof [ Join . This <$> g
, Join . That <$> g
, (Join .) . These <$> g <*> g ]
instance Show Child where instance Show Child where
show Child {..} = childMargin ++ "(" ++ childKey ++ childContents ++ ")" show Child {..} = childMargin ++ "(" ++ childKey ++ childContents ++ ")"