diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-09 21:58:34 +0100 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2017-03-09 21:58:34 +0100 |
| commit | 03025c105e5fb3055e57e2df9d2af258d579ff7f (patch) | |
| tree | fbf2457c688838ac60f9f6726e0baebb7ed25b06 /bragi | |
| parent | edd2494e67cc92b8fb4a0ff706ea3a53248ca6d3 (diff) | |
| download | nixos-03025c105e5fb3055e57e2df9d2af258d579ff7f.tar nixos-03025c105e5fb3055e57e2df9d2af258d579ff7f.tar.gz nixos-03025c105e5fb3055e57e2df9d2af258d579ff7f.tar.bz2 nixos-03025c105e5fb3055e57e2df9d2af258d579ff7f.tar.xz nixos-03025c105e5fb3055e57e2df9d2af258d579ff7f.zip | |
Configure warp
Diffstat (limited to 'bragi')
| -rw-r--r-- | bragi/thermoprint-server/thermoprint-server.hs | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/bragi/thermoprint-server/thermoprint-server.hs b/bragi/thermoprint-server/thermoprint-server.hs index 6142e7d9..97b37374 100644 --- a/bragi/thermoprint-server/thermoprint-server.hs +++ b/bragi/thermoprint-server/thermoprint-server.hs | |||
| @@ -1,5 +1,6 @@ | |||
| 1 | {-# LANGUAGE OverloadedStrings #-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
| 2 | {-# LANGUAGE ImpredicativeTypes #-} | 2 | {-# LANGUAGE ImpredicativeTypes #-} |
| 3 | {-# LANGUAGE RecordWildCards #-} | ||
| 3 | 4 | ||
| 4 | module Main (main) where | 5 | module Main (main) where |
| 5 | 6 | ||
| @@ -11,19 +12,22 @@ import Control.Monad.Trans.Resource | |||
| 11 | import Control.Monad.Logger | 12 | import Control.Monad.Logger |
| 12 | import Control.Monad.Reader | 13 | import Control.Monad.Reader |
| 13 | 14 | ||
| 15 | import Data.Function ((&)) | ||
| 16 | |||
| 14 | import Database.Persist.Postgresql | 17 | import Database.Persist.Postgresql |
| 15 | 18 | ||
| 19 | import qualified Network.Wai.Handler.Warp as Warp | ||
| 20 | |||
| 16 | type ServerM = ReaderT ConnectionPool (LoggingT IO) | 21 | type ServerM = ReaderT ConnectionPool (LoggingT IO) |
| 17 | 22 | ||
| 18 | main :: IO () | 23 | main :: IO () |
| 19 | main = thermoprintServer True (Nat runDb) $ (\c -> c { queueManagers = queueManagers }) <$> def `withPrinters` printers | 24 | main = thermoprintServer True (Nat runDb) $ configure (\c -> c{..}) <$> def `withPrinters` printers' |
| 20 | where | 25 | where |
| 21 | runDb :: ServerM a -> IO a | 26 | runDb :: ServerM a -> IO a |
| 22 | runDb = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT | 27 | runDb = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT |
| 23 | 28 | ||
| 24 | printers :: [(ResourceT ServerM PrinterMethod, QMConfig (ResourceT ServerM))] | 29 | printers' = [ (pure $ genericPrint "/dev/usb/lp0", def :: QMConfig (ResourceT ServerM)) |
| 25 | printers = [ (pure $ genericPrint "/dev/usb/lp0", def) | 30 | ] |
| 26 | ] | ||
| 27 | 31 | ||
| 28 | queueManagers _ = QMConfig | 32 | queueManagers _ = QMConfig |
| 29 | { manager = union [ limitHistorySize 100 | 33 | { manager = union [ limitHistorySize 100 |
| @@ -31,3 +35,7 @@ main = thermoprintServer True (Nat runDb) $ (\c -> c { queueManagers = queueMana | |||
| 31 | ] | 35 | ] |
| 32 | , collapse = standardCollapse | 36 | , collapse = standardCollapse |
| 33 | } | 37 | } |
| 38 | |||
| 39 | warpSettings = Warp.defaultSettings | ||
| 40 | & Warp.setHost "localhost" | ||
| 41 | & Warp.setPort 8080 | ||
