Custom monad

This commit is contained in:
Mats Rauhala 2018-08-02 22:32:23 +03:00
parent 1e088afce4
commit 6d08e9dad4
5 changed files with 23 additions and 7 deletions

View File

@ -20,9 +20,11 @@ executable ebook-manager
other-modules: Devel.Main
, Server
, API
, Types
-- other-extensions:
build-depends: base >=4.10 && <4.11
, servant
, monad-logger
, servant-server
, servant-docs
, classy-prelude

View File

@ -17,6 +17,7 @@ import Servant
import Servant.HTML.Lucid (HTML)
import Lucid (HtmlT, ToHtml(..))
import qualified Lucid.Html5 as H
import Types
data Index = Index
@ -39,5 +40,5 @@ instance ToHtml Index where
type API = Get '[HTML] Index
handler :: ServerT API Handler
handler :: ServerT API AppM
handler = return Index

View File

@ -2,9 +2,10 @@ module Main where
import Server (server)
import Network.Wai.Handler.Warp (run)
import Types
defaultMain :: IO ()
defaultMain = run 8080 server
defaultMain = run 8080 (server App)
main :: IO ()
main = defaultMain

View File

@ -13,15 +13,18 @@ module Server where
import qualified API as API
import Servant
import Types
import ClassyPrelude hiding (Handler)
import Control.Monad.Logger
import Control.Monad.Except
type API = API.API :<|> "static" :> Raw
handler :: ServerT API Handler
handler = API.handler :<|> serveDirectoryFileServer "static"
server :: Application
server = serve api handler
server :: App -> Application
server app = serve api (enter server' API.handler :<|> serveDirectoryFileServer "static")
where
server' :: AppM :~> Servant.Handler
server' = NT (Handler . ExceptT . try . (`runReaderT` app) . (runFileLoggingT "logs/server.log"))
api :: Proxy API
api = Proxy

9
src/Types.hs Normal file
View File

@ -0,0 +1,9 @@
{-# Language NoImplicitPrelude #-}
module Types where
import ClassyPrelude
import Control.Monad.Logger
data App = App
type AppM = LoggingT (ReaderT App IO)