diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-31 21:13:16 +0000 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-31 21:13:16 +0000 |
| commit | 02b70a1c7ee923b85a44febf99e31476272fcf41 (patch) | |
| tree | 24552a78e3c980137cf362fab96e77b7a274a8d9 /server/src | |
| parent | f05870a7fe99797daed23984617ac68873901983 (diff) | |
| download | thermoprint-02b70a1c7ee923b85a44febf99e31476272fcf41.tar thermoprint-02b70a1c7ee923b85a44febf99e31476272fcf41.tar.gz thermoprint-02b70a1c7ee923b85a44febf99e31476272fcf41.tar.bz2 thermoprint-02b70a1c7ee923b85a44febf99e31476272fcf41.tar.xz thermoprint-02b70a1c7ee923b85a44febf99e31476272fcf41.zip | |
Fixed queue order
Diffstat (limited to 'server/src')
| -rw-r--r-- | server/src/Thermoprint/Server/Printer.hs | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/server/src/Thermoprint/Server/Printer.hs b/server/src/Thermoprint/Server/Printer.hs index 7f41430..5dc593e 100644 --- a/server/src/Thermoprint/Server/Printer.hs +++ b/server/src/Thermoprint/Server/Printer.hs | |||
| @@ -25,7 +25,7 @@ import Thermoprint.Server.Database | |||
| 25 | import Database.Persist | 25 | import Database.Persist |
| 26 | import Database.Persist.Sql | 26 | import Database.Persist.Sql |
| 27 | 27 | ||
| 28 | import Data.Sequence (Seq, ViewL(..), viewl, (<|), (|>)) | 28 | import Data.Sequence (Seq, ViewR(..), viewr, (<|), (|>)) |
| 29 | import qualified Data.Sequence as Seq | 29 | import qualified Data.Sequence as Seq |
| 30 | import Data.Map (Map) | 30 | import Data.Map (Map) |
| 31 | import qualified Data.Map as Map | 31 | import qualified Data.Map as Map |
| @@ -91,9 +91,9 @@ runPrinter :: ( MonadReader ConnectionPool m | |||
| 91 | runPrinter Printer{..} = forever $ do | 91 | runPrinter Printer{..} = forever $ do |
| 92 | entry@(QueueEntry{..}) <- atomically' $ do | 92 | entry@(QueueEntry{..}) <- atomically' $ do |
| 93 | (Queue queuePending Nothing history) <- readTVar queue | 93 | (Queue queuePending Nothing history) <- readTVar queue |
| 94 | case viewl queuePending of | 94 | case viewr queuePending of |
| 95 | EmptyL -> retry | 95 | EmptyR -> retry |
| 96 | (current :< remaining) -> do | 96 | (remaining :> current) -> do |
| 97 | writeTVar queue $!! Queue remaining (Just current) history | 97 | writeTVar queue $!! Queue remaining (Just current) history |
| 98 | return current | 98 | return current |
| 99 | job <- runSqlPool (get jobId) =<< ask | 99 | job <- runSqlPool (get jobId) =<< ask |