From cf8aef18aad8e92f699165350ec4e18a0f2ee3f5 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 6 Mar 2017 21:13:03 +0100 Subject: Migrate thermoprint-server to postgresql --- bragi/thermoprint-server/thermoprint-server.hs | 30 ++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 bragi/thermoprint-server/thermoprint-server.hs (limited to 'bragi/thermoprint-server') diff --git a/bragi/thermoprint-server/thermoprint-server.hs b/bragi/thermoprint-server/thermoprint-server.hs new file mode 100644 index 00000000..4f909f80 --- /dev/null +++ b/bragi/thermoprint-server/thermoprint-server.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ImpredicativeTypes #-} + +module Main (main) where + +import Thermoprint.Server + +import Thermoprint.Server.Printer.Generic + +import Control.Monad.Trans.Resource +import Control.Monad.Logger +import Control.Monad.Reader + +import Database.Persist.Postgresql + +main :: IO () +main = thermoprintServer True (Nat runDb) $ (\c -> c { queueManagers = queueManagers }) <$> def `withPrinters` printers + where + runDb :: ReaderT ConnectionPool (LoggingT IO) a -> IO a + runDb = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT + + printers = [ (pure $ genericPrint "/dev/usb/lp0", def) + ] + + queueManagers _ = QMConfig + { manager = union [ limitHistorySize 100 + , limitHistoryAge 3600 + ] + , collapse = standardCollapse + } -- cgit v1.2.3 From b519427c4e02671dffa24aa6e6ddf536480fb9d4 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 9 Mar 2017 21:30:10 +0100 Subject: Add types to thermoprint-server --- bragi/thermoprint-server/thermoprint-server.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'bragi/thermoprint-server') diff --git a/bragi/thermoprint-server/thermoprint-server.hs b/bragi/thermoprint-server/thermoprint-server.hs index 4f909f80..6142e7d9 100644 --- a/bragi/thermoprint-server/thermoprint-server.hs +++ b/bragi/thermoprint-server/thermoprint-server.hs @@ -13,12 +13,15 @@ import Control.Monad.Reader import Database.Persist.Postgresql +type ServerM = ReaderT ConnectionPool (LoggingT IO) + main :: IO () main = thermoprintServer True (Nat runDb) $ (\c -> c { queueManagers = queueManagers }) <$> def `withPrinters` printers where - runDb :: ReaderT ConnectionPool (LoggingT IO) a -> IO a + runDb :: ServerM a -> IO a runDb = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT + printers :: [(ResourceT ServerM PrinterMethod, QMConfig (ResourceT ServerM))] printers = [ (pure $ genericPrint "/dev/usb/lp0", def) ] -- cgit v1.2.3 From 03025c105e5fb3055e57e2df9d2af258d579ff7f Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 9 Mar 2017 21:58:34 +0100 Subject: Configure warp --- bragi/thermoprint-server/thermoprint-server.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'bragi/thermoprint-server') 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 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ImpredicativeTypes #-} +{-# LANGUAGE RecordWildCards #-} module Main (main) where @@ -11,19 +12,22 @@ import Control.Monad.Trans.Resource import Control.Monad.Logger import Control.Monad.Reader +import Data.Function ((&)) + import Database.Persist.Postgresql +import qualified Network.Wai.Handler.Warp as Warp + type ServerM = ReaderT ConnectionPool (LoggingT IO) main :: IO () -main = thermoprintServer True (Nat runDb) $ (\c -> c { queueManagers = queueManagers }) <$> def `withPrinters` printers +main = thermoprintServer True (Nat runDb) $ configure (\c -> c{..}) <$> def `withPrinters` printers' where runDb :: ServerM a -> IO a runDb = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT - printers :: [(ResourceT ServerM PrinterMethod, QMConfig (ResourceT ServerM))] - printers = [ (pure $ genericPrint "/dev/usb/lp0", def) - ] + printers' = [ (pure $ genericPrint "/dev/usb/lp0", def :: QMConfig (ResourceT ServerM)) + ] queueManagers _ = QMConfig { manager = union [ limitHistorySize 100 @@ -31,3 +35,7 @@ main = thermoprintServer True (Nat runDb) $ (\c -> c { queueManagers = queueMana ] , collapse = standardCollapse } + + warpSettings = Warp.defaultSettings + & Warp.setHost "localhost" + & Warp.setPort 8080 -- cgit v1.2.3 From cf6ba7cbff444db49797076b70a639961f29e8ef Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 9 Mar 2017 22:02:46 +0100 Subject: Syntax --- bragi/thermoprint-server/thermoprint-server.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'bragi/thermoprint-server') diff --git a/bragi/thermoprint-server/thermoprint-server.hs b/bragi/thermoprint-server/thermoprint-server.hs index 97b37374..7e571021 100644 --- a/bragi/thermoprint-server/thermoprint-server.hs +++ b/bragi/thermoprint-server/thermoprint-server.hs @@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ImpredicativeTypes #-} -{-# LANGUAGE RecordWildCards #-} module Main (main) where @@ -21,7 +20,7 @@ import qualified Network.Wai.Handler.Warp as Warp type ServerM = ReaderT ConnectionPool (LoggingT IO) main :: IO () -main = thermoprintServer True (Nat runDb) $ configure (\c -> c{..}) <$> def `withPrinters` printers' +main = thermoprintServer True (Nat runDb) $ configure <$> def `withPrinters` printers' where runDb :: ServerM a -> IO a runDb = runStderrLoggingT . withPostgresqlPool "" 5 . runReaderT @@ -29,6 +28,11 @@ main = thermoprintServer True (Nat runDb) $ configure (\c -> c{..}) <$> def `wit printers' = [ (pure $ genericPrint "/dev/usb/lp0", def :: QMConfig (ResourceT ServerM)) ] + configure c = c + { queueManagers = queueManagers + , warpSettings = warpSettings + } + queueManagers _ = QMConfig { manager = union [ limitHistorySize 100 , limitHistoryAge 3600 -- cgit v1.2.3 From 5f7dfe0b58e961d4f798691e6067d61e44460470 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 9 Mar 2017 22:08:24 +0100 Subject: Poke thermoprint config --- bragi/thermoprint-server/thermoprint-server.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'bragi/thermoprint-server') diff --git a/bragi/thermoprint-server/thermoprint-server.hs b/bragi/thermoprint-server/thermoprint-server.hs index 7e571021..4635dd0a 100644 --- a/bragi/thermoprint-server/thermoprint-server.hs +++ b/bragi/thermoprint-server/thermoprint-server.hs @@ -41,5 +41,5 @@ main = thermoprintServer True (Nat runDb) $ configure <$> def `withPrinters` pri } warpSettings = Warp.defaultSettings - & Warp.setHost "localhost" + & Warp.setHost "::1" & Warp.setPort 8080 -- cgit v1.2.3