2016-06-27 20:15:03 +03:00
|
|
|
{-# LANGUAGE DataKinds #-}
|
2017-03-01 02:35:43 +03:00
|
|
|
module DiffSpec where
|
2016-06-27 20:12:06 +03:00
|
|
|
|
2016-06-27 20:15:03 +03:00
|
|
|
import Category
|
2017-06-01 18:10:47 +03:00
|
|
|
import Data.Functor.Both
|
2017-01-08 07:17:05 +03:00
|
|
|
import Data.Functor.Listable
|
2017-04-24 22:53:11 +03:00
|
|
|
import RWS
|
2016-06-27 20:12:06 +03:00
|
|
|
import Diff
|
2017-02-08 19:15:37 +03:00
|
|
|
import Info
|
2016-06-27 20:15:03 +03:00
|
|
|
import Interpreter
|
2016-06-27 20:12:06 +03:00
|
|
|
import Prologue
|
2017-05-11 16:30:15 +03:00
|
|
|
import SpecHelpers
|
2017-01-08 07:17:05 +03:00
|
|
|
import Term
|
2016-06-27 20:12:06 +03:00
|
|
|
import Test.Hspec
|
2017-01-08 07:17:05 +03:00
|
|
|
import Test.Hspec.LeanCheck
|
2016-06-27 20:12:06 +03:00
|
|
|
|
|
|
|
spec :: Spec
|
|
|
|
spec = parallel $ do
|
2017-02-08 19:15:37 +03:00
|
|
|
let decorate = defaultFeatureVectorDecorator (category . headF)
|
2016-06-27 20:18:20 +03:00
|
|
|
prop "equality is reflexive" $
|
2017-07-23 22:59:02 +03:00
|
|
|
\ a -> let diff = unListableDiff a :: SyntaxDiff '[Category] in
|
2016-06-27 20:21:32 +03:00
|
|
|
diff `shouldBe` diff
|
2016-06-27 20:18:20 +03:00
|
|
|
|
2016-07-13 00:29:47 +03:00
|
|
|
prop "equal terms produce identity diffs" $
|
2017-07-23 22:56:08 +03:00
|
|
|
\ a -> let term = decorate (unListableF a :: SyntaxTerm '[Category]) in
|
2017-06-01 18:10:47 +03:00
|
|
|
diffCost (diffTerms (pure term)) `shouldBe` 0
|
2016-06-27 20:18:20 +03:00
|
|
|
|
2016-06-27 20:23:43 +03:00
|
|
|
describe "beforeTerm" $ do
|
|
|
|
prop "recovers the before term" $
|
2017-07-23 22:56:08 +03:00
|
|
|
\ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm '[Category])) in
|
2017-01-08 07:17:05 +03:00
|
|
|
beforeTerm diff `shouldBe` Just (unListableF a)
|
2016-06-27 20:15:03 +03:00
|
|
|
|
2016-06-27 20:24:50 +03:00
|
|
|
describe "afterTerm" $ do
|
|
|
|
prop "recovers the after term" $
|
2017-07-23 22:56:08 +03:00
|
|
|
\ a b -> let diff = diffTerms (unListableF <$> both a b :: Both (SyntaxTerm '[Category])) in
|
2017-01-08 07:17:05 +03:00
|
|
|
afterTerm diff `shouldBe` Just (unListableF b)
|