diff options
Diffstat (limited to 'server/src/Thermoprint/Server/Printer.hs')
-rw-r--r-- | server/src/Thermoprint/Server/Printer.hs | 24 |
1 files changed, 2 insertions, 22 deletions
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 @@ | |||
6 | {-# LANGUAGE StandaloneDeriving #-} | 6 | {-# LANGUAGE StandaloneDeriving #-} |
7 | {-# LANGUAGE GADTs #-} | 7 | {-# LANGUAGE GADTs #-} |
8 | {-# LANGUAGE ExistentialQuantification #-} | 8 | {-# LANGUAGE ExistentialQuantification #-} |
9 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} | ||
10 | 9 | ||
11 | module Thermoprint.Server.Printer | 10 | module Thermoprint.Server.Printer |
12 | ( PrinterMethod(..), Printer(..) | 11 | ( PrinterMethod(..), Printer(..) |
@@ -48,6 +47,8 @@ import Control.Concurrent.STM | |||
48 | 47 | ||
49 | import Data.Time.Clock | 48 | import Data.Time.Clock |
50 | 49 | ||
50 | import Thermoprint.Server.Queue | ||
51 | |||
51 | newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m) => Printout -> m (Maybe PrintingError) } | 52 | newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m) => Printout -> m (Maybe PrintingError) } |
52 | 53 | ||
53 | data Printer = Printer | 54 | data Printer = Printer |
@@ -55,27 +56,6 @@ data Printer = Printer | |||
55 | , queue :: TVar Queue | 56 | , queue :: TVar Queue |
56 | } | 57 | } |
57 | 58 | ||
58 | -- | Zipper for 'Seq QueueEntry' | ||
59 | data Queue = Queue | ||
60 | { pending :: Seq QueueEntry -- ^ Pending jobs, closest last | ||
61 | , current :: Maybe QueueEntry | ||
62 | , history :: Seq (QueueEntry, Maybe PrintingError) -- ^ Completed jobs, closest first | ||
63 | } | ||
64 | deriving (Typeable, Generic, NFData) | ||
65 | |||
66 | instance Default Queue where | ||
67 | def = Queue | ||
68 | { pending = Seq.empty | ||
69 | , current = Nothing | ||
70 | , history = Seq.empty | ||
71 | } | ||
72 | |||
73 | data QueueEntry = QueueEntry | ||
74 | { jobId :: JobId | ||
75 | , created :: UTCTime | ||
76 | } | ||
77 | deriving (Typeable, Generic, NFData) | ||
78 | |||
79 | printer :: MonadResource m => m PrinterMethod -> m Printer | 59 | printer :: MonadResource m => m PrinterMethod -> m Printer |
80 | printer p = Printer <$> p <*> liftIO (newTVarIO def) | 60 | printer p = Printer <$> p <*> liftIO (newTVarIO def) |
81 | 61 | ||