33 lines
1.2 KiB
Haskell
33 lines
1.2 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
module AppM where
|
|
|
|
import Bot.DSL
|
|
import Control.Monad.Catch (MonadCatch, MonadThrow)
|
|
import Control.Monad.Logger
|
|
import Control.Monad.Trans (MonadIO, liftIO)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.IO as T
|
|
import qualified Data.Time as Time
|
|
|
|
newtype AppM a = AppM (LoggingT IO a)
|
|
deriving (Functor, Applicative, Monad, MonadCatch, MonadThrow, MonadLogger, MonadIO)
|
|
|
|
-- The tagless final interpreter.
|
|
instance MonadNetwork AppM where
|
|
type Meta AppM = ()
|
|
recvMsg = Request <$> liftIO T.getLine <*> pure ()
|
|
putMsg Response{..} = liftIO . T.putStrLn $ content
|
|
|
|
instance MonadData AppM where
|
|
putData key val = liftIO $ T.putStrLn $ "Would put " <> T.pack key <> " = " <> T.pack (show val)
|
|
getData key = liftIO (T.putStrLn $ "Would fetch " <> T.pack key) >> return Nothing
|
|
|
|
instance MonadTime AppM where
|
|
getCurrentTime = liftIO Time.getCurrentTime
|
|
|
|
runAppM :: AppM a -> IO a
|
|
runAppM (AppM f) = runStdoutLoggingT f
|