github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Extract a constructor for the root terms.

Browse Source
This commit is contained in:
Rob Rix 2016-08-11 12:54:14 -04:00
parent 7d8eb02ec8
commit 261e82fd21
1 changed files with 2 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
test/Data/RandomWalkSimilarity/Spec.hs
View File

@ -34,8 +34,9 @@ spec = parallel $ do
prop "produces correct diffs" . forAll (scale (`div` 4) arbitrary) $
\ (as, bs) -> let tas = toTerm' <$> (as :: [ArbitraryTerm Text (Record '[Category])])
tbs = toTerm' <$> (bs :: [ArbitraryTerm Text (Record '[Category])])
root = cofree . ((Program .: RNil) :<) . Indexed
diff = free (Free (pure (Program .: RNil) :< Indexed (stripDiff <$> rws compare tas tbs))) in
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (cofree ((Program .: RNil) :< Indexed (stripTerm <$> tas))), Just (cofree ((Program .: RNil) :< Indexed (stripTerm <$> tbs))))
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (root (stripTerm <$> tas)), Just (root (stripTerm <$> tbs)))
let toTerm'' c (ArbitraryTerm r f) = toTerm' (ArbitraryTerm (setCategory r c) f)
prop "produces unbiased deletions" $