{-# 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 { forall a. BotM a -> ReaderT BotContext ClientM a
_runBotM :: ReaderT BotContext ClientM a }
  deriving ((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
$cfmap :: forall a b. (a -> b) -> BotM a -> BotM b
fmap :: forall a b. (a -> b) -> BotM a -> BotM b
$c<$ :: forall a b. a -> BotM b -> BotM a
<$ :: forall a b. a -> BotM b -> BotM a
Functor, Functor BotM
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
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
$cpure :: forall a. a -> BotM a
pure :: forall a. a -> BotM a
$c<*> :: forall a b. BotM (a -> b) -> BotM a -> BotM b
<*> :: forall a b. BotM (a -> b) -> BotM a -> BotM b
$cliftA2 :: forall a b c. (a -> b -> c) -> BotM a -> BotM b -> BotM c
liftA2 :: forall a b c. (a -> b -> c) -> BotM a -> BotM b -> BotM c
$c*> :: forall a b. BotM a -> BotM b -> BotM b
*> :: forall a b. BotM a -> BotM b -> BotM b
$c<* :: forall a b. BotM a -> BotM b -> BotM a
<* :: forall a b. BotM a -> BotM b -> BotM a
Applicative, Applicative BotM
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
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
$c>>= :: forall a b. BotM a -> (a -> BotM b) -> BotM b
>>= :: forall a b. BotM a -> (a -> BotM b) -> BotM b
$c>> :: forall a b. BotM a -> BotM b -> BotM b
>> :: forall a b. BotM a -> BotM b -> BotM b
$creturn :: forall a. a -> BotM a
return :: forall a. a -> BotM a
Monad, MonadReader BotContext, Monad BotM
Monad BotM => (forall a. IO a -> BotM a) -> MonadIO BotM
forall a. IO a -> BotM a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> BotM a
liftIO :: forall a. IO a -> BotM a
MonadIO)

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

liftClientM :: ClientM a -> BotM a
liftClientM :: forall a. 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 (m :: * -> *) a. Monad m => m a -> ReaderT BotContext m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runBotM :: BotContext -> BotM a -> ClientM a
runBotM :: forall a. 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 { forall action model.
Eff action model -> Writer [BotM (Maybe action)] model
_runEff :: Writer [BotM (Maybe action)] model }
  deriving ((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
$cfmap :: forall action a b. (a -> b) -> Eff action a -> Eff action b
fmap :: forall a b. (a -> b) -> Eff action a -> Eff action b
$c<$ :: forall action a b. a -> Eff action b -> Eff action a
<$ :: forall a b. a -> Eff action b -> Eff action a
Functor, Functor (Eff action)
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)
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
$cpure :: forall action a. a -> Eff action a
pure :: forall a. a -> Eff action a
$c<*> :: forall action a b.
Eff action (a -> b) -> Eff action a -> Eff action b
<*> :: forall a b. Eff action (a -> b) -> Eff action a -> Eff action b
$cliftA2 :: forall action a b c.
(a -> b -> c) -> Eff action a -> Eff action b -> Eff action c
liftA2 :: forall a b c.
(a -> b -> c) -> Eff action a -> Eff action b -> Eff action c
$c*> :: forall action a b. Eff action a -> Eff action b -> Eff action b
*> :: forall a b. Eff action a -> Eff action b -> Eff action b
$c<* :: forall action a b. Eff action a -> Eff action b -> Eff action a
<* :: forall a b. Eff action a -> Eff action b -> Eff action a
Applicative, Applicative (Eff action)
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)
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
$c>>= :: forall action a b.
Eff action a -> (a -> Eff action b) -> Eff action b
>>= :: forall a b. Eff action a -> (a -> Eff action b) -> Eff action b
$c>> :: forall action a b. Eff action a -> Eff action b -> Eff action b
>> :: forall a b. Eff action a -> Eff action b -> Eff action b
$creturn :: forall action a. a -> Eff action a
return :: forall a. a -> Eff action a
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 :: forall a b c d. (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 a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
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 a b. (a -> b) -> BotM a -> BotM 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 a b. (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 :: forall action model.
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 :: forall a b. GetAction a b => 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 :: forall a action model.
GetAction a action =>
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 a b. Eff action a -> Eff action b -> Eff action b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> model -> Eff action model
forall a. a -> Eff action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
model

(<#) :: GetAction a action => model -> BotM a -> Eff action model
<# :: forall a action model.
GetAction a action =>
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 :: forall a. 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 a.
(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 = update }

-- | Set a specific 'Telegram.Update' in every effect of 'Eff' context.
setEffUpdate :: Maybe Telegram.Update -> Eff action model -> Eff action model
setEffUpdate :: forall action model.
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)