chore(users): grfn -> aspen
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809 Autosubmit: aspen <root@gws.fyi> Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI Reviewed-by: lukegb <lukegb@tvl.fyi>
This commit is contained in:
parent
0ba476a426
commit
82ecd61f5c
478 changed files with 75 additions and 77 deletions
69
users/aspen/xanthous/test/Xanthous/Data/EntityMapSpec.hs
Normal file
69
users/aspen/xanthous/test/Xanthous/Data/EntityMapSpec.hs
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
{-# 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)
|
||||
]
|
||||
]
|
||||
Loading…
Add table
Add a link
Reference in a new issue