{-# LANGUAGE TemplateHaskell #-}

module Calamity.Interactions.View (
  ViewEff (..),
  endView,
  replaceView,
  getSendResponse,
  View,
  row,
  runView,
  runViewInstance,
  button,
  button',
  select,
  select',
  textInput,
  textInput',
  deleteInitialMsg,
  instantiateView,
) where

import Calamity.Client.Client (react)
import Calamity.Client.Types (BotC, EventType (InteractionEvt))
import Calamity.HTTP.Channel (ChannelRequest (DeleteMessage))
import Calamity.HTTP.Internal.Ratelimit (RatelimitEff)
import Calamity.HTTP.Internal.Request (invoke)
import Calamity.Interactions.Eff (InteractionEff (..))
import Calamity.Internal.AesonThings
import Calamity.Metrics.Eff (MetricEff)
import Calamity.Types.LogEff (LogEff)
import Calamity.Types.Model.Channel.Component (CustomID)
import qualified Calamity.Types.Model.Channel.Component as C
import Calamity.Types.Model.Channel.Message (Message)
import Calamity.Types.Model.Interaction
import Calamity.Types.TokenEff (TokenEff)
import qualified Control.Concurrent.STM as STM
import Control.Lens ((.~), (?~), (^.), (^..), _1, _2, _3, _Just)
import Control.Monad (guard, void)
import qualified Data.Aeson
import Data.Aeson.Lens (AsValue (_Array), key)
import qualified Data.List
import qualified Data.Set as S
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified GHC.TypeLits as E
import qualified Polysemy as P
import qualified Polysemy.Resource as P
import qualified Polysemy.State as P
import System.Random

data ViewComponent a = ViewComponent
  { ViewComponent a -> Component
component :: C.Component
  , ViewComponent a -> Interaction -> ExtractResult a
parse :: Interaction -> ExtractResult a
  }

instance Functor ViewComponent where
  fmap :: (a -> b) -> ViewComponent a -> ViewComponent b
fmap a -> b
f ViewComponent {Component
component :: Component
$sel:component:ViewComponent :: forall a. ViewComponent a -> Component
component, Interaction -> ExtractResult a
parse :: Interaction -> ExtractResult a
$sel:parse:ViewComponent :: forall a. ViewComponent a -> Interaction -> ExtractResult a
parse} = ViewComponent :: forall a.
Component -> (Interaction -> ExtractResult a) -> ViewComponent a
ViewComponent {Component
component :: Component
$sel:component:ViewComponent :: Component
component, $sel:parse:ViewComponent :: Interaction -> ExtractResult b
parse = (a -> b) -> ExtractResult a -> ExtractResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ExtractResult a -> ExtractResult b)
-> (Interaction -> ExtractResult a)
-> Interaction
-> ExtractResult b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interaction -> ExtractResult a
parse}

{- | A view containing one or more components

 This has an applicative interface to allow for easy composition of
 components.
-}
data View a
  = NilView a
  | SingView (forall g. RandomGen g => g -> (ViewComponent a, g))
  | RowView (View a)
  | forall x. MultView (View (x -> a)) (View x)

{- | Convert a 'View' such that it renders as a row.

 Note: nested rows are not allowed by discord, along with further restrictions
 listed here:
 https://discord.com/developers/docs/interactions/message-components
-}
row :: View a -> View a
row :: View a -> View a
row = View a -> View a
forall a. View a -> View a
RowView

instance Functor View where
  fmap :: (a -> b) -> View a -> View b
fmap a -> b
f (NilView a
x) = b -> View b
forall a. a -> View a
NilView (a -> b
f a
x)
  fmap a -> b
f (SingView forall g. RandomGen g => g -> (ViewComponent a, g)
x) = (forall g. RandomGen g => g -> (ViewComponent b, g)) -> View b
forall a.
(forall g. RandomGen g => g -> (ViewComponent a, g)) -> View a
SingView (\g
r -> let (ViewComponent a
x', g
r') = g -> (ViewComponent a, g)
forall g. RandomGen g => g -> (ViewComponent a, g)
x g
r in (a -> b
f (a -> b) -> ViewComponent a -> ViewComponent b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ViewComponent a
x', g
r'))
  fmap a -> b
f (RowView View a
x) = View b -> View b
forall a. View a -> View a
RowView ((a -> b) -> View a -> View b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f View a
x)
  fmap a -> b
f (MultView View (x -> a)
x View x
y) = View (x -> b) -> View x -> View b
forall a x. View (x -> a) -> View x -> View a
MultView (((x -> a) -> x -> b) -> View (x -> a) -> View (x -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f (a -> b) -> (x -> a) -> x -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) View (x -> a)
x) View x
y

instance Applicative View where
  pure :: a -> View a
pure = a -> View a
forall a. a -> View a
NilView
  <*> :: View (a -> b) -> View a -> View b
(<*>) = View (a -> b) -> View a -> View b
forall a x. View (x -> a) -> View x -> View a
MultView

type MonadViewMessage =
  'E.ShowType View
    'E.:<>: 'E.Text " doesn't have a Monad instance as we need to be able to inspect the contained components"
    'E.:$$: 'E.Text "If you haven't already, enable ApplicativeDo"
    'E.:$$: 'E.Text "Also, make sure you use lazy patterns: ~(a, b) instead of (a, b)"
    'E.:$$: 'E.Text "Refer to https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/applicative_do.html"

instance E.TypeError MonadViewMessage => Monad View where
  >>= :: View a -> (a -> View b) -> View b
(>>=) = View a -> (a -> View b) -> View b
forall a. HasCallStack => a
undefined -- unreachable

data ExtractOkType
  = -- | At least one value has been extracted
    SomeExtracted
  | -- | No values have been extracted, we shouldn't trigger the callback
    NoneExtracted
  deriving (Int -> ExtractOkType -> ShowS
[ExtractOkType] -> ShowS
ExtractOkType -> String
(Int -> ExtractOkType -> ShowS)
-> (ExtractOkType -> String)
-> ([ExtractOkType] -> ShowS)
-> Show ExtractOkType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtractOkType] -> ShowS
$cshowList :: [ExtractOkType] -> ShowS
show :: ExtractOkType -> String
$cshow :: ExtractOkType -> String
showsPrec :: Int -> ExtractOkType -> ShowS
$cshowsPrec :: Int -> ExtractOkType -> ShowS
Show)

instance Semigroup ExtractOkType where
  ExtractOkType
SomeExtracted <> :: ExtractOkType -> ExtractOkType -> ExtractOkType
<> ExtractOkType
_ = ExtractOkType
SomeExtracted
  ExtractOkType
_ <> ExtractOkType
SomeExtracted = ExtractOkType
SomeExtracted
  ExtractOkType
_ <> ExtractOkType
_ = ExtractOkType
NoneExtracted

data ExtractResult a
  = -- | Extraction succeeded in some way
    ExtractOk ExtractOkType a
  | -- | Bail out from parsing this interaction for the current view
    ExtractFail
  deriving (Int -> ExtractResult a -> ShowS
[ExtractResult a] -> ShowS
ExtractResult a -> String
(Int -> ExtractResult a -> ShowS)
-> (ExtractResult a -> String)
-> ([ExtractResult a] -> ShowS)
-> Show (ExtractResult a)
forall a. Show a => Int -> ExtractResult a -> ShowS
forall a. Show a => [ExtractResult a] -> ShowS
forall a. Show a => ExtractResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtractResult a] -> ShowS
$cshowList :: forall a. Show a => [ExtractResult a] -> ShowS
show :: ExtractResult a -> String
$cshow :: forall a. Show a => ExtractResult a -> String
showsPrec :: Int -> ExtractResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ExtractResult a -> ShowS
Show, a -> ExtractResult b -> ExtractResult a
(a -> b) -> ExtractResult a -> ExtractResult b
(forall a b. (a -> b) -> ExtractResult a -> ExtractResult b)
-> (forall a b. a -> ExtractResult b -> ExtractResult a)
-> Functor ExtractResult
forall a b. a -> ExtractResult b -> ExtractResult a
forall a b. (a -> b) -> ExtractResult a -> ExtractResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ExtractResult b -> ExtractResult a
$c<$ :: forall a b. a -> ExtractResult b -> ExtractResult a
fmap :: (a -> b) -> ExtractResult a -> ExtractResult b
$cfmap :: forall a b. (a -> b) -> ExtractResult a -> ExtractResult b
Functor)

instance Applicative ExtractResult where
  pure :: a -> ExtractResult a
pure = ExtractOkType -> a -> ExtractResult a
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted

  ExtractOk ExtractOkType
ta a -> b
f <*> :: ExtractResult (a -> b) -> ExtractResult a -> ExtractResult b
<*> ExtractOk ExtractOkType
tb a
x = ExtractOkType -> b -> ExtractResult b
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk (ExtractOkType
ta ExtractOkType -> ExtractOkType -> ExtractOkType
forall a. Semigroup a => a -> a -> a
<> ExtractOkType
tb) (b -> ExtractResult b) -> b -> ExtractResult b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
x
  ExtractResult (a -> b)
_ <*> ExtractResult a
_ = ExtractResult b
forall a. ExtractResult a
ExtractFail

data ViewInstance a = ViewInstance
  { -- customIDS :: Set C.CustomID ,
    ViewInstance a -> Interaction -> ExtractResult a
extract :: Interaction -> ExtractResult a
  , ViewInstance a -> [Component]
rendered :: [C.Component]
  }

data ViewEff ret inp sendResp m a where
  -- | Mark the view as finished and set the return value.
  --
  -- This doesn't trigger the immediate exit from the code it is used in, the
  -- view will exit before it would wait for the next event.
  EndView :: ret -> ViewEff ret inp sendResp m ()
  -- | Given a view and a way to display the rendered view to discord, show the
  -- view and start tracking the new view
  --
  -- This works for both message components and modals
  ReplaceView :: View inp -> ([C.Component] -> m ()) -> ViewEff ret inp sendResp m ()
  -- | Get the result of the action that sent a value
  GetSendResponse :: ViewEff ret inp sendResp m sendResp

P.makeSem ''ViewEff

extractCustomID :: Interaction -> Maybe CustomID
extractCustomID :: Interaction -> Maybe CustomID
extractCustomID Interaction {Maybe InteractionData
$sel:data_:Interaction :: Interaction -> Maybe InteractionData
data_ :: Maybe InteractionData
data_, InteractionType
$sel:type_:Interaction :: Interaction -> InteractionType
type_ :: InteractionType
type_} = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ InteractionType
type_ InteractionType -> InteractionType -> Bool
forall a. Eq a => a -> a -> Bool
== InteractionType
MessageComponentType
  InteractionData
data' <- Maybe InteractionData
data_
  InteractionData
data' InteractionData
-> Getting (Maybe CustomID) InteractionData (Maybe CustomID)
-> Maybe CustomID
forall s a. s -> Getting a s a -> a
^. IsLabel
  "customID"
  (Getting (Maybe CustomID) InteractionData (Maybe CustomID))
Getting (Maybe CustomID) InteractionData (Maybe CustomID)
#customID

guardComponentType :: Interaction -> C.ComponentType -> Maybe ()
guardComponentType :: Interaction -> ComponentType -> Maybe ()
guardComponentType Interaction {Maybe InteractionData
data_ :: Maybe InteractionData
$sel:data_:Interaction :: Interaction -> Maybe InteractionData
data_} ComponentType
expected = do
  InteractionData
data' <- Maybe InteractionData
data_
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ InteractionData
data' InteractionData
-> Getting
     (Maybe ComponentType) InteractionData (Maybe ComponentType)
-> Maybe ComponentType
forall s a. s -> Getting a s a -> a
^. IsLabel
  "componentType"
  (Getting
     (Maybe ComponentType) InteractionData (Maybe ComponentType))
Getting (Maybe ComponentType) InteractionData (Maybe ComponentType)
#componentType Maybe ComponentType -> Maybe ComponentType -> Bool
forall a. Eq a => a -> a -> Bool
== ComponentType -> Maybe ComponentType
forall a. a -> Maybe a
Just ComponentType
expected

extractOkFromMaybe :: Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe :: Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe (Just a
a) = ExtractOkType -> Maybe a -> ExtractResult (Maybe a)
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
extractOkFromMaybe Maybe a
Nothing = ExtractOkType -> Maybe a -> ExtractResult (Maybe a)
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
NoneExtracted Maybe a
forall a. Maybe a
Nothing

extractOkFromBool :: Bool -> ExtractResult Bool
extractOkFromBool :: Bool -> ExtractResult Bool
extractOkFromBool Bool
True = ExtractOkType -> Bool -> ExtractResult Bool
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted Bool
True
extractOkFromBool Bool
False = ExtractOkType -> Bool -> ExtractResult Bool
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
NoneExtracted Bool
False

{- | Construct a 'View' containing a 'C.Button' with the given style and label

 Other fields of 'C.Button' default to 'Nothing'
-}
button :: C.ButtonStyle -> Text -> View Bool
button :: ButtonStyle -> Text -> View Bool
button ButtonStyle
s Text
l = (Button -> Button) -> View Bool
button' ((IsLabel "style" (ASetter Button Button ButtonStyle ButtonStyle)
ASetter Button Button ButtonStyle ButtonStyle
#style ASetter Button Button ButtonStyle ButtonStyle
-> ButtonStyle -> Button -> Button
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ButtonStyle
s) (Button -> Button) -> (Button -> Button) -> Button -> Button
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel "label" (ASetter Button Button (Maybe Text) (Maybe Text))
ASetter Button Button (Maybe Text) (Maybe Text)
#label ASetter Button Button (Maybe Text) (Maybe Text)
-> Text -> Button -> Button
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Text
l))

{- | Construct a 'View' containing a 'C.Button', then modify the component with
   the passed mapping function

 The 'C.Button' passed to the mapping function will have a style of
 'C.ButtonPrimary', other fields will be 'Nothing'
-}
button' :: (C.Button -> C.Button) -> View Bool
button' :: (Button -> Button) -> View Bool
button' Button -> Button
f = (forall g. RandomGen g => g -> (ViewComponent Bool, g))
-> View Bool
forall a.
(forall g. RandomGen g => g -> (ViewComponent a, g)) -> View a
SingView ((forall g. RandomGen g => g -> (ViewComponent Bool, g))
 -> View Bool)
-> (forall g. RandomGen g => g -> (ViewComponent Bool, g))
-> View Bool
forall a b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall g a. (RandomGen g, Uniform a) => g -> (a, g)
uniform g
g
      comp :: Component
comp = Button -> Component
C.Button' (Button -> Component) -> (Button -> Button) -> Button -> Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Button -> Button
f (Button -> Component) -> Button -> Component
forall a b. (a -> b) -> a -> b
$ ButtonStyle -> CustomID -> Button
C.button ButtonStyle
C.ButtonPrimary CustomID
cid
      parse' :: Interaction -> Bool
parse' Interaction
int =
        Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
          Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ( do
                CustomID
customID <- Interaction -> Maybe CustomID
extractCustomID Interaction
int
                Interaction -> ComponentType -> Maybe ()
guardComponentType Interaction
int ComponentType
C.ButtonType
                Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ CustomID
customID CustomID -> CustomID -> Bool
forall a. Eq a => a -> a -> Bool
== CustomID
cid
             )
      parse :: Interaction -> ExtractResult Bool
parse = Bool -> ExtractResult Bool
extractOkFromBool (Bool -> ExtractResult Bool)
-> (Interaction -> Bool) -> Interaction -> ExtractResult Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interaction -> Bool
parse'
   in (Component
-> (Interaction -> ExtractResult Bool) -> ViewComponent Bool
forall a.
Component -> (Interaction -> ExtractResult a) -> ViewComponent a
ViewComponent Component
comp Interaction -> ExtractResult Bool
parse, g
g')

{- | Construct a 'View' containing a 'C.Select' with the given list of values

 Each element of the passed options list is used as both the display
 'C.SelectOption.label' and 'C.SelectOption.value', use 'select'' if you
 desire more control
-}
select :: [Text] -> View (Maybe Text)
select :: [Text] -> View (Maybe Text)
select [Text]
opts = Maybe [Text] -> Maybe Text
ensureOne (Maybe [Text] -> Maybe Text)
-> View (Maybe [Text]) -> View (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SelectOption] -> (Select -> Select) -> View (Maybe [Text])
select' ((Text -> SelectOption) -> [Text] -> [SelectOption]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Text -> Text -> SelectOption
C.sopt Text
x Text
x) [Text]
opts) Select -> Select
forall a. a -> a
Prelude.id
  where
    ensureOne :: Maybe [Text] -> Maybe Text
    ensureOne :: Maybe [Text] -> Maybe Text
ensureOne Maybe [Text]
mx = do
      [Text]
o <- Maybe [Text]
mx
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
o Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      case [Text]
o of
        [Text
x] -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
        [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing

{- | Construct a 'View' containing a 'C.Select' with the given options, then
 modify the component with the passed mapping function
-}
select' :: [C.SelectOption] -> (C.Select -> C.Select) -> View (Maybe [Text])
select' :: [SelectOption] -> (Select -> Select) -> View (Maybe [Text])
select' [SelectOption]
opts Select -> Select
f = (forall g. RandomGen g => g -> (ViewComponent (Maybe [Text]), g))
-> View (Maybe [Text])
forall a.
(forall g. RandomGen g => g -> (ViewComponent a, g)) -> View a
SingView ((forall g. RandomGen g => g -> (ViewComponent (Maybe [Text]), g))
 -> View (Maybe [Text]))
-> (forall g.
    RandomGen g =>
    g -> (ViewComponent (Maybe [Text]), g))
-> View (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall g a. (RandomGen g, Uniform a) => g -> (a, g)
uniform g
g
      comp :: Select
comp = Select -> Select
f (Select -> Select) -> Select -> Select
forall a b. (a -> b) -> a -> b
$ [SelectOption] -> CustomID -> Select
C.select [SelectOption]
opts CustomID
cid
      finalValues :: Set Text
finalValues = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ Select
comp Select -> Getting (Endo [Text]) Select Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. IsLabel
  "options"
  (([SelectOption] -> Const (Endo [Text]) [SelectOption])
   -> Select -> Const (Endo [Text]) Select)
([SelectOption] -> Const (Endo [Text]) [SelectOption])
-> Select -> Const (Endo [Text]) Select
#options (([SelectOption] -> Const (Endo [Text]) [SelectOption])
 -> Select -> Const (Endo [Text]) Select)
-> ((Text -> Const (Endo [Text]) Text)
    -> [SelectOption] -> Const (Endo [Text]) [SelectOption])
-> Getting (Endo [Text]) Select Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SelectOption -> Const (Endo [Text]) SelectOption)
-> [SelectOption] -> Const (Endo [Text]) [SelectOption]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((SelectOption -> Const (Endo [Text]) SelectOption)
 -> [SelectOption] -> Const (Endo [Text]) [SelectOption])
-> ((Text -> Const (Endo [Text]) Text)
    -> SelectOption -> Const (Endo [Text]) SelectOption)
-> (Text -> Const (Endo [Text]) Text)
-> [SelectOption]
-> Const (Endo [Text]) [SelectOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "value"
  ((Text -> Const (Endo [Text]) Text)
   -> SelectOption -> Const (Endo [Text]) SelectOption)
(Text -> Const (Endo [Text]) Text)
-> SelectOption -> Const (Endo [Text]) SelectOption
#value
      parse :: Interaction -> ExtractResult (Maybe [Text])
parse Interaction
int = Maybe [Text] -> ExtractResult (Maybe [Text])
forall a. Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe (Maybe [Text] -> ExtractResult (Maybe [Text]))
-> Maybe [Text] -> ExtractResult (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ do
        CustomID
customID <- Interaction -> Maybe CustomID
extractCustomID Interaction
int
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ CustomID
customID CustomID -> CustomID -> Bool
forall a. Eq a => a -> a -> Bool
== CustomID
cid
        Interaction -> ComponentType -> Maybe ()
guardComponentType Interaction
int ComponentType
C.SelectType
        [Text]
values <- Interaction
int Interaction
-> Getting (Maybe [Text]) Interaction (Maybe [Text])
-> Maybe [Text]
forall s a. s -> Getting a s a -> a
^. IsLabel
  "data_"
  ((Maybe InteractionData
    -> Const (Maybe [Text]) (Maybe InteractionData))
   -> Interaction -> Const (Maybe [Text]) Interaction)
(Maybe InteractionData
 -> Const (Maybe [Text]) (Maybe InteractionData))
-> Interaction -> Const (Maybe [Text]) Interaction
#data_ ((Maybe InteractionData
  -> Const (Maybe [Text]) (Maybe InteractionData))
 -> Interaction -> Const (Maybe [Text]) Interaction)
-> ((Maybe [Text] -> Const (Maybe [Text]) (Maybe [Text]))
    -> Maybe InteractionData
    -> Const (Maybe [Text]) (Maybe InteractionData))
-> Getting (Maybe [Text]) Interaction (Maybe [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InteractionData -> Const (Maybe [Text]) InteractionData)
-> Maybe InteractionData
-> Const (Maybe [Text]) (Maybe InteractionData)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((InteractionData -> Const (Maybe [Text]) InteractionData)
 -> Maybe InteractionData
 -> Const (Maybe [Text]) (Maybe InteractionData))
-> ((Maybe [Text] -> Const (Maybe [Text]) (Maybe [Text]))
    -> InteractionData -> Const (Maybe [Text]) InteractionData)
-> (Maybe [Text] -> Const (Maybe [Text]) (Maybe [Text]))
-> Maybe InteractionData
-> Const (Maybe [Text]) (Maybe InteractionData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "values"
  ((Maybe [Text] -> Const (Maybe [Text]) (Maybe [Text]))
   -> InteractionData -> Const (Maybe [Text]) InteractionData)
(Maybe [Text] -> Const (Maybe [Text]) (Maybe [Text]))
-> InteractionData -> Const (Maybe [Text]) InteractionData
#values
        let values' :: Set Text
values' = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
values
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Set Text -> Set Text -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set Text
values' Set Text
finalValues
        [Text] -> Maybe [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
values
   in (Component
-> (Interaction -> ExtractResult (Maybe [Text]))
-> ViewComponent (Maybe [Text])
forall a.
Component -> (Interaction -> ExtractResult a) -> ViewComponent a
ViewComponent (Select -> Component
C.Select' Select
comp) Interaction -> ExtractResult (Maybe [Text])
parse, g
g')

data TextInputDecoded = TextInputDecoded
  { TextInputDecoded -> Maybe Text
value :: Maybe Text
  , TextInputDecoded -> CustomID
customID :: CustomID
  }
  deriving (Int -> TextInputDecoded -> ShowS
[TextInputDecoded] -> ShowS
TextInputDecoded -> String
(Int -> TextInputDecoded -> ShowS)
-> (TextInputDecoded -> String)
-> ([TextInputDecoded] -> ShowS)
-> Show TextInputDecoded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextInputDecoded] -> ShowS
$cshowList :: [TextInputDecoded] -> ShowS
show :: TextInputDecoded -> String
$cshow :: TextInputDecoded -> String
showsPrec :: Int -> TextInputDecoded -> ShowS
$cshowsPrec :: Int -> TextInputDecoded -> ShowS
Show, (forall x. TextInputDecoded -> Rep TextInputDecoded x)
-> (forall x. Rep TextInputDecoded x -> TextInputDecoded)
-> Generic TextInputDecoded
forall x. Rep TextInputDecoded x -> TextInputDecoded
forall x. TextInputDecoded -> Rep TextInputDecoded x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextInputDecoded x -> TextInputDecoded
$cfrom :: forall x. TextInputDecoded -> Rep TextInputDecoded x
Generic)
  deriving (Value -> Parser [TextInputDecoded]
Value -> Parser TextInputDecoded
(Value -> Parser TextInputDecoded)
-> (Value -> Parser [TextInputDecoded])
-> FromJSON TextInputDecoded
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TextInputDecoded]
$cparseJSONList :: Value -> Parser [TextInputDecoded]
parseJSON :: Value -> Parser TextInputDecoded
$cparseJSON :: Value -> Parser TextInputDecoded
Data.Aeson.FromJSON) via CalamityJSON TextInputDecoded

parseTextInput :: CustomID -> Interaction -> ExtractResult (Maybe Text)
parseTextInput :: CustomID -> Interaction -> ExtractResult (Maybe Text)
parseTextInput CustomID
cid Interaction
int = Maybe Text -> ExtractResult (Maybe Text)
forall a. Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe (Maybe Text -> ExtractResult (Maybe Text))
-> Maybe Text -> ExtractResult (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
  [Value]
components <- Interaction
int Interaction
-> Getting (Maybe [Value]) Interaction (Maybe [Value])
-> Maybe [Value]
forall s a. s -> Getting a s a -> a
^. IsLabel
  "data_"
  ((Maybe InteractionData
    -> Const (Maybe [Value]) (Maybe InteractionData))
   -> Interaction -> Const (Maybe [Value]) Interaction)
(Maybe InteractionData
 -> Const (Maybe [Value]) (Maybe InteractionData))
-> Interaction -> Const (Maybe [Value]) Interaction
#data_ ((Maybe InteractionData
  -> Const (Maybe [Value]) (Maybe InteractionData))
 -> Interaction -> Const (Maybe [Value]) Interaction)
-> ((Maybe [Value] -> Const (Maybe [Value]) (Maybe [Value]))
    -> Maybe InteractionData
    -> Const (Maybe [Value]) (Maybe InteractionData))
-> Getting (Maybe [Value]) Interaction (Maybe [Value])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InteractionData -> Const (Maybe [Value]) InteractionData)
-> Maybe InteractionData
-> Const (Maybe [Value]) (Maybe InteractionData)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((InteractionData -> Const (Maybe [Value]) InteractionData)
 -> Maybe InteractionData
 -> Const (Maybe [Value]) (Maybe InteractionData))
-> ((Maybe [Value] -> Const (Maybe [Value]) (Maybe [Value]))
    -> InteractionData -> Const (Maybe [Value]) InteractionData)
-> (Maybe [Value] -> Const (Maybe [Value]) (Maybe [Value]))
-> Maybe InteractionData
-> Const (Maybe [Value]) (Maybe InteractionData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "components"
  ((Maybe [Value] -> Const (Maybe [Value]) (Maybe [Value]))
   -> InteractionData -> Const (Maybe [Value]) InteractionData)
(Maybe [Value] -> Const (Maybe [Value]) (Maybe [Value]))
-> InteractionData -> Const (Maybe [Value]) InteractionData
#components
  -- currently, each text input is a singleton actionrow containing a single textinput component

  let textInputs :: [Value]
textInputs = [Value]
components [Value] -> Getting (Endo [Value]) [Value] Value -> [Value]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Value]) [Value] Value
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Getting (Endo [Value]) [Value] Value
-> ((Value -> Const (Endo [Value]) Value)
    -> Value -> Const (Endo [Value]) Value)
-> Getting (Endo [Value]) [Value] Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"components" ((Value -> Const (Endo [Value]) Value)
 -> Value -> Const (Endo [Value]) Value)
-> ((Value -> Const (Endo [Value]) Value)
    -> Value -> Const (Endo [Value]) Value)
-> (Value -> Const (Endo [Value]) Value)
-> Value
-> Const (Endo [Value]) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Const (Endo [Value]) (Vector Value))
-> Value -> Const (Endo [Value]) Value
forall t. AsValue t => Prism' t (Vector Value)
_Array ((Vector Value -> Const (Endo [Value]) (Vector Value))
 -> Value -> Const (Endo [Value]) Value)
-> ((Value -> Const (Endo [Value]) Value)
    -> Vector Value -> Const (Endo [Value]) (Vector Value))
-> (Value -> Const (Endo [Value]) Value)
-> Value
-> Const (Endo [Value]) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Value]) Value)
-> Vector Value -> Const (Endo [Value]) (Vector Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
      Result [TextInputDecoded]
inputs' :: Data.Aeson.Result [TextInputDecoded] = (Value -> Result TextInputDecoded)
-> [Value] -> Result [TextInputDecoded]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Result TextInputDecoded
forall a. FromJSON a => Value -> Result a
Data.Aeson.fromJSON [Value]
textInputs

  [TextInputDecoded]
inputs <- case Result [TextInputDecoded]
inputs' of
    Data.Aeson.Success [TextInputDecoded]
x -> [TextInputDecoded] -> Maybe [TextInputDecoded]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TextInputDecoded]
x
    Data.Aeson.Error String
_ -> Maybe [TextInputDecoded]
forall a. Maybe a
Nothing

  TextInputDecoded
thisValue <- (TextInputDecoded -> Bool)
-> [TextInputDecoded] -> Maybe TextInputDecoded
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find ((CustomID -> CustomID -> Bool
forall a. Eq a => a -> a -> Bool
== CustomID
cid) (CustomID -> Bool)
-> (TextInputDecoded -> CustomID) -> TextInputDecoded -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextInputDecoded
-> Getting CustomID TextInputDecoded CustomID -> CustomID
forall s a. s -> Getting a s a -> a
^. IsLabel "customID" (Getting CustomID TextInputDecoded CustomID)
Getting CustomID TextInputDecoded CustomID
#customID)) [TextInputDecoded]
inputs

  TextInputDecoded
thisValue TextInputDecoded
-> Getting (Maybe Text) TextInputDecoded (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. IsLabel
  "value" (Getting (Maybe Text) TextInputDecoded (Maybe Text))
Getting (Maybe Text) TextInputDecoded (Maybe Text)
#value

{- | Construct a 'View' containing a 'C.TextInput' with the given style and label

 All other fields of 'C.TextInput' default to 'Nothing'

 This view ensures that a value was passed for an input
-}
textInput ::
  C.TextInputStyle ->
  -- | Label
  Text ->
  View Text
textInput :: TextInputStyle -> Text -> View Text
textInput TextInputStyle
s Text
l = (forall g. RandomGen g => g -> (ViewComponent Text, g))
-> View Text
forall a.
(forall g. RandomGen g => g -> (ViewComponent a, g)) -> View a
SingView ((forall g. RandomGen g => g -> (ViewComponent Text, g))
 -> View Text)
-> (forall g. RandomGen g => g -> (ViewComponent Text, g))
-> View Text
forall a b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall g a. (RandomGen g, Uniform a) => g -> (a, g)
uniform g
g
      comp :: Component
comp = TextInput -> Component
C.TextInput' (TextInput -> Component) -> TextInput -> Component
forall a b. (a -> b) -> a -> b
$ TextInputStyle -> Text -> CustomID -> TextInput
C.textInput TextInputStyle
s Text
l CustomID
cid
      parse :: Interaction -> ExtractResult Text
parse = ExtractResult (Maybe Text) -> ExtractResult Text
forall a. ExtractResult (Maybe a) -> ExtractResult a
ensure (ExtractResult (Maybe Text) -> ExtractResult Text)
-> (Interaction -> ExtractResult (Maybe Text))
-> Interaction
-> ExtractResult Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CustomID -> Interaction -> ExtractResult (Maybe Text)
parseTextInput CustomID
cid
   in (Component
-> (Interaction -> ExtractResult Text) -> ViewComponent Text
forall a.
Component -> (Interaction -> ExtractResult a) -> ViewComponent a
ViewComponent Component
comp Interaction -> ExtractResult Text
parse, g
g')
  where
    ensure :: ExtractResult (Maybe a) -> ExtractResult a
ensure (ExtractOk ExtractOkType
v (Just a
x)) = ExtractOkType -> a -> ExtractResult a
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
v a
x
    ensure ExtractResult (Maybe a)
_ = ExtractResult a
forall a. ExtractResult a
ExtractFail

{- | Construct a 'View' containing a 'C.TextInput' with the given style and label,
   then modify the component with the passed mapping function
-}
textInput' ::
  C.TextInputStyle ->
  -- | Label
  Text ->
  (C.TextInput -> C.TextInput) ->
  View (Maybe Text)
textInput' :: TextInputStyle
-> Text -> (TextInput -> TextInput) -> View (Maybe Text)
textInput' TextInputStyle
s Text
l TextInput -> TextInput
f = (forall g. RandomGen g => g -> (ViewComponent (Maybe Text), g))
-> View (Maybe Text)
forall a.
(forall g. RandomGen g => g -> (ViewComponent a, g)) -> View a
SingView ((forall g. RandomGen g => g -> (ViewComponent (Maybe Text), g))
 -> View (Maybe Text))
-> (forall g. RandomGen g => g -> (ViewComponent (Maybe Text), g))
-> View (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall g a. (RandomGen g, Uniform a) => g -> (a, g)
uniform g
g
      comp :: Component
comp = TextInput -> Component
C.TextInput' (TextInput -> Component)
-> (TextInput -> TextInput) -> TextInput -> Component
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextInput -> TextInput
f (TextInput -> Component) -> TextInput -> Component
forall a b. (a -> b) -> a -> b
$ TextInputStyle -> Text -> CustomID -> TextInput
C.textInput TextInputStyle
s Text
l CustomID
cid
      parse :: Interaction -> ExtractResult (Maybe Text)
parse = CustomID -> Interaction -> ExtractResult (Maybe Text)
parseTextInput CustomID
cid
   in (Component
-> (Interaction -> ExtractResult (Maybe Text))
-> ViewComponent (Maybe Text)
forall a.
Component -> (Interaction -> ExtractResult a) -> ViewComponent a
ViewComponent Component
comp Interaction -> ExtractResult (Maybe Text)
parse, g
g')

-- componentIDS :: C.Component -> S.Set CustomID
-- componentIDS (C.ActionRow' coms) = S.unions $ map componentIDS coms
-- componentIDS (C.Button' C.Button {customID}) = S.singleton customID
-- componentIDS (C.LinkButton' _) = S.empty
-- componentIDS (C.Select' C.Select {customID}) = S.singleton customID
-- componentIDS (C.TextInput' C.TextInput {customID}) = S.singleton customID

-- | Generate a 'ViewInstance' of a 'View' by filling in 'CustomID's with random values
instantiateView :: RandomGen g => g -> View a -> (ViewInstance a, g)
instantiateView :: g -> View a -> (ViewInstance a, g)
instantiateView g
g View a
v =
  case View a
v of
    NilView a
x -> ((Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
forall a.
(Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
ViewInstance (ExtractResult a -> Interaction -> ExtractResult a
forall a b. a -> b -> a
const (ExtractResult a -> Interaction -> ExtractResult a)
-> ExtractResult a -> Interaction -> ExtractResult a
forall a b. (a -> b) -> a -> b
$ ExtractOkType -> a -> ExtractResult a
forall a. ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted a
x) [], g
g)
    SingView forall g. RandomGen g => g -> (ViewComponent a, g)
f ->
      let (ViewComponent Component
c Interaction -> ExtractResult a
p, g
g') = g -> (ViewComponent a, g)
forall g. RandomGen g => g -> (ViewComponent a, g)
f g
g
          i :: ViewInstance a
i = (Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
forall a.
(Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
ViewInstance Interaction -> ExtractResult a
p [Component
c]
       in (ViewInstance a
i, g
g')
    RowView View a
x ->
      let (v' :: ViewInstance a
v'@ViewInstance {[Component]
rendered :: [Component]
$sel:rendered:ViewInstance :: forall a. ViewInstance a -> [Component]
rendered}, g
g') = g -> View a -> (ViewInstance a, g)
forall g a. RandomGen g => g -> View a -> (ViewInstance a, g)
instantiateView g
g View a
x
       in (ViewInstance a
v' {$sel:rendered:ViewInstance :: [Component]
rendered = [[Component] -> Component
C.ActionRow' [Component]
rendered]}, g
g')
    MultView View (x -> a)
a View x
b ->
      let (ViewInstance Interaction -> ExtractResult (x -> a)
ia [Component]
ra, g
g') = g -> View (x -> a) -> (ViewInstance (x -> a), g)
forall g a. RandomGen g => g -> View a -> (ViewInstance a, g)
instantiateView g
g View (x -> a)
a
          (ViewInstance Interaction -> ExtractResult x
ib [Component]
rb, g
g'') = g -> View x -> (ViewInstance x, g)
forall g a. RandomGen g => g -> View a -> (ViewInstance a, g)
instantiateView g
g' View x
b
          inv :: Interaction -> ExtractResult a
inv Interaction
i = Interaction -> ExtractResult (x -> a)
ia Interaction
i ExtractResult (x -> a) -> ExtractResult x -> ExtractResult a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Interaction -> ExtractResult x
ib Interaction
i
       in ((Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
forall a.
(Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
ViewInstance Interaction -> ExtractResult a
inv ([Component]
ra [Component] -> [Component] -> [Component]
forall a. Semigroup a => a -> a -> a
<> [Component]
rb), g
g'')

-- | Delete the initial message containing components
deleteInitialMsg :: (BotC r, P.Member (ViewEff a inp (Either e Message)) r) => P.Sem r ()
deleteInitialMsg :: Sem r ()
deleteInitialMsg = do
  Either e Message
ini <- Sem r (Either e Message)
forall ret inp sendResp (r :: EffectRow).
Member (ViewEff ret inp sendResp) r =>
Sem r sendResp
getSendResponse
  case Either e Message
ini of
    Right Message
m ->
      Sem r (Either RestError ()) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (Either RestError ()) -> Sem r ())
-> (ChannelRequest () -> Sem r (Either RestError ()))
-> ChannelRequest ()
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelRequest () -> Sem r (Either RestError ())
forall (r :: EffectRow) a.
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke (ChannelRequest () -> Sem r ()) -> ChannelRequest () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Message -> Message -> ChannelRequest ()
forall c m.
(HasID Channel c, HasID Message m) =>
c -> m -> ChannelRequest ()
DeleteMessage Message
m Message
m
    Left e
_ -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Run a 'View', returning the value passed to 'endView'
--
-- This function will not return until 'endView' is used inside the view.
-- If you want it to run in the background, consider using "Polysemy.Async".
--
-- This is async exception safe, you can use libraries such as
-- [polysemy-conc](https://hackage.haskell.org/package/polysemy-conc) to stop
-- views after a timeout.
runView ::
  BotC r =>
  -- | The initial view to render
  View inp ->
  -- | A function to send the rendered view (i.e. as a message or a modal)
  ([C.Component] -> P.Sem r sendResp) ->
  -- | Your callback effect.
  --
  -- local state semantics are preserved between calls here, you can keep state around
  (inp -> P.Sem (InteractionEff ': ViewEff a inp sendResp ': r) ()) ->
  P.Sem r a
runView :: View inp
-> ([Component] -> Sem r sendResp)
-> (inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ())
-> Sem r a
runView View inp
v [Component] -> Sem r sendResp
sendRendered inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ()
m = do
  inst :: ViewInstance inp
inst@ViewInstance {[Component]
rendered :: [Component]
$sel:rendered:ViewInstance :: forall a. ViewInstance a -> [Component]
rendered} <- (StdGen -> (ViewInstance inp, StdGen)) -> Sem r (ViewInstance inp)
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom (StdGen -> View inp -> (ViewInstance inp, StdGen)
forall g a. RandomGen g => g -> View a -> (ViewInstance a, g)
`instantiateView` View inp
v)
  sendResp
r <- [Component] -> Sem r sendResp
sendRendered [Component]
rendered
  sendResp
-> ViewInstance inp
-> (inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ())
-> Sem r a
forall (r :: EffectRow) sendResp inp a.
BotC r =>
sendResp
-> ViewInstance inp
-> (inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ())
-> Sem r a
runViewInstance sendResp
r ViewInstance inp
inst inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ()
m

{- | Run a prerendered 'View', returning the value passed to 'endView'

 This function won't send the view, you should do that yourself
-}
runViewInstance ::
  BotC r =>
  -- | An initial value to act as the value of @GetSendResponse@
  --
  -- If you just sent a message, probably pass that
  sendResp ->
  -- | The initial view to run
  ViewInstance inp ->
  -- | Your callback effect.
  --
  -- In here you get access to the 'InteractionEff' and 'ViewEff' effects.
  --
  -- local state semantics are preserved between calls here, you can keep state around
  (inp -> P.Sem (InteractionEff ': ViewEff a inp sendResp ': r) ()) ->
  P.Sem r a
runViewInstance :: sendResp
-> ViewInstance inp
-> (inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ())
-> Sem r a
runViewInstance sendResp
initSendResp ViewInstance inp
inst inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ()
m = Sem (Resource : r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
P.resourceToIOFinal (Sem (Resource : r) a -> Sem r a)
-> Sem (Resource : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$ do
  TQueue Interaction
eventIn <- IO (TQueue Interaction) -> Sem (Resource : r) (TQueue Interaction)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed IO (TQueue Interaction)
forall a. IO (TQueue a)
STM.newTQueueIO

  Sem (Resource : r) (Sem r ())
-> (Sem r () -> Sem (Resource : r) ())
-> (Sem r () -> Sem (Resource : r) a)
-> Sem (Resource : r) a
forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
P.bracket
    (Sem r (Sem r ()) -> Sem (Resource : r) (Sem r ())
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
P.raise (Sem r (Sem r ()) -> Sem (Resource : r) (Sem r ()))
-> Sem r (Sem r ()) -> Sem (Resource : r) (Sem r ())
forall a b. (a -> b) -> a -> b
$ (EHType 'InteractionEvt -> Sem r ()) -> Sem r (Sem r ())
forall (s :: EventType) (r :: EffectRow).
(BotC r, ReactConstraints s) =>
(EHType s -> Sem r ()) -> Sem r (Sem r ())
react @'InteractionEvt (IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO () -> Sem r ())
-> (Interaction -> IO ()) -> Interaction -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue Interaction -> Interaction -> IO ()
sender TQueue Interaction
eventIn))
    Sem r () -> Sem (Resource : r) ()
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
P.raise
    ( \Sem r ()
_ -> do
        Sem r a -> Sem (Resource : r) a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem r a -> Sem (e : r) a
P.raise (Sem r a -> Sem (Resource : r) a)
-> Sem r a -> Sem (Resource : r) a
forall a b. (a -> b) -> a -> b
$ sendResp
-> ViewInstance inp
-> TQueue Interaction
-> (inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ())
-> Sem r a
forall (r :: EffectRow) ret inp sendResp.
Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r =>
sendResp
-> ViewInstance inp
-> TQueue Interaction
-> (inp -> Sem (InteractionEff : ViewEff ret inp sendResp : r) ())
-> Sem r ret
innerLoop sendResp
initSendResp ViewInstance inp
inst TQueue Interaction
eventIn inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ()
m
    )
  where
    interpretInteraction ::
      forall r.
      Interaction ->
      P.Sem (InteractionEff ': r) () ->
      P.Sem r ()
    interpretInteraction :: Interaction -> Sem (InteractionEff : r) () -> Sem r ()
interpretInteraction Interaction
int =
      (forall (rInitial :: EffectRow) x.
 InteractionEff (Sem rInitial) x -> Sem r x)
-> Sem (InteractionEff : r) () -> Sem r ()
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
        ( \case
            InteractionEff (Sem rInitial) x
GetInteraction -> Interaction -> Sem r Interaction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Interaction
int
        )

    interpretView ::
      forall r ret inp sendResp.
      P.Member (P.Embed IO) r =>
      P.Sem (ViewEff ret inp sendResp ': r) () ->
      P.Sem (P.State (Maybe ret, ViewInstance inp, sendResp) ': r) ()
    interpretView :: Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
interpretView =
      (forall (rInitial :: EffectRow) x.
 ViewEff ret inp sendResp (Sem rInitial) x
 -> Tactical
      (ViewEff ret inp sendResp)
      (Sem rInitial)
      (State (Maybe ret, ViewInstance inp, sendResp) : r)
      x)
-> Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpretH
        ( \case
            EndView x -> ((Maybe ret, ViewInstance inp, sendResp)
 -> (Maybe ret, ViewInstance inp, sendResp))
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify' ((Maybe ret -> Identity (Maybe ret))
-> (Maybe ret, ViewInstance inp, sendResp)
-> Identity (Maybe ret, ViewInstance inp, sendResp)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Maybe ret -> Identity (Maybe ret))
 -> (Maybe ret, ViewInstance inp, sendResp)
 -> Identity (Maybe ret, ViewInstance inp, sendResp))
-> ret
-> (Maybe ret, ViewInstance inp, sendResp)
-> (Maybe ret, ViewInstance inp, sendResp)
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ret
x) Sem
  (WithTactics
     (ViewEff ret inp sendResp)
     f
     (Sem rInitial)
     (State (Maybe ret, ViewInstance inp, sendResp) : r))
  ()
-> (()
    -> Sem
         (WithTactics
            (ViewEff ret inp sendResp)
            f
            (Sem rInitial)
            (State (Maybe ret, ViewInstance inp, sendResp) : r))
         (f ()))
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (f ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ()
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (f ())
forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
P.pureT
            ReplaceView v m -> do
              inst :: ViewInstance inp
inst@ViewInstance {[Component]
rendered :: [Component]
$sel:rendered:ViewInstance :: forall a. ViewInstance a -> [Component]
rendered} <- IO (ViewInstance inp)
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (ViewInstance inp)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO (ViewInstance inp)
 -> Sem
      (WithTactics
         (ViewEff ret inp sendResp)
         f
         (Sem rInitial)
         (State (Maybe ret, ViewInstance inp, sendResp) : r))
      (ViewInstance inp))
-> IO (ViewInstance inp)
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (ViewInstance inp)
forall a b. (a -> b) -> a -> b
$ (StdGen -> (ViewInstance inp, StdGen)) -> IO (ViewInstance inp)
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom (StdGen -> View inp -> (ViewInstance inp, StdGen)
forall g a. RandomGen g => g -> View a -> (ViewInstance a, g)
`instantiateView` View inp
v)
              ((Maybe ret, ViewInstance inp, sendResp)
 -> (Maybe ret, ViewInstance inp, sendResp))
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     ()
forall s (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify' ((ViewInstance inp -> Identity (ViewInstance inp))
-> (Maybe ret, ViewInstance inp, sendResp)
-> Identity (Maybe ret, ViewInstance inp, sendResp)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((ViewInstance inp -> Identity (ViewInstance inp))
 -> (Maybe ret, ViewInstance inp, sendResp)
 -> Identity (Maybe ret, ViewInstance inp, sendResp))
-> ViewInstance inp
-> (Maybe ret, ViewInstance inp, sendResp)
-> (Maybe ret, ViewInstance inp, sendResp)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ViewInstance inp
inst)
              Sem rInitial ()
-> Tactical
     (ViewEff ret inp sendResp)
     (Sem rInitial)
     (State (Maybe ret, ViewInstance inp, sendResp) : r)
     ()
forall (m :: * -> *) a (e :: (* -> *) -> * -> *) (r :: EffectRow).
m a -> Tactical e m r a
P.runTSimple (Sem rInitial ()
 -> Tactical
      (ViewEff ret inp sendResp)
      (Sem rInitial)
      (State (Maybe ret, ViewInstance inp, sendResp) : r)
      ())
-> Sem rInitial ()
-> Tactical
     (ViewEff ret inp sendResp)
     (Sem rInitial)
     (State (Maybe ret, ViewInstance inp, sendResp) : r)
     ()
forall a b. (a -> b) -> a -> b
$ [Component] -> Sem rInitial ()
m [Component]
rendered
            ViewEff ret inp sendResp (Sem rInitial) x
GetSendResponse -> ((Maybe ret, ViewInstance inp, sendResp) -> x)
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     x
forall s a (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
P.gets ((Maybe ret, ViewInstance inp, sendResp)
-> Getting x (Maybe ret, ViewInstance inp, sendResp) x -> x
forall s a. s -> Getting a s a -> a
^. Getting x (Maybe ret, ViewInstance inp, sendResp) x
forall s t a b. Field3 s t a b => Lens s t a b
_3) Sem
  (WithTactics
     (ViewEff ret inp sendResp)
     f
     (Sem rInitial)
     (State (Maybe ret, ViewInstance inp, sendResp) : r))
  x
-> (x
    -> Sem
         (WithTactics
            (ViewEff ret inp sendResp)
            f
            (Sem rInitial)
            (State (Maybe ret, ViewInstance inp, sendResp) : r))
         (f x))
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (f x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (f x)
forall (f :: * -> *) a (e :: (* -> *) -> * -> *) (m :: * -> *)
       (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
P.pureT
        )

    innerLoop ::
      forall r ret inp sendResp.
      P.Members '[RatelimitEff, TokenEff, LogEff, MetricEff, P.Embed IO] r =>
      sendResp ->
      ViewInstance inp ->
      STM.TQueue Interaction ->
      (inp -> P.Sem (InteractionEff ': ViewEff ret inp sendResp ': r) ()) ->
      P.Sem r ret
    innerLoop :: sendResp
-> ViewInstance inp
-> TQueue Interaction
-> (inp -> Sem (InteractionEff : ViewEff ret inp sendResp : r) ())
-> Sem r ret
innerLoop sendResp
initialSendResp ViewInstance inp
initialInst TQueue Interaction
inChan inp -> Sem (InteractionEff : ViewEff ret inp sendResp : r) ()
m = (Maybe ret, ViewInstance inp, sendResp)
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ret
-> Sem r ret
forall s (r :: EffectRow) a. s -> Sem (State s : r) a -> Sem r a
P.evalState (Maybe ret
forall a. Maybe a
Nothing, ViewInstance inp
initialInst, sendResp
initialSendResp) Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ret
innerLoop'
      where
        innerLoop' :: P.Sem (P.State (Maybe ret, ViewInstance inp, sendResp) ': r) ret
        innerLoop' :: Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ret
innerLoop' = do
          (Maybe ret
s, ViewInstance {Interaction -> ExtractResult inp
extract :: Interaction -> ExtractResult inp
$sel:extract:ViewInstance :: forall a. ViewInstance a -> Interaction -> ExtractResult a
extract}, sendResp
_) <- Sem
  (State (Maybe ret, ViewInstance inp, sendResp) : r)
  (Maybe ret, ViewInstance inp, sendResp)
forall s (r :: EffectRow). Member (State s) r => Sem r s
P.get
          case Maybe ret
s of
            Just ret
x -> ret -> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ret
forall (f :: * -> *) a. Applicative f => a -> f a
pure ret
x
            Maybe ret
Nothing -> do
              Interaction
int <- IO Interaction
-> Sem
     (State (Maybe ret, ViewInstance inp, sendResp) : r) Interaction
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO Interaction
 -> Sem
      (State (Maybe ret, ViewInstance inp, sendResp) : r) Interaction)
-> IO Interaction
-> Sem
     (State (Maybe ret, ViewInstance inp, sendResp) : r) Interaction
forall a b. (a -> b) -> a -> b
$ STM Interaction -> IO Interaction
forall a. STM a -> IO a
STM.atomically (TQueue Interaction -> STM Interaction
forall a. TQueue a -> STM a
STM.readTQueue TQueue Interaction
inChan)
              case Interaction -> ExtractResult inp
extract Interaction
int of
                ExtractOk ExtractOkType
SomeExtracted inp
x -> Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
forall (r :: EffectRow) ret inp sendResp.
Member (Embed IO) r =>
Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
interpretView (Sem (ViewEff ret inp sendResp : r) ()
 -> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ())
-> Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
forall a b. (a -> b) -> a -> b
$ Interaction
-> Sem (InteractionEff : ViewEff ret inp sendResp : r) ()
-> Sem (ViewEff ret inp sendResp : r) ()
forall (r :: EffectRow).
Interaction -> Sem (InteractionEff : r) () -> Sem r ()
interpretInteraction Interaction
int (inp -> Sem (InteractionEff : ViewEff ret inp sendResp : r) ()
m inp
x)
                ExtractResult inp
_ -> () -> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

              -- if Just True == ((`S.member` customIDS) <$> extractCustomID int)
              --   then case extract int of
              --     ExtractOk SomeExtracted x -> interpretView $ interpretInteraction int (m x)
              --     _ -> pure ()
              --   else pure ()
              Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ret
innerLoop'

    sender :: STM.TQueue Interaction -> Interaction -> IO ()
    sender :: TQueue Interaction -> Interaction -> IO ()
sender TQueue Interaction
eventIn Interaction
int = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue Interaction -> Interaction -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue Interaction
eventIn Interaction
int