1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 17:04:47 +03:00

🔥 Data.Adjoined.Spec.

This commit is contained in:
Rob Rix 2016-04-14 21:54:25 -04:00
parent 1972e20233
commit 6829c6baab
3 changed files with 0 additions and 97 deletions

View File

@ -72,7 +72,6 @@ test-suite semantic-diff-test
other-modules: AlignmentSpec other-modules: AlignmentSpec
, ArbitraryTerm , ArbitraryTerm
, CorpusSpec , CorpusSpec
, Data.Adjoined.Spec
, InterpreterSpec , InterpreterSpec
, OrderedMapSpec , OrderedMapSpec
, PatchOutputSpec , PatchOutputSpec

View File

@ -1,94 +0,0 @@
module Data.Adjoined.Spec (spec) where
import ArbitraryTerm ()
import Control.Applicative
import Data.Adjoined
import Data.Coalescent
import Data.Foldable
import Data.Functor.Both
import Data.Typeable
import Line
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
spec :: Spec
spec = do
prop "equality is reflexive" $
\ a -> a `shouldBe` (a :: Adjoined (Uncoalesced Char))
monoid (arbitrary :: Gen (Adjoined (Coalesced String)))
monoid (arbitrary :: Gen (Adjoined (Uncoalesced String)))
monoid (arbitrary :: Gen (Adjoined (Semicoalesced String)))
monoid (arbitrary :: Gen (Adjoined (Line Char)))
-- monoid (arbitrary :: Gen (Adjoined (Both (Line Char))))
monoid :: (Arbitrary a, Coalescent a, Eq a, Show a, Typeable a) => Gen (Adjoined a) -> Spec
monoid gen =
describe ("Monoid (" ++ showTypeOf (`asGeneratedTypeOf` gen) ++ ")") $ do
describe "mempty" $ do
prop "left identity" $ forAll gen $
\ a -> mempty `mappend` a `shouldBe` a
prop "right identity" $ forAll gen $
\ a -> a `mappend` mempty `shouldBe` a
describe "mappend" $ do
prop "associativity" $ forAll gen $
\ a b c -> (a `mappend` b) `mappend` c `shouldBe` a `mappend` (b `mappend` c)
instance Arbitrary a => Arbitrary (Adjoined a) where
arbitrary = fromList <$> arbitrary
shrink arbitrary = fromList <$> shrinkList shrink (toList arbitrary)
-- | A wrapper which never coalesces values.
newtype Uncoalesced a = Uncoalesced { runUncoalesced :: a }
deriving (Eq, Show)
instance Arbitrary a => Arbitrary (Uncoalesced a) where
arbitrary = Uncoalesced <$> arbitrary
instance Coalescent (Uncoalesced a) where
coalesce a b = pure a <|> pure b
-- | A wrapper which always coalesces values.
newtype Coalesced a = Coalesced { runCoalesced :: a }
deriving (Eq, Show)
instance Arbitrary a => Arbitrary (Coalesced a) where
arbitrary = Coalesced <$> arbitrary
instance Monoid a => Coalescent (Coalesced a) where
coalesce a b = pure (Coalesced (runCoalesced a `mappend` runCoalesced b))
-- | A wrapper which coalesces asymmetrically.
-- |
-- | Specifically, it coalesces only when the value at the left has `True` set.
newtype Semicoalesced a = Semicoalesced { runSemicoalesced :: (Bool, a) }
deriving (Eq, Show)
instance Arbitrary a => Arbitrary (Semicoalesced a) where
arbitrary = Semicoalesced <$> arbitrary
instance Monoid a => Coalescent (Semicoalesced a) where
Semicoalesced (True, a) `coalesce` Semicoalesced (flag, b) = pure (Semicoalesced (flag, a `mappend` b))
a `coalesce` b = pure a <|> pure b
-- | Returns a string with the name of a type.
-- |
-- | Use with `asTypeOf` or `asGeneratedTypeOf` to show type names for parameters without fighting type variable scoping:
-- |
-- | showTypeOf (`asTypeOf` someTypeParametricValue)
showTypeOf :: Typeable a => (a -> a) -> String
showTypeOf f = show (typeRep (proxyOf f))
where proxyOf :: (a -> a) -> Proxy a
proxyOf _ = Proxy
-- | Type-restricted `const`, usually written infix or as an operator section with `showTypeOf`.
asGeneratedTypeOf :: a -> Gen a -> a
asGeneratedTypeOf = const

View File

@ -2,7 +2,6 @@ module Main where
import qualified AlignmentSpec import qualified AlignmentSpec
import qualified CorpusSpec import qualified CorpusSpec
import qualified Data.Adjoined.Spec
import qualified InterpreterSpec import qualified InterpreterSpec
import qualified OrderedMapSpec import qualified OrderedMapSpec
import qualified PatchOutputSpec import qualified PatchOutputSpec
@ -13,7 +12,6 @@ main :: IO ()
main = hspec $ parallel $ do main = hspec $ parallel $ do
describe "Alignment" AlignmentSpec.spec describe "Alignment" AlignmentSpec.spec
describe "Corpus" CorpusSpec.spec describe "Corpus" CorpusSpec.spec
describe "Data.Adjoined" Data.Adjoined.Spec.spec
describe "Interpreter" InterpreterSpec.spec describe "Interpreter" InterpreterSpec.spec
describe "OrderedMap" OrderedMapSpec.spec describe "OrderedMap" OrderedMapSpec.spec
describe "PatchOutput" PatchOutputSpec.spec describe "PatchOutput" PatchOutputSpec.spec