about summary refs log tree commit diff
path: root/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs')
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs69
1 files changed, 0 insertions, 69 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs
deleted file mode 100644
index 7c5cad019616..000000000000
--- a/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs
+++ /dev/null
@@ -1,69 +0,0 @@
-{-# LANGUAGE ApplicativeDo #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.EntityMapSpec where
---------------------------------------------------------------------------------
-import           Test.Prelude
---------------------------------------------------------------------------------
-import qualified Data.Aeson as JSON
---------------------------------------------------------------------------------
-import           Xanthous.Data.EntityMap
-import           Xanthous.Data (Positioned(..))
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = localOption (QuickCheckTests 20)
-  $ testGroup "Xanthous.Data.EntityMap"
-  [ testBatch $ monoid @(EntityMap Int) mempty
-  , testGroup "Deduplicate"
-    [ testGroup "Semigroup laws"
-      [ testProperty "associative" $ \(a :: Deduplicate (EntityMap Int)) b c ->
-          a <> (b <> c) === (a <> b) <> c
-      ]
-    ]
-  , testGroup "Eq laws"
-    [ testProperty "reflexivity" $ \(em :: EntityMap Int) ->
-        em == em
-    , testProperty "symmetric" $ \(em₁ :: EntityMap Int) em₂ ->
-        (em₁ == em₂) == (em₂ == em₁)
-    , testProperty "transitive" $ \(em₁ :: EntityMap Int) em₂ em₃ ->
-        if (em₁ == em₂ && em₂ == em₃)
-        then (em₁ == em₃)
-        else True
-    ]
-  , testGroup "JSON encoding/decoding"
-    [ testProperty "round-trips" $ \(em :: EntityMap Int) ->
-        let em' = JSON.decode (JSON.encode em)
-        in counterexample (show (em' ^? _Just . lastID, em ^. lastID
-                                , em' ^? _Just . byID == em ^. byID . re _Just
-                                , em' ^? _Just . byPosition == em ^. byPosition . re _Just
-                                , em' ^? _Just . _EntityMap == em ^. _EntityMap . re _Just
-                                ))
-           $ em' === Just em
-    , testProperty "Preserves IDs" $ \(em :: EntityMap Int) ->
-        let Just em' = JSON.decode $ JSON.encode em
-        in toEIDsAndPositioned em' === toEIDsAndPositioned em
-    ]
-
-  , localOption (QuickCheckTests 50)
-  $ testGroup "atPosition"
-    [ testProperty "setget" $ \pos (em :: EntityMap Int) es ->
-        view (atPosition pos) (set (atPosition pos) es em) === es
-    , testProperty "getset" $ \pos (em :: EntityMap Int) ->
-        set (atPosition pos) (view (atPosition pos) em) em === em
-    , testProperty "setset" $ \pos (em :: EntityMap Int) es ->
-        (set (atPosition pos) es . set (atPosition pos) es) em
-        ===
-        set (atPosition pos) es em
-      -- testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos
-    , testProperty "preserves IDs" $ \(em :: EntityMap Int) e1 e2 p ->
-        let (eid, em') = insertAtReturningID p e1 em
-            em'' = em' & atPosition p %~ (e2 <|)
-        in
-          counterexample ("em': " <> show em')
-          . counterexample ("em'': " <> show em'')
-          $ em'' ^. at eid === Just (Positioned p e1)
-    ]
-  ]