{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE FlexibleInstances          #-}
module Telegram.Bot.Simple.Eff where

import           Control.Monad.Reader
import           Control.Monad.Writer
import           Data.Bifunctor
import           Servant.Client

import qualified Telegram.Bot.API     as Telegram

-- | Bot handler context.
--
-- The context may include an 'Update' the bot is handling at the moment.
newtype BotM a = BotM { BotM a -> ReaderT BotContext ClientM a
_runBotM :: ReaderT BotContext ClientM a }
  deriving (a -> BotM b -> BotM a
(a -> b) -> BotM a -> BotM b
(forall a b. (a -> b) -> BotM a -> BotM b)
-> (forall a b. a -> BotM b -> BotM a) -> Functor BotM
forall a b. a -> BotM b -> BotM a
forall a b. (a -> b) -> BotM a -> BotM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BotM b -> BotM a
$c<$ :: forall a b. a -> BotM b -> BotM a
fmap :: (a -> b) -> BotM a -> BotM b
$cfmap :: forall a b. (a -> b) -> BotM a -> BotM b
Functor, Functor BotM
a -> BotM a
Functor BotM
-> (forall a. a -> BotM a)
-> (forall a b. BotM (a -> b) -> BotM a -> BotM b)
-> (forall a b c. (a -> b -> c) -> BotM a -> BotM b -> BotM c)
-> (forall a b. BotM a -> BotM b -> BotM b)
-> (forall a b. BotM a -> BotM b -> BotM a)
-> Applicative BotM
BotM a -> BotM b -> BotM b
BotM a -> BotM b -> BotM a
BotM (a -> b) -> BotM a -> BotM b
(a -> b -> c) -> BotM a -> BotM b -> BotM c
forall a. a -> BotM a
forall a b. BotM a -> BotM b -> BotM a
forall a b. BotM a -> BotM b -> BotM b
forall a b. BotM (a -> b) -> BotM a -> BotM b
forall a b c. (a -> b -> c) -> BotM a -> BotM b -> BotM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: BotM a -> BotM b -> BotM a
$c<* :: forall a b. BotM a -> BotM b -> BotM a
*> :: BotM a -> BotM b -> BotM b
$c*> :: forall a b. BotM a -> BotM b -> BotM b
liftA2 :: (a -> b -> c) -> BotM a -> BotM b -> BotM c
$cliftA2 :: forall a b c. (a -> b -> c) -> BotM a -> BotM b -> BotM c
<*> :: BotM (a -> b) -> BotM a -> BotM b
$c<*> :: forall a b. BotM (a -> b) -> BotM a -> BotM b
pure :: a -> BotM a
$cpure :: forall a. a -> BotM a
$cp1Applicative :: Functor BotM
Applicative, Applicative BotM
a -> BotM a
Applicative BotM
-> (forall a b. BotM a -> (a -> BotM b) -> BotM b)
-> (forall a b. BotM a -> BotM b -> BotM b)
-> (forall a. a -> BotM a)
-> Monad BotM
BotM a -> (a -> BotM b) -> BotM b
BotM a -> BotM b -> BotM b
forall a. a -> BotM a
forall a b. BotM a -> BotM b -> BotM b
forall a b. BotM a -> (a -> BotM b) -> BotM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> BotM a
$creturn :: forall a. a -> BotM a
>> :: BotM a -> BotM b -> BotM b
$c>> :: forall a b. BotM a -> BotM b -> BotM b
>>= :: BotM a -> (a -> BotM b) -> BotM b
$c>>= :: forall a b. BotM a -> (a -> BotM b) -> BotM b
$cp1Monad :: Applicative BotM
Monad, MonadReader BotContext, Monad BotM
Monad BotM -> (forall a. IO a -> BotM a) -> MonadIO BotM
IO a -> BotM a
forall a. IO a -> BotM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> BotM a
$cliftIO :: forall a. IO a -> BotM a
$cp1MonadIO :: Monad BotM
MonadIO)

data BotContext = BotContext
  { BotContext -> User
botContextUser   :: Telegram.User
  , BotContext -> Maybe Update
botContextUpdate :: Maybe Telegram.Update
  }

liftClientM :: ClientM a -> BotM a
liftClientM :: ClientM a -> BotM a
liftClientM = ReaderT BotContext ClientM a -> BotM a
forall a. ReaderT BotContext ClientM a -> BotM a
BotM (ReaderT BotContext ClientM a -> BotM a)
-> (ClientM a -> ReaderT BotContext ClientM a)
-> ClientM a
-> BotM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientM a -> ReaderT BotContext ClientM a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runBotM :: BotContext -> BotM a -> ClientM a
runBotM :: BotContext -> BotM a -> ClientM a
runBotM BotContext
update = (ReaderT BotContext ClientM a -> BotContext -> ClientM a)
-> BotContext -> ReaderT BotContext ClientM a -> ClientM a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT BotContext ClientM a -> BotContext -> ClientM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT BotContext
update (ReaderT BotContext ClientM a -> ClientM a)
-> (BotM a -> ReaderT BotContext ClientM a) -> BotM a -> ClientM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BotM a -> ReaderT BotContext ClientM a
forall a. BotM a -> ReaderT BotContext ClientM a
_runBotM

newtype Eff action model = Eff { Eff action model -> Writer [BotM (Maybe action)] model
_runEff :: Writer [BotM (Maybe action)] model }
  deriving (a -> Eff action b -> Eff action a
(a -> b) -> Eff action a -> Eff action b
(forall a b. (a -> b) -> Eff action a -> Eff action b)
-> (forall a b. a -> Eff action b -> Eff action a)
-> Functor (Eff action)
forall a b. a -> Eff action b -> Eff action a
forall a b. (a -> b) -> Eff action a -> Eff action b
forall action a b. a -> Eff action b -> Eff action a
forall action a b. (a -> b) -> Eff action a -> Eff action b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Eff action b -> Eff action a
$c<$ :: forall action a b. a -> Eff action b -> Eff action a
fmap :: (a -> b) -> Eff action a -> Eff action b
$cfmap :: forall action a b. (a -> b) -> Eff action a -> Eff action b
Functor, Functor (Eff action)
a -> Eff action a
Functor (Eff action)
-> (forall a. a -> Eff action a)
-> (forall a b.
    Eff action (a -> b) -> Eff action a -> Eff action b)
-> (forall a b c.
    (a -> b -> c) -> Eff action a -> Eff action b -> Eff action c)
-> (forall a b. Eff action a -> Eff action b -> Eff action b)
-> (forall a b. Eff action a -> Eff action b -> Eff action a)
-> Applicative (Eff action)
Eff action a -> Eff action b -> Eff action b
Eff action a -> Eff action b -> Eff action a
Eff action (a -> b) -> Eff action a -> Eff action b
(a -> b -> c) -> Eff action a -> Eff action b -> Eff action c
forall action. Functor (Eff action)
forall a. a -> Eff action a
forall action a. a -> Eff action a
forall a b. Eff action a -> Eff action b -> Eff action a
forall a b. Eff action a -> Eff action b -> Eff action b
forall a b. Eff action (a -> b) -> Eff action a -> Eff action b
forall action a b. Eff action a -> Eff action b -> Eff action a
forall action a b. Eff action a -> Eff action b -> Eff action b
forall action a b.
Eff action (a -> b) -> Eff action a -> Eff action b
forall a b c.
(a -> b -> c) -> Eff action a -> Eff action b -> Eff action c
forall action a b c.
(a -> b -> c) -> Eff action a -> Eff action b -> Eff action c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Eff action a -> Eff action b -> Eff action a
$c<* :: forall action a b. Eff action a -> Eff action b -> Eff action a
*> :: Eff action a -> Eff action b -> Eff action b
$c*> :: forall action a b. Eff action a -> Eff action b -> Eff action b
liftA2 :: (a -> b -> c) -> Eff action a -> Eff action b -> Eff action c
$cliftA2 :: forall action a b c.
(a -> b -> c) -> Eff action a -> Eff action b -> Eff action c
<*> :: Eff action (a -> b) -> Eff action a -> Eff action b
$c<*> :: forall action a b.
Eff action (a -> b) -> Eff action a -> Eff action b
pure :: a -> Eff action a
$cpure :: forall action a. a -> Eff action a
$cp1Applicative :: forall action. Functor (Eff action)
Applicative, Applicative (Eff action)
a -> Eff action a
Applicative (Eff action)
-> (forall a b.
    Eff action a -> (a -> Eff action b) -> Eff action b)
-> (forall a b. Eff action a -> Eff action b -> Eff action b)
-> (forall a. a -> Eff action a)
-> Monad (Eff action)
Eff action a -> (a -> Eff action b) -> Eff action b
Eff action a -> Eff action b -> Eff action b
forall action. Applicative (Eff action)
forall a. a -> Eff action a
forall action a. a -> Eff action a
forall a b. Eff action a -> Eff action b -> Eff action b
forall a b. Eff action a -> (a -> Eff action b) -> Eff action b
forall action a b. Eff action a -> Eff action b -> Eff action b
forall action a b.
Eff action a -> (a -> Eff action b) -> Eff action b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Eff action a
$creturn :: forall action a. a -> Eff action a
>> :: Eff action a -> Eff action b -> Eff action b
$c>> :: forall action a b. Eff action a -> Eff action b -> Eff action b
>>= :: Eff action a -> (a -> Eff action b) -> Eff action b
$c>>= :: forall action a b.
Eff action a -> (a -> Eff action b) -> Eff action b
$cp1Monad :: forall action. Applicative (Eff action)
Monad)

-- | The idea behind following type class is
--   to allow you defining the type 'ret' you want to return from 'BotM' action.
--   You can create your own return-types via new instances.
--   Here 'action' is a 'botAction'
--   type, that will be used further in 'botHandler' function.
--   If you don't want to return action use 'Nothing' instead.
--
--   See "Telegram.Bot.Simple.Instances" for more commonly useful instances.
--   - @GetAction a a@ - for simple making finite automata of
--   BotM actions. (For example you can log every update
--   and then return new 'action' to answer at message/send sticker/etc)
--   - @GetAction () a@ - to use @pure ()@ instead of dealing with @Nothing@.
--   - @GetAction Text a@ - to add some sugar over the 'replyText' function.
--   'OverloadedStrings' breaks type inference,
--   so we advise to use @replyText \"message\"@
--   instead of @pure \@_ \@Text \"message\"@.
class GetAction return action where
  getNextAction :: BotM return -> BotM (Maybe action)

instance Bifunctor Eff where
  bimap :: (a -> b) -> (c -> d) -> Eff a c -> Eff b d
bimap a -> b
f c -> d
g = Writer [BotM (Maybe b)] d -> Eff b d
forall action model.
Writer [BotM (Maybe action)] model -> Eff action model
Eff (Writer [BotM (Maybe b)] d -> Eff b d)
-> (Eff a c -> Writer [BotM (Maybe b)] d) -> Eff a c -> Eff b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c, [BotM (Maybe a)]) -> (d, [BotM (Maybe b)]))
-> Writer [BotM (Maybe a)] c -> Writer [BotM (Maybe b)] d
forall a w b w'. ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
mapWriter ((c -> d)
-> ([BotM (Maybe a)] -> [BotM (Maybe b)])
-> (c, [BotM (Maybe a)])
-> (d, [BotM (Maybe b)])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap c -> d
g ((BotM (Maybe a) -> BotM (Maybe b))
-> [BotM (Maybe a)] -> [BotM (Maybe b)]
forall a b. (a -> b) -> [a] -> [b]
map ((BotM (Maybe a) -> BotM (Maybe b))
 -> [BotM (Maybe a)] -> [BotM (Maybe b)])
-> ((a -> b) -> BotM (Maybe a) -> BotM (Maybe b))
-> (a -> b)
-> [BotM (Maybe a)]
-> [BotM (Maybe b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Maybe b) -> BotM (Maybe a) -> BotM (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe a -> Maybe b) -> BotM (Maybe a) -> BotM (Maybe b))
-> ((a -> b) -> Maybe a -> Maybe b)
-> (a -> b)
-> BotM (Maybe a)
-> BotM (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> [BotM (Maybe a)] -> [BotM (Maybe b)])
-> (a -> b) -> [BotM (Maybe a)] -> [BotM (Maybe b)]
forall a b. (a -> b) -> a -> b
$ a -> b
f)) (Writer [BotM (Maybe a)] c -> Writer [BotM (Maybe b)] d)
-> (Eff a c -> Writer [BotM (Maybe a)] c)
-> Eff a c
-> Writer [BotM (Maybe b)] d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff a c -> Writer [BotM (Maybe a)] c
forall action model.
Eff action model -> Writer [BotM (Maybe action)] model
_runEff

runEff :: Eff action model -> (model, [BotM (Maybe action)])
runEff :: Eff action model -> (model, [BotM (Maybe action)])
runEff = Writer [BotM (Maybe action)] model
-> (model, [BotM (Maybe action)])
forall w a. Writer w a -> (a, w)
runWriter (Writer [BotM (Maybe action)] model
 -> (model, [BotM (Maybe action)]))
-> (Eff action model -> Writer [BotM (Maybe action)] model)
-> Eff action model
-> (model, [BotM (Maybe action)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff action model -> Writer [BotM (Maybe action)] model
forall action model.
Eff action model -> Writer [BotM (Maybe action)] model
_runEff

eff :: GetAction a b => BotM a -> Eff b ()
eff :: BotM a -> Eff b ()
eff BotM a
e = Writer [BotM (Maybe b)] () -> Eff b ()
forall action model.
Writer [BotM (Maybe action)] model -> Eff action model
Eff ([BotM (Maybe b)] -> Writer [BotM (Maybe b)] ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [BotM a -> BotM (Maybe b)
forall return action.
GetAction return action =>
BotM return -> BotM (Maybe action)
getNextAction BotM a
e])

withEffect :: GetAction a action => BotM a -> model -> Eff action model
withEffect :: BotM a -> model -> Eff action model
withEffect BotM a
effect model
model = BotM a -> Eff action ()
forall a b. GetAction a b => BotM a -> Eff b ()
eff BotM a
effect Eff action () -> Eff action model -> Eff action model
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> model -> Eff action model
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
model

(<#) :: GetAction a action => model -> BotM a -> Eff action model
<# :: model -> BotM a -> Eff action model
(<#) = (BotM a -> model -> Eff action model)
-> model -> BotM a -> Eff action model
forall a b c. (a -> b -> c) -> b -> a -> c
flip BotM a -> model -> Eff action model
forall a action model.
GetAction a action =>
BotM a -> model -> Eff action model
withEffect

-- | Set a specific 'Telegram.Update' in a 'BotM' context.
setBotMUpdate :: Maybe Telegram.Update -> BotM a -> BotM a
setBotMUpdate :: Maybe Update -> BotM a -> BotM a
setBotMUpdate Maybe Update
update (BotM ReaderT BotContext ClientM a
m) =  ReaderT BotContext ClientM a -> BotM a
forall a. ReaderT BotContext ClientM a -> BotM a
BotM ((BotContext -> BotContext)
-> ReaderT BotContext ClientM a -> ReaderT BotContext ClientM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local BotContext -> BotContext
f ReaderT BotContext ClientM a
m)
  where
    f :: BotContext -> BotContext
f BotContext
botContext = BotContext
botContext { botContextUpdate :: Maybe Update
botContextUpdate = Maybe Update
update }

-- | Set a specific 'Telegram.Update' in every effect of 'Eff' context.
setEffUpdate :: Maybe Telegram.Update -> Eff action model -> Eff action model
setEffUpdate :: Maybe Update -> Eff action model -> Eff action model
setEffUpdate Maybe Update
update (Eff Writer [BotM (Maybe action)] model
m) = Writer [BotM (Maybe action)] model -> Eff action model
forall action model.
Writer [BotM (Maybe action)] model -> Eff action model
Eff (([BotM (Maybe action)] -> [BotM (Maybe action)])
-> Writer [BotM (Maybe action)] model
-> Writer [BotM (Maybe action)] model
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((BotM (Maybe action) -> BotM (Maybe action))
-> [BotM (Maybe action)] -> [BotM (Maybe action)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Update -> BotM (Maybe action) -> BotM (Maybe action)
forall a. Maybe Update -> BotM a -> BotM a
setBotMUpdate Maybe Update
update)) Writer [BotM (Maybe action)] model
m)