Test for zipper morphisms

2 files changed, 35 insertions, 0 deletions

diff --git a/server/test/Spec.hs b/server/test/Spec.hs
new file mode 100644
index 0000000..a824f8c
--- /dev/null
+++ b/server/test/Spec.hs
@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/server/test/Thermoprint/Server/QueueSpec.hs b/server/test/Thermoprint/Server/QueueSpec.hs
new file mode 100644
index 0000000..fd45e1b
--- /dev/null
+++ b/server/test/Thermoprint/Server/QueueSpec.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, StandaloneDeriving #-}
+
+module Thermoprint.Server.QueueSpec (spec) where
+
+import Test.Hspec
+import Test.Hspec.QuickCheck (prop)
+
+import Thermoprint.Server.Queue
+import Thermoprint.Server.Database
+import Thermoprint.API hiding (JobId)
+
+import Test.QuickCheck.Arbitrary
+import Test.QuickCheck.Gen
+import Test.QuickCheck.Modifiers
+
+deriving instance (Eq PrintingError)
+deriving instance (Eq Queue)
+
+instance Arbitrary Queue where
+  arbitrary = Queue <$> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary QueueEntry where
+  arbitrary = QueueEntry <$> arbitrary <*> arbitrary
+
+instance Arbitrary PrintingError where
+  arbitrary = oneof [ return UnknownError
+                    ]
+
+instance Arbitrary JobId where
+  arbitrary = castId . getNonNegative <$> (arbitrary :: Gen (NonNegative Integer))
+
+spec :: Spec
+spec = do
+  prop "prop_zipper" $ \queue -> queue == toZipper (fromZipper queue)