Custom monad
This commit is contained in:
		@@ -20,9 +20,11 @@ executable ebook-manager
 | 
				
			|||||||
  other-modules:       Devel.Main
 | 
					  other-modules:       Devel.Main
 | 
				
			||||||
                     , Server
 | 
					                     , Server
 | 
				
			||||||
                     , API
 | 
					                     , API
 | 
				
			||||||
 | 
					                     , Types
 | 
				
			||||||
  -- other-extensions:
 | 
					  -- other-extensions:
 | 
				
			||||||
  build-depends:       base >=4.10 && <4.11
 | 
					  build-depends:       base >=4.10 && <4.11
 | 
				
			||||||
                     , servant
 | 
					                     , servant
 | 
				
			||||||
 | 
					                     , monad-logger
 | 
				
			||||||
                     , servant-server
 | 
					                     , servant-server
 | 
				
			||||||
                     , servant-docs
 | 
					                     , servant-docs
 | 
				
			||||||
                     , classy-prelude
 | 
					                     , classy-prelude
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -17,6 +17,7 @@ import Servant
 | 
				
			|||||||
import Servant.HTML.Lucid (HTML)
 | 
					import Servant.HTML.Lucid (HTML)
 | 
				
			||||||
import Lucid (HtmlT, ToHtml(..))
 | 
					import Lucid (HtmlT, ToHtml(..))
 | 
				
			||||||
import qualified Lucid.Html5 as H
 | 
					import qualified Lucid.Html5 as H
 | 
				
			||||||
 | 
					import Types
 | 
				
			||||||
 | 
					
 | 
				
			||||||
data Index = Index
 | 
					data Index = Index
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@@ -39,5 +40,5 @@ instance ToHtml Index where
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
type API = Get '[HTML] Index
 | 
					type API = Get '[HTML] Index
 | 
				
			||||||
 | 
					
 | 
				
			||||||
handler :: ServerT API Handler
 | 
					handler :: ServerT API AppM
 | 
				
			||||||
handler = return Index
 | 
					handler = return Index
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -2,9 +2,10 @@ module Main where
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
import Server (server)
 | 
					import Server (server)
 | 
				
			||||||
import Network.Wai.Handler.Warp (run)
 | 
					import Network.Wai.Handler.Warp (run)
 | 
				
			||||||
 | 
					import Types
 | 
				
			||||||
 | 
					
 | 
				
			||||||
defaultMain :: IO ()
 | 
					defaultMain :: IO ()
 | 
				
			||||||
defaultMain = run 8080 server
 | 
					defaultMain = run 8080 (server App)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
main :: IO ()
 | 
					main :: IO ()
 | 
				
			||||||
main = defaultMain
 | 
					main = defaultMain
 | 
				
			||||||
 
 | 
				
			|||||||
@@ -13,15 +13,18 @@ module Server where
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
import qualified API as API
 | 
					import qualified API as API
 | 
				
			||||||
import Servant
 | 
					import Servant
 | 
				
			||||||
 | 
					import Types
 | 
				
			||||||
 | 
					import ClassyPrelude hiding (Handler)
 | 
				
			||||||
 | 
					import Control.Monad.Logger
 | 
				
			||||||
 | 
					import Control.Monad.Except
 | 
				
			||||||
 | 
					
 | 
				
			||||||
type API = API.API :<|> "static" :> Raw
 | 
					type API = API.API :<|> "static" :> Raw
 | 
				
			||||||
 | 
					
 | 
				
			||||||
handler :: ServerT API Handler
 | 
					 | 
				
			||||||
handler = API.handler :<|> serveDirectoryFileServer "static"
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					server :: App -> Application
 | 
				
			||||||
server :: Application
 | 
					server app = serve api (enter server' API.handler :<|> serveDirectoryFileServer "static")
 | 
				
			||||||
server = serve api handler
 | 
					 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
 | 
					    server' :: AppM :~> Servant.Handler
 | 
				
			||||||
 | 
					    server' = NT (Handler . ExceptT . try . (`runReaderT` app) . (runFileLoggingT "logs/server.log"))
 | 
				
			||||||
    api :: Proxy API
 | 
					    api :: Proxy API
 | 
				
			||||||
    api = Proxy
 | 
					    api = Proxy
 | 
				
			||||||
 
 | 
				
			|||||||
							
								
								
									
										9
									
								
								src/Types.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										9
									
								
								src/Types.hs
									
									
									
									
									
										Normal 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)
 | 
				
			||||||
		Reference in New Issue
	
	Block a user