diff options
| -rw-r--r-- | server/src/Thermoprint/Server.hs | 2 | ||||
| -rw-r--r-- | server/src/Thermoprint/Server/Printer.hs | 4 |
2 files changed, 5 insertions, 1 deletions
diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs index 2413b2a..678d056 100644 --- a/server/src/Thermoprint/Server.hs +++ b/server/src/Thermoprint/Server.hs | |||
| @@ -34,6 +34,7 @@ import Control.Monad.Reader | |||
| 34 | import Control.Monad.IO.Class | 34 | import Control.Monad.IO.Class |
| 35 | import Control.Monad.Morph | 35 | import Control.Monad.Morph |
| 36 | import Control.Category | 36 | import Control.Category |
| 37 | import Control.Monad.Catch (MonadMask) | ||
| 37 | import Prelude hiding (id, (.)) | 38 | import Prelude hiding (id, (.)) |
| 38 | 39 | ||
| 39 | import qualified Control.Monad as M | 40 | import qualified Control.Monad as M |
| @@ -105,6 +106,7 @@ withPrinters cfg = fmap updateCfg . foldlM mapInsert (Map.mapWithKey (\k a -> (a | |||
| 105 | thermoprintServer :: ( MonadLoggerIO m | 106 | thermoprintServer :: ( MonadLoggerIO m |
| 106 | , MonadReader ConnectionPool m | 107 | , MonadReader ConnectionPool m |
| 107 | , MonadResourceBase m | 108 | , MonadResourceBase m |
| 109 | , MonadMask m | ||
| 108 | ) => (m :~> IO) -- ^ 'dyre' controls the base of the monad-transformer-stack ('IO') but we let the user specify much of the rest of it (we handle 'ResourceT' ourselves, since we need it to fork properly). Therefore we require a specification of how to collapse the stack. | 110 | ) => (m :~> IO) -- ^ 'dyre' controls the base of the monad-transformer-stack ('IO') but we let the user specify much of the rest of it (we handle 'ResourceT' ourselves, since we need it to fork properly). Therefore we require a specification of how to collapse the stack. |
| 109 | -> ResourceT m (Config (ResourceT m)) -> IO () | 111 | -> ResourceT m (Config (ResourceT m)) -> IO () |
| 110 | -- ^ Run the server | 112 | -- ^ Run the server |
diff --git a/server/src/Thermoprint/Server/Printer.hs b/server/src/Thermoprint/Server/Printer.hs index d9cea9d..d0dc37b 100644 --- a/server/src/Thermoprint/Server/Printer.hs +++ b/server/src/Thermoprint/Server/Printer.hs | |||
| @@ -40,6 +40,7 @@ import Control.Monad.Trans.Resource | |||
| 40 | import Control.Monad.IO.Class | 40 | import Control.Monad.IO.Class |
| 41 | import Control.Monad.Logger | 41 | import Control.Monad.Logger |
| 42 | import Control.Monad.Reader | 42 | import Control.Monad.Reader |
| 43 | import Control.Monad.Catch (MonadMask) | ||
| 43 | 44 | ||
| 44 | import Control.Monad (forever) | 45 | import Control.Monad (forever) |
| 45 | 46 | ||
| @@ -49,7 +50,7 @@ import Data.Time.Clock | |||
| 49 | 50 | ||
| 50 | import Thermoprint.Server.Queue | 51 | import Thermoprint.Server.Queue |
| 51 | 52 | ||
| 52 | newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m) => Printout -> m (Maybe PrintingError) } | 53 | newtype PrinterMethod = PM { unPM :: forall m. (MonadResource m, MonadLogger m, MonadMask m) => Printout -> m (Maybe PrintingError) } |
| 53 | 54 | ||
| 54 | data Printer = Printer | 55 | data Printer = Printer |
| 55 | { print :: PrinterMethod | 56 | { print :: PrinterMethod |
| @@ -69,6 +70,7 @@ runPrinter :: ( MonadReader ConnectionPool m | |||
| 69 | , MonadLogger m | 70 | , MonadLogger m |
| 70 | , MonadBaseControl IO m | 71 | , MonadBaseControl IO m |
| 71 | , MonadResource m | 72 | , MonadResource m |
| 73 | , MonadMask m | ||
| 72 | ) => Printer -> m () | 74 | ) => Printer -> m () |
| 73 | -- ^ Loop 'forever' pushing entries from the 'Queue' associated to a 'Printer' into its 'print'-method | 75 | -- ^ Loop 'forever' pushing entries from the 'Queue' associated to a 'Printer' into its 'print'-method |
| 74 | runPrinter Printer{..} = forever $ do | 76 | runPrinter Printer{..} = forever $ do |
