From c63f7ca27bf3a014dd501a6f58dc6a983251df4d Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 4 Feb 2016 19:04:35 +0000
Subject: Split Queue-management into new module

---
 server/src/Thermoprint/Server/API.hs     |  1 +
 server/src/Thermoprint/Server/Printer.hs | 24 ++----------------
 server/src/Thermoprint/Server/Queue.hs   | 43 ++++++++++++++++++++++++++++++++
 3 files changed, 46 insertions(+), 22 deletions(-)
 create mode 100644 server/src/Thermoprint/Server/Queue.hs

(limited to 'server/src')

diff --git a/server/src/Thermoprint/Server/API.hs b/server/src/Thermoprint/Server/API.hs
index 247fb89..7868f2c 100644
--- a/server/src/Thermoprint/Server/API.hs
+++ b/server/src/Thermoprint/Server/API.hs
@@ -13,6 +13,7 @@ import           Thermoprint.API hiding (JobId(..), DraftId(..))
 import qualified Thermoprint.API as API (JobId(..), DraftId(..))
 
 import           Thermoprint.Server.Printer
+import           Thermoprint.Server.Queue
 import           Thermoprint.Server.Database
 
 import           Data.Set (Set)
diff --git a/server/src/Thermoprint/Server/Printer.hs b/server/src/Thermoprint/Server/Printer.hs
index 5dc593e..3700f45 100644
--- a/server/src/Thermoprint/Server/Printer.hs
+++ b/server/src/Thermoprint/Server/Printer.hs
@@ -6,7 +6,6 @@
 {-# LANGUAGE StandaloneDeriving            #-}
 {-# LANGUAGE GADTs                         #-}
 {-# LANGUAGE ExistentialQuantification     #-}
-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 
 module Thermoprint.Server.Printer
        ( PrinterMethod(..), Printer(..)
@@ -48,6 +47,8 @@ import           Control.Concurrent.STM
 
 import           Data.Time.Clock
 
+import           Thermoprint.Server.Queue
+
 newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m) => Printout -> m (Maybe PrintingError) }
 
 data Printer = Printer
@@ -55,27 +56,6 @@ data Printer = Printer
   , queue :: TVar Queue
   }
 
--- | Zipper for 'Seq QueueEntry'
-data Queue = Queue
-  { pending :: Seq QueueEntry -- ^ Pending jobs, closest last
-  , current :: Maybe QueueEntry
-  , history :: Seq (QueueEntry, Maybe PrintingError) -- ^ Completed jobs, closest first
-  }
-  deriving (Typeable, Generic, NFData)
-
-instance Default Queue where
-  def = Queue
-    { pending = Seq.empty
-    , current = Nothing
-    , history = Seq.empty
-    }
-
-data QueueEntry = QueueEntry
-  { jobId :: JobId
-  , created :: UTCTime
-  }
-  deriving (Typeable, Generic, NFData)
-
 printer :: MonadResource m => m PrinterMethod -> m Printer
 printer p = Printer <$> p <*> liftIO (newTVarIO def)
 
diff --git a/server/src/Thermoprint/Server/Queue.hs b/server/src/Thermoprint/Server/Queue.hs
new file mode 100644
index 0000000..d2400a1
--- /dev/null
+++ b/server/src/Thermoprint/Server/Queue.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
+
+module Thermoprint.Server.Queue
+       ( Queue(..), QueueEntry(..)
+       ) where
+
+import           Thermoprint.API (PrintingError(..), Printout)
+import qualified Thermoprint.API as API (JobStatus(..))
+
+import           Thermoprint.Server.Database
+
+import           Data.Sequence (Seq)
+import qualified Data.Sequence as Seq
+
+import Data.Time
+
+import           Control.DeepSeq (NFData)
+import           Data.Typeable (Typeable)
+import           GHC.Generics (Generic)
+
+import           Data.Default.Class
+
+-- | Zipper for 'Seq QueueEntry'
+data Queue = Queue
+  { pending :: Seq QueueEntry -- ^ Pending jobs, closest last
+  , current :: Maybe QueueEntry
+  , history :: Seq (QueueEntry, Maybe PrintingError) -- ^ Completed jobs, closest first
+  }
+  deriving (Typeable, Generic, NFData)
+
+instance Default Queue where
+  def = Queue
+    { pending = Seq.empty
+    , current = Nothing
+    , history = Seq.empty
+    }
+
+data QueueEntry = QueueEntry
+  { jobId :: JobId
+  , created :: UTCTime
+  }
+  deriving (Typeable, Generic, NFData)
+
-- 
cgit v1.2.3