diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-21 11:48:30 +0000 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-21 11:48:30 +0000 |
commit | 24ced6db101d7f9ea4e4544566cad9eab372ad51 (patch) | |
tree | 59777cf98194215c36a02c207ada248a54e73838 | |
parent | bfbc22268b3622a2f63cd6f5b929a122ff251fd0 (diff) | |
download | thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar.gz thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar.bz2 thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar.xz thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.zip |
Logging in Handler
-rw-r--r-- | server/src/Thermoprint/Server.hs | 15 |
1 files changed, 9 insertions, 6 deletions
diff --git a/server/src/Thermoprint/Server.hs b/server/src/Thermoprint/Server.hs index 8cbe71d..b26d387 100644 --- a/server/src/Thermoprint/Server.hs +++ b/server/src/Thermoprint/Server.hs | |||
@@ -77,7 +77,7 @@ Draft | |||
77 | |] | 77 | |] |
78 | 78 | ||
79 | 79 | ||
80 | thermoprintServer :: ( MonadLogger m | 80 | thermoprintServer :: ( MonadLoggerIO m |
81 | , MonadIO m | 81 | , MonadIO m |
82 | , MonadBaseControl IO m | 82 | , MonadBaseControl IO m |
83 | , MonadReader ConnectionPool m | 83 | , MonadReader ConnectionPool m |
@@ -97,16 +97,19 @@ thermoprintServer io = Dyre.wrapMain $ Dyre.defaultParams | |||
97 | 97 | ||
98 | realMain (Config{..}) = enter io $ do | 98 | realMain (Config{..}) = enter io $ do |
99 | sqlPool <- ask | 99 | sqlPool <- ask |
100 | runSqlPool (runMigrationSilent migrateAll) sqlPool >>= mapM_ $(logWarn) | 100 | runSqlPool (runMigrationSilent migrateAll) sqlPool >>= mapM_ ($(logWarnS) "DB") |
101 | |||
102 | logFunc <- askLoggerIO | ||
103 | |||
101 | let | 104 | let |
102 | handlerInput = HandlerInput | 105 | handlerInput = HandlerInput |
103 | { sqlPool = sqlPool | 106 | { sqlPool = sqlPool |
104 | } | 107 | } |
105 | io' :: ReaderT HandlerInput IO :~> IO | 108 | io' :: ReaderT HandlerInput (LoggingT IO) :~> IO |
106 | io' = runReaderTNat handlerInput | 109 | io' = Nat (($ logFunc) . runLoggingT) . runReaderTNat handlerInput |
107 | liftIO . Warp.runSettings warpSettings . serve thermoprintAPI $ enter (hoistNat io') thermoprintServer' | 110 | liftIO . Warp.runSettings warpSettings . serve thermoprintAPI $ enter (hoistNat io') thermoprintServer' |
108 | 111 | ||
109 | type Handler = EitherT ServantErr (ReaderT HandlerInput IO) | 112 | type Handler = EitherT ServantErr (ReaderT HandlerInput (LoggingT IO)) |
110 | 113 | ||
111 | (<||>) :: Monad m => m a -> m b -> m (a :<|> b) | 114 | (<||>) :: Monad m => m a -> m b -> m (a :<|> b) |
112 | (<||>) = liftM2 (:<|>) | 115 | (<||>) = liftM2 (:<|>) |
@@ -121,7 +124,7 @@ thermoprintServer' = listPrinters | |||
121 | 124 | ||
122 | 125 | ||
123 | listPrinters :: Handler (Map PrinterId PrinterStatus) | 126 | listPrinters :: Handler (Map PrinterId PrinterStatus) |
124 | listPrinters = return Set.empty | 127 | listPrinters = return $ Map.fromList [(1, Available), (7, Available), (3, Available)] |
125 | 128 | ||
126 | queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId | 129 | queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId |
127 | queueJob = return undefined | 130 | queueJob = return undefined |