github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

Shrink Child contents respecting their prefixes/suffixes.

Browse Source
This commit is contained in:
Rob Rix 2016-05-20 23:13:36 -04:00
parent ff3691eac4
commit 96f94c9bdb
1 changed files with 3 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
test/AlignmentSpec.hs
View File

@ -212,7 +212,9 @@ instance Arbitrary BranchElement where
, Join . That <$> g
, (Join .) . These <$> g <*> g ]
shrink (Child key contents) = Child key <$> traverse (shrinkList (const [])) contents
shrink (Child key contents) = Child key <$> traverse shrinkContents contents
where shrinkContents string = (++ suffix) . (prefix ++) <$> shrinkList (const []) (drop (length prefix) (take (length string - length suffix) string))
(prefix, suffix) = ('(' : key, ")" :: String)
shrink (Margin contents) = Margin <$> traverse (shrinkList (const [])) contents
instance Show BranchElement where