61 lines
1.8 KiB
Haskell
61 lines
1.8 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
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)
|
|
|
|
|
|
|
|
accessToken :: Lens' Config Token
|
|
accessToken = lens _accessToken (\st x -> st{_accessToken=x})
|
|
|
|
solidabisBase :: Lens' Config BaseUrl
|
|
solidabisBase = lens _solidabisBase (\st x -> st{_solidabisBase=x})
|
|
|
|
port :: Lens' Config Port
|
|
port = lens _port (\st x -> st{_port = x})
|
|
|
|
data App
|
|
= App { _config :: Config
|
|
, _solidabisClient :: ClientEnv
|
|
, _languageModel :: Model}
|
|
|
|
config :: Lens' App Config
|
|
config = lens _config (\st x -> st{_config=x})
|
|
|
|
solidabisClient :: Lens' App ClientEnv
|
|
solidabisClient = lens _solidabisClient (\st x -> st{_solidabisClient=x})
|
|
|
|
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
|
|
|
|
newtype AppM a = AppM (ReaderT App IO a)
|
|
deriving (Functor, Applicative, Monad, MonadReader App, MonadIO)
|
|
|
|
runAppM :: App -> AppM a -> IO a
|
|
runAppM st (AppM f) = runReaderT f st
|