-
-
Save goertzenator/aae4f6efc65a2ae930ac5bca10ff9f7c to your computer and use it in GitHub Desktop.
servant and MonadUnliftIO
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE GeneralizedNewtypeDeriving #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
module Main (main) where | |
import Network.Wai | |
import Network.Wai.Handler.Warp | |
import Servant | |
import Control.Monad.IO.Unlift | |
import UnliftIO.Exception hiding (Handler) | |
import UnliftIO.Async | |
import UnliftIO.IORef | |
import UnliftIO.Concurrent | |
import Control.Monad.Except | |
import Control.Monad.Reader | |
-- | |
-- This example drives a counter in an IORef which is available to a Servant API. | |
-- ReaderT is commonly used to enable this sort of this, but this example | |
-- achieves the same thing with MonadUnliftIO. This is useful because other MonadUnliftIO | |
-- monads can be used such as effect monads from cleff and effectful. | |
-- | |
--- Servant API | |
type CounterAPI | |
= "counter" :> Get '[JSON] Int | |
:<|> "fail" :> Get '[JSON] Int | |
counterAPI :: Proxy CounterAPI | |
counterAPI = Proxy | |
main :: IO () | |
main = do | |
counter_ref <- newIORef 0 -- IORef holding counter value | |
race_ | |
-- run servant | |
(runReaderT runserver counter_ref) | |
-- run counter | |
(forever $ modifyIORef' counter_ref (1+) >> threadDelay 1000000) | |
runserver :: ReaderT (IORef Int) IO () | |
runserver = do | |
let | |
counterPage :: ReaderT (IORef Int) IO Int | |
counterPage = do | |
ask >>= readIORef | |
failPage :: ReaderT (IORef Int) IO Int | |
failPage = do | |
throwIO err500 | |
-- Use unliftio's `toIO` to get these ReaderTs closer to what Servant likes. | |
-- Note: toIO :: MonadUnliftIO m => m a -> m (IO a) | |
counterPage_io :: IO Int <- toIO counterPage | |
failPage_io :: IO Int <- toIO failPage | |
let | |
server_io = counterPage_io :<|> failPage_io | |
-- If we had a monadic hoistServer we could do this... | |
-- | |
-- let | |
-- server_rio :: ServerT CounterAPI (ReaderT (IORef Int) IO) | |
-- server_rio = counterPage :<|> failPage | |
-- server_io <- hoistServerM counterAPI toIO server_rio | |
let | |
-- hoist IO into Handler | |
server = hoistServer counterAPI ioToHandler server_io | |
app :: Application | |
app = serve counterAPI server | |
liftIO $ putStrLn "Starting Server" | |
liftIO $ run 8081 app | |
-- Convert an IO action (possibly carrying Servant exceptions) | |
-- into a Servant `Handler`. | |
ioToHandler :: IO a -> Handler a | |
ioToHandler = Handler . ExceptT . try |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment