Morphism Seq _ <-> Queue

1 files changed, 15 insertions, 1 deletions

diff --git a/server/src/Thermoprint/Server/Queue.hs b/server/src/Thermoprint/Server/Queue.hs
index cfe0970..68dc7a9 100644
--- a/server/src/Thermoprint/Server/Queue.hs
+++ b/server/src/Thermoprint/Server/Queue.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
 {-# LANGUAGE ExistentialQuantification #-}
 
@@ -14,7 +15,7 @@ import qualified Thermoprint.API as API (JobStatus(..))
 
 import           Thermoprint.Server.Database
 
-import           Data.Sequence (Seq)
+import           Data.Sequence (Seq, ViewL(..), viewl)
 import qualified Data.Sequence as Seq
 
 import           Data.Time
@@ -33,6 +34,8 @@ import           Data.Default.Class
 import           Control.Monad.Morph
 import           Control.Monad.Trans.Compose
 
+import           Data.Monoid
+
 -- | Zipper for 'Seq QueueEntry' with additional support for 'PrintingError' in the section after point
 data Queue = Queue
   { pending :: Seq QueueEntry -- ^ Pending jobs, closest last
@@ -41,6 +44,17 @@ data Queue = Queue
   }
   deriving (Typeable, Generic, NFData)
 
+toSeq :: Queue -> Seq (Bool, QueueEntry, Maybe PrintingError)
+toSeq Queue{..} = fmap (\x -> (False, x, Nothing)) pending <> maybe Seq.empty (\c -> Seq.singleton (True, c, Nothing)) current <> fmap (\(x, p) -> (False, x, p)) history
+
+fromSeq :: Seq (Bool, QueueEntry, Maybe PrintingError) -> Queue
+fromSeq s = Queue pending' current' history'
+  where
+    (fmap (\(_, x, _) -> x) -> pending', pending'') = Seq.breakl (\(c, _, _) -> c) s
+    (current', history') = case viewl pending'' of
+      EmptyL -> (Nothing, Seq.empty)
+      (_, a, _) :< as -> (Just a, fmap (\(_, x, p) -> (x, p)) as)
+
 class HasQueue a where
   extractQueue :: a -> TVar Queue