Test for zipper morphisms

5 files changed, 55 insertions, 5 deletions

diff --git a/server/src/Thermoprint/Server/Queue.hs b/server/src/Thermoprint/Server/Queue.hs
index d5ab42b..52e973d 100644
--- a/server/src/Thermoprint/Server/Queue.hs
+++ b/server/src/Thermoprint/Server/Queue.hs
@@ -52,7 +52,7 @@ data Queue = Queue
   , current :: Maybe QueueEntry
   , history :: Seq (QueueEntry, Maybe PrintingError) -- ^ Completed jobs, closest first
   }
-  deriving (Typeable, Generic, NFData)
+  deriving (Typeable, Generic, NFData, Show)
 
 class HasQueue a where
   extractQueue :: a -> TVar Queue
@@ -71,7 +71,7 @@ data QueueEntry = QueueEntry
   { jobId :: JobId
   , created :: UTCTime
   }
-  deriving (Typeable, Generic, NFData, Eq, Ord)
+  deriving (Typeable, Generic, NFData, Eq, Ord, Show)
 
 data QueueItem = Pending Int QueueEntry | Current QueueEntry | History Int QueueEntry (Maybe PrintingError)
 
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)
diff --git a/server/thermoprint-server.cabal b/server/thermoprint-server.cabal
index 5e1b0b2..5783f06 100644
--- a/server/thermoprint-server.cabal
+++ b/server/thermoprint-server.cabal
@@ -52,6 +52,17 @@ library
   hs-source-dirs:      src
   default-language:    Haskell2010
 
+Test-Suite tests
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base >=4.8.1 && <5
+                     , thermoprint-server -any
+                     , thermoprint-spec -any
+                     , hspec >=2.2.1 && <3
+                     , QuickCheck >=2.8.1 && <3
+                     , quickcheck-instances >=0.3.11 && <4
+
 executable thermoprint-server
   main-is:             Main.hs
   build-depends:       base >=4.8 && <5
diff --git a/server/thermoprint-server.nix b/server/thermoprint-server.nix
index 41f7198..a33e6db 100644
--- a/server/thermoprint-server.nix
+++ b/server/thermoprint-server.nix
@@ -1,8 +1,9 @@
 { mkDerivation, base, conduit, containers, data-default-class
-, deepseq, dyre, either, exceptions, extended-reals, mmorph
+, deepseq, dyre, either, exceptions, extended-reals, hspec, mmorph
 , monad-control, monad-logger, mtl, persistent, persistent-sqlite
-, persistent-template, resourcet, servant-server, stdenv, stm, text
-, thermoprint-spec, time, transformers, wai, warp
+, persistent-template, QuickCheck, quickcheck-instances, resourcet
+, servant-server, stdenv, stm, text, thermoprint-spec, time
+, transformers, wai, warp
 }:
 mkDerivation {
   pname = "thermoprint-server";
@@ -19,6 +20,9 @@ mkDerivation {
   executableHaskellDepends = [
     base monad-logger mtl persistent-sqlite resourcet
   ];
+  testHaskellDepends = [
+    base hspec QuickCheck quickcheck-instances
+  ];
   homepage = "http://dirty-haskell.org/tags/thermoprint.html";
   description = "Server for thermoprint-spec";
   license = stdenv.lib.licenses.publicDomain;