diff options
Diffstat (limited to 'server/src/Thermoprint/Server/Printer.hs')
-rw-r--r-- | server/src/Thermoprint/Server/Printer.hs | 20 |
1 files changed, 4 insertions, 16 deletions
diff --git a/server/src/Thermoprint/Server/Printer.hs b/server/src/Thermoprint/Server/Printer.hs index 46b8a53..5b1b7b0 100644 --- a/server/src/Thermoprint/Server/Printer.hs +++ b/server/src/Thermoprint/Server/Printer.hs | |||
@@ -1,7 +1,4 @@ | |||
1 | {-# LANGUAGE RankNTypes #-} | 1 | {-# LANGUAGE RankNTypes #-} |
2 | {-# LANGUAGE TypeSynonymInstances #-} | ||
3 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
4 | {-# LANGUAGE FlexibleInstances #-} | ||
5 | {-# LANGUAGE FlexibleContexts #-} | 2 | {-# LANGUAGE FlexibleContexts #-} |
6 | {-# LANGUAGE RecordWildCards #-} | 3 | {-# LANGUAGE RecordWildCards #-} |
7 | {-# LANGUAGE OverloadedStrings #-} | 4 | {-# LANGUAGE OverloadedStrings #-} |
@@ -12,7 +9,8 @@ | |||
12 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} | 9 | {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} |
13 | 10 | ||
14 | module Thermoprint.Server.Printer | 11 | module Thermoprint.Server.Printer |
15 | ( PrinterMethod(..), PrinterSpec(..), IsPrinter(..), Printer(..), printer | 12 | ( PrinterMethod(..), Printer(..) |
13 | , printer | ||
16 | , Queue(..) | 14 | , Queue(..) |
17 | , runPrinter | 15 | , runPrinter |
18 | , addToQueue | 16 | , addToQueue |
@@ -48,16 +46,6 @@ import Control.Monad (forever) | |||
48 | import Control.Concurrent.STM | 46 | import Control.Concurrent.STM |
49 | 47 | ||
50 | newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m) => Printout -> m (Maybe PrintingError) } | 48 | newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m) => Printout -> m (Maybe PrintingError) } |
51 | data PrinterSpec m = forall p. IsPrinter p m => PS p | ||
52 | |||
53 | class IsPrinter p m where | ||
54 | printMethod :: p -> m PrinterMethod | ||
55 | |||
56 | instance Applicative m => IsPrinter PrinterMethod m where | ||
57 | printMethod = pure | ||
58 | |||
59 | instance IsPrinter (PrinterSpec m) m where | ||
60 | printMethod (PS p) = printMethod p | ||
61 | 49 | ||
62 | data Printer = Printer | 50 | data Printer = Printer |
63 | { print :: PrinterMethod | 51 | { print :: PrinterMethod |
@@ -79,8 +67,8 @@ instance Default Queue where | |||
79 | , history = Seq.empty | 67 | , history = Seq.empty |
80 | } | 68 | } |
81 | 69 | ||
82 | printer :: (MonadResource m, IsPrinter p m) => p -> m Printer | 70 | printer :: MonadResource m => m PrinterMethod -> m Printer |
83 | printer spec = Printer <$> printMethod spec <*> liftIO (newTVarIO def) | 71 | printer p = Printer <$> p <*> liftIO (newTVarIO def) |
84 | 72 | ||
85 | atomically' :: MonadIO m => STM a -> m a | 73 | atomically' :: MonadIO m => STM a -> m a |
86 | atomically' = liftIO . atomically | 74 | atomically' = liftIO . atomically |