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

Use the comparableTerms relation in the RWS tests.

Browse Source
This commit is contained in:
Rob Rix 2017-10-03 15:10:11 -04:00
parent 0d790823ab
commit 27758821e8
1 changed files with 3 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-}
module Data.RandomWalkSimilarity.Spec where
import Algorithm
import Data.Array.IArray
import Data.Bifunctor
import Data.Diff
@ -35,12 +36,12 @@ spec = parallel $ do
\ (as, bs) -> let tas = decorate <$> (as :: [Term ListableSyntax (Record '[])])
tbs = decorate <$> (bs :: [Term ListableSyntax (Record '[])])
wrap = termIn Nil . inj
diff = merge (Nil, Nil) (inj (stripDiff . diffThese <$> rws comparableByConstructor (equalTerms comparableByConstructor) tas tbs)) in
diff = merge (Nil, Nil) (inj (stripDiff . diffThese <$> rws comparableTerms (equalTerms comparableTerms) tas tbs)) in
(beforeTerm diff, afterTerm diff) `shouldBe` (Just (wrap (stripTerm <$> tas)), Just (wrap (stripTerm <$> tbs)))
it "produces unbiased insertions within branches" $
let (a, b) = (decorate (termIn Nil (inj [ termIn Nil (inj (Syntax.Identifier "a")) ])), decorate (termIn Nil (inj [ termIn Nil (inj (Syntax.Identifier "b")) ]))) in
fmap (bimap stripTerm stripTerm) (rws comparableByConstructor (equalTerms comparableByConstructor) [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ]
fmap (bimap stripTerm stripTerm) (rws comparableTerms (equalTerms comparableTerms) [ b ] [ a, b ]) `shouldBe` fmap (bimap stripTerm stripTerm) [ That a, These b b ]
where decorate = defaultFeatureVectorDecorator constructorNameAndConstantFields