James/HELPS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Implement logging in terms of IOE and adapt locally; include stdout logging on adapt catches

Browse Source
This commit is contained in:
James Eversole 2024-10-12 17:52:12 -05:00
parent 9a8bd089e5
commit 960bb0c1a8
1 changed files with 10 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Core.hs
View File

@ -62,18 +62,19 @@ writeLog = send . WriteLog
runLoggerIO :: (IOE :> es, Error ServerError :> es) => Eff (Logger : es) a -> Eff es a runLoggerIO :: (IOE :> es, Error ServerError :> es) => Eff (Logger : es) a -> Eff es a
runLoggerIO = interpret $ \_ -> \case runLoggerIO = interpret $ \_ -> \case
WriteLog msg -> adapt $ log msg WriteLog msg -> log msg
where where
log :: String -> IO () log :: (IOE :> es, Error ServerError :> es) => String -> Eff es ()
log msg = putStrLn msg log msg = adapt $ putStrLn msg
-- Utility -- Utility
adapt :: (IOE :> es, Error ServerError :> es) => IO a -> Eff es a adapt :: (IOE :> es, Error ServerError :> es) => IO a -> Eff es a
adapt m = liftIO m `catch` \(e::IOException) -> adapt m = liftIO m `catch` \(e::IOException) -> do
liftIO $ putStrLn $ "ERROR Exception: " ++ show e
throwError $ ServerError throwError $ ServerError
{ errHTTPCode = 500 { errHTTPCode = 500
, errReasonPhrase = "Internal Database Error" , errReasonPhrase = "Internal Server Error"
, errBody = fromString $ show e , errBody = "This incident will be investigated."
, errHeaders = [] , errHeaders = []
} }