{-# 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