87 lines
2.6 KiB
Haskell
87 lines
2.6 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-|
|
|
Module : Control.Monad.App
|
|
Description : Our application monad
|
|
Copyright : (c) Mats Rauhala, 2019
|
|
License : BSD3
|
|
Maintainer : mats.rauhala@iki.fi
|
|
Stability : experimental
|
|
Portability : POSIX
|
|
|
|
Provides the application monad, which is just a newtype over a ReaderT environment.
|
|
|
|
The environment contains the configuration as well as values determind at startup.
|
|
|
|
The environment can be thought of as dependency injection.
|
|
-}
|
|
module Control.Monad.App where
|
|
|
|
import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
|
|
import Control.Monad.Trans (MonadIO)
|
|
import Servant.Client (BaseUrl, ClientEnv)
|
|
import Server (HasPort (..), Port)
|
|
|
|
import Control.Lens
|
|
import Data.Config
|
|
import Data.Language (HasModel (..), Model)
|
|
import Solidabis.API (HasClientEnv (..), HasToken (..), Token)
|
|
|
|
|
|
|
|
-- | Lens for accessing token
|
|
accessToken :: Lens' Config Token
|
|
accessToken = lens _accessToken (\st x -> st{_accessToken=x})
|
|
|
|
-- | Lens for accessing solidabis base url
|
|
solidabisBase :: Lens' Config BaseUrl
|
|
solidabisBase = lens _solidabisBase (\st x -> st{_solidabisBase=x})
|
|
|
|
-- | Lens for accessing the server port
|
|
port :: Lens' Config Port
|
|
port = lens _port (\st x -> st{_port = x})
|
|
|
|
-- | The environment
|
|
data App
|
|
= App { _config :: Config
|
|
, _solidabisClient :: ClientEnv
|
|
, _languageModel :: Model}
|
|
|
|
-- | Lens for accessing the config
|
|
config :: Lens' App Config
|
|
config = lens _config (\st x -> st{_config=x})
|
|
|
|
-- | Lens for accessing the client environment
|
|
solidabisClient :: Lens' App ClientEnv
|
|
solidabisClient = lens _solidabisClient (\st x -> st{_solidabisClient=x})
|
|
|
|
-- | Lens for accessing the language model
|
|
model :: Lens' App Model
|
|
model = lens _languageModel (\st x -> st{_languageModel=x})
|
|
|
|
instance HasToken App where
|
|
getToken = view (config . accessToken)
|
|
setToken app tk = set (config . accessToken) tk app
|
|
|
|
instance HasClientEnv App where
|
|
getClientEnv = view solidabisClient
|
|
setClientEnv app tk = set solidabisClient tk app
|
|
|
|
instance HasPort App where
|
|
getPort = view (config . port)
|
|
setPort app tk = set (config . port) tk app
|
|
|
|
instance HasModel App where
|
|
getModel = view model
|
|
setModel app tk = set model tk app
|
|
|
|
-- | The application monad
|
|
--
|
|
-- This is just a 'ReaderT App IO'
|
|
newtype AppM a = AppM (ReaderT App IO a)
|
|
deriving (Functor, Applicative, Monad, MonadReader App, MonadIO)
|
|
|
|
-- | Run the application monad into IO
|
|
runAppM :: App -> AppM a -> IO a
|
|
runAppM st (AppM f) = runReaderT f st
|