aboutsummaryrefslogtreecommitdiff
path: root/server/src
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-01-21 11:48:30 +0000
committerGregor Kleen <gkleen@yggdrasil.li>2016-01-21 11:48:30 +0000
commit24ced6db101d7f9ea4e4544566cad9eab372ad51 (patch)
tree59777cf98194215c36a02c207ada248a54e73838 /server/src
parentbfbc22268b3622a2f63cd6f5b929a122ff251fd0 (diff)
downloadthermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar
thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar.gz
thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar.bz2
thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.tar.xz
thermoprint-24ced6db101d7f9ea4e4544566cad9eab372ad51.zip
Logging in Handler
Diffstat (limited to 'server/src')
-rw-r--r--server/src/Thermoprint/Server.hs15
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
80thermoprintServer :: ( MonadLogger m 80thermoprintServer :: ( 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
109type Handler = EitherT ServantErr (ReaderT HandlerInput IO) 112type 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
123listPrinters :: Handler (Map PrinterId PrinterStatus) 126listPrinters :: Handler (Map PrinterId PrinterStatus)
124listPrinters = return Set.empty 127listPrinters = return $ Map.fromList [(1, Available), (7, Available), (3, Available)]
125 128
126queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId 129queueJob :: Maybe PrinterId -> Printout -> Handler API.JobId
127queueJob = return undefined 130queueJob = return undefined