{-# 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.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 Optics
import Control.Monad (guard, void)
import qualified Data.Aeson as Aeson
import qualified Data.List
import qualified Data.Set as S
import Data.Text (Text)
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
import Data.Aeson ((.:?), (.:))
import Data.Aeson.Optics

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

instance Functor ViewComponent where
  fmap :: forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> ViewComponent a -> ViewComponent b
fmap a -> b
f ViewComponent {Component
component :: Component
$sel:component:ViewComponent :: forall (a :: OpticKind). ViewComponent a -> Component
component, Interaction -> ExtractResult a
parse :: Interaction -> ExtractResult a
$sel:parse:ViewComponent :: forall (a :: OpticKind).
ViewComponent a -> Interaction -> ExtractResult a
parse} = ViewComponent {Component
component :: Component
$sel:component:ViewComponent :: Component
component, $sel:parse:ViewComponent :: Interaction -> ExtractResult b
parse = forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap a -> b
f forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(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 :: forall (a :: OpticKind). View a -> View a
row = forall (a :: OpticKind). View a -> View a
RowView

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

instance Applicative View where
  pure :: forall (a :: OpticKind). a -> View a
pure = forall (a :: OpticKind). a -> View a
NilView
  <*> :: forall (a :: OpticKind) (b :: OpticKind).
View (a -> b) -> View a -> View b
(<*>) = forall (a :: OpticKind) (x :: OpticKind).
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
  >>= :: forall (a :: OpticKind) (b :: OpticKind).
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
forall (a :: OpticKind).
(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
forall (a :: OpticKind). Show a => Int -> ExtractResult a -> ShowS
forall (a :: OpticKind). Show a => [ExtractResult a] -> ShowS
forall (a :: OpticKind). Show a => ExtractResult a -> String
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtractResult a] -> ShowS
$cshowList :: forall (a :: OpticKind). Show a => [ExtractResult a] -> ShowS
show :: ExtractResult a -> String
$cshow :: forall (a :: OpticKind). Show a => ExtractResult a -> String
showsPrec :: Int -> ExtractResult a -> ShowS
$cshowsPrec :: forall (a :: OpticKind). Show a => Int -> ExtractResult a -> ShowS
Show, forall (a :: OpticKind) (b :: OpticKind).
a -> ExtractResult b -> ExtractResult a
forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> ExtractResult a -> ExtractResult b
forall (f :: OpticKind -> OpticKind).
(forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> f a -> f b)
-> (forall (a :: OpticKind) (b :: OpticKind). a -> f b -> f a)
-> Functor f
<$ :: forall (a :: OpticKind) (b :: OpticKind).
a -> ExtractResult b -> ExtractResult a
$c<$ :: forall (a :: OpticKind) (b :: OpticKind).
a -> ExtractResult b -> ExtractResult a
fmap :: forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> ExtractResult a -> ExtractResult b
$cfmap :: forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> ExtractResult a -> ExtractResult b
Functor)

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

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

data ViewInstance a = ViewInstance
  { -- customIDS :: Set C.CustomID ,
    forall (a :: OpticKind).
ViewInstance a -> Interaction -> ExtractResult a
extract :: Interaction -> ExtractResult a
  , forall (a :: OpticKind). 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
  forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard forall (a :: OpticKind) b. (a -> b) -> a -> b
$ InteractionType
type_ forall (a :: OpticKind). Eq a => a -> a -> Bool
== InteractionType
MessageComponentType
  InteractionData
data' <- Maybe InteractionData
data_
  InteractionData
data' forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "customID" a => a
#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_
  forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard forall (a :: OpticKind) b. (a -> b) -> a -> b
$ InteractionData
data' forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "componentType" a => a
#componentType forall (a :: OpticKind). Eq a => a -> a -> Bool
== forall (a :: OpticKind). a -> Maybe a
Just ComponentType
expected

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

extractOkFromBool :: Bool -> ExtractResult Bool
extractOkFromBool :: Bool -> ExtractResult Bool
extractOkFromBool Bool
True = forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted Bool
True
extractOkFromBool Bool
False = forall (a :: OpticKind). 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' ((forall (a :: OpticKind). IsLabel "style" a => a
#style forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ButtonStyle
s) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (forall (a :: OpticKind). IsLabel "label" a => a
#label forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is 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 (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = forall (g :: OpticKind) (a :: OpticKind).
(RandomGen g, Uniform a) =>
g -> (a, g)
uniform g
g
      comp :: Component
comp = Button -> Component
C.Button' forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Button -> Button
f forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ButtonStyle -> CustomID -> Button
C.button ButtonStyle
C.ButtonPrimary CustomID
cid
      parse' :: Interaction -> Bool
parse' Interaction
int =
        forall (a :: OpticKind). a -> Maybe a
Just Bool
True
          forall (a :: OpticKind). Eq a => a -> a -> Bool
== ( do
                CustomID
customID <- Interaction -> Maybe CustomID
extractCustomID Interaction
int
                Interaction -> ComponentType -> Maybe ()
guardComponentType Interaction
int ComponentType
C.ButtonType
                forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure forall (a :: OpticKind) b. (a -> b) -> a -> b
$ CustomID
customID forall (a :: OpticKind). Eq a => a -> a -> Bool
== CustomID
cid
             )
      parse :: Interaction -> ExtractResult Bool
parse = Bool -> ExtractResult Bool
extractOkFromBool forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Interaction -> Bool
parse'
   in (forall (a :: OpticKind).
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 forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [SelectOption] -> (Select -> Select) -> View (Maybe [Text])
select' (forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (\Text
x -> Text -> Text -> SelectOption
C.sopt Text
x Text
x) [Text]
opts) forall (a :: OpticKind). 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
      forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [Text]
o forall (a :: OpticKind). Eq a => a -> a -> Bool
== Int
1
      case [Text]
o of
        [Text
x] -> forall (a :: OpticKind). a -> Maybe a
Just Text
x
        [Text]
_ -> forall (a :: OpticKind). 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 (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = forall (g :: OpticKind) (a :: OpticKind).
(RandomGen g, Uniform a) =>
g -> (a, g)
uniform g
g
      comp :: Select
comp = Select -> Select
f forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [SelectOption] -> CustomID -> Select
C.select [SelectOption]
opts CustomID
cid
      finalValues :: Set Text
finalValues = forall (a :: OpticKind). Ord a => [a] -> Set a
S.fromList forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Select
comp forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. forall (a :: OpticKind). IsLabel "options" a => a
#options forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "value" a => a
#value
      parse :: Interaction -> ExtractResult (Maybe [Text])
parse Interaction
int = forall (a :: OpticKind). Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
        CustomID
customID <- Interaction -> Maybe CustomID
extractCustomID Interaction
int
        forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard forall (a :: OpticKind) b. (a -> b) -> a -> b
$ CustomID
customID forall (a :: OpticKind). Eq a => a -> a -> Bool
== CustomID
cid
        Interaction -> ComponentType -> Maybe ()
guardComponentType Interaction
int ComponentType
C.SelectType
        [Text]
values <- Interaction
int forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (a :: OpticKind). IsLabel "data_" a => a
#data_ forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "values" a => a
#values forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just
        let values' :: Set Text
values' = forall (a :: OpticKind). Ord a => [a] -> Set a
S.fromList [Text]
values
        forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set Text
values' Set Text
finalValues
        forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure [Text]
values
   in (forall (a :: OpticKind).
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
forall (a :: OpticKind).
(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)

$(makeFieldLabelsNoPrefix ''TextInputDecoded)

instance Aeson.FromJSON TextInputDecoded where
  parseJSON :: Value -> Parser TextInputDecoded
parseJSON = forall (a :: OpticKind).
String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"TextInputDecoded" forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Object
v ->
    Maybe Text -> CustomID -> TextInputDecoded
TextInputDecoded
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Object
v forall (a :: OpticKind).
FromJSON a =>
Object -> Key -> Parser (Maybe a)
.:? Key
"value"
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
v forall (a :: OpticKind). FromJSON a => Object -> Key -> Parser a
.: Key
"custom_id"

parseTextInput :: CustomID -> Interaction -> ExtractResult (Maybe Text)
parseTextInput :: CustomID -> Interaction -> ExtractResult (Maybe Text)
parseTextInput CustomID
cid Interaction
int = forall (a :: OpticKind). Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  Maybe [Value]
components <- Interaction
int forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? forall (a :: OpticKind). IsLabel "data_" a => a
#data_ forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (a :: OpticKind). IsLabel "components" a => a
#components
  -- currently, each text input is a singleton actionrow containing a single textinput component

  let textInputs :: [Value]
textInputs = Maybe [Value]
components forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"components" forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: OpticKind). AsValue t => Prism' t (Vector Value)
_Array forall (k :: OpticKind) (l :: OpticKind) (m :: OpticKind)
       (is :: IxList) (js :: IxList) (ks :: IxList) (s :: OpticKind)
       (t :: OpticKind) (u :: OpticKind) (v :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed
      Result [TextInputDecoded]
inputs' :: Aeson.Result [TextInputDecoded] = forall (t :: OpticKind -> OpticKind) (f :: OpticKind -> OpticKind)
       (a :: OpticKind) (b :: OpticKind).
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall (a :: OpticKind). FromJSON a => Value -> Result a
Aeson.fromJSON [Value]
textInputs

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

  TextInputDecoded
thisValue <- forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
(a -> Bool) -> t a -> Maybe a
Data.List.find ((forall (a :: OpticKind). Eq a => a -> a -> Bool
== CustomID
cid) forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "customID" a => a
#customID)) [TextInputDecoded]
inputs

  TextInputDecoded
thisValue forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (a :: OpticKind). IsLabel "value" a => a
#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 (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = forall (g :: OpticKind) (a :: OpticKind).
(RandomGen g, Uniform a) =>
g -> (a, g)
uniform g
g
      comp :: Component
comp = TextInput -> Component
C.TextInput' forall (a :: OpticKind) b. (a -> b) -> a -> b
$ TextInputStyle -> Text -> CustomID -> TextInput
C.textInput TextInputStyle
s Text
l CustomID
cid
      parse :: Interaction -> ExtractResult Text
parse = forall {a :: OpticKind}. ExtractResult (Maybe a) -> ExtractResult a
ensure forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> CustomID -> Interaction -> ExtractResult (Maybe Text)
parseTextInput CustomID
cid
   in (forall (a :: OpticKind).
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)) = forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
v a
x
    ensure ExtractResult (Maybe a)
_ = forall (a :: OpticKind). 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 (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = forall (g :: OpticKind) (a :: OpticKind).
(RandomGen g, Uniform a) =>
g -> (a, g)
uniform g
g
      comp :: Component
comp = TextInput -> Component
C.TextInput' forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. TextInput -> TextInput
f forall (a :: OpticKind) 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 (forall (a :: OpticKind).
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 :: forall (g :: OpticKind) (a :: OpticKind).
RandomGen g =>
g -> View a -> (ViewInstance a, g)
instantiateView g
g View a
v =
  case View a
v of
    NilView a
x -> (forall (a :: OpticKind).
(Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
ViewInstance (forall (a :: OpticKind) (b :: OpticKind). a -> b -> a
const forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted a
x) [], g
g)
    SingView forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g)
f ->
      let (ViewComponent Component
c Interaction -> ExtractResult a
p, g
g') = forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g)
f g
g
          i :: ViewInstance a
i = forall (a :: OpticKind).
(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 :: OpticKind). ViewInstance a -> [Component]
rendered}, g
g') = forall (g :: OpticKind) (a :: OpticKind).
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') = forall (g :: OpticKind) (a :: OpticKind).
RandomGen g =>
g -> View a -> (ViewInstance a, g)
instantiateView g
g View (x -> a)
a
          (ViewInstance Interaction -> ExtractResult x
ib [Component]
rb, g
g'') = forall (g :: OpticKind) (a :: OpticKind).
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 forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> Interaction -> ExtractResult x
ib Interaction
i
       in (forall (a :: OpticKind).
(Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
ViewInstance Interaction -> ExtractResult a
inv ([Component]
ra forall (a :: OpticKind). 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 :: forall (r :: EffectRow) (a :: OpticKind) (inp :: OpticKind)
       (e :: OpticKind).
(BotC r, Member (ViewEff a inp (Either e Message)) r) =>
Sem r ()
deleteInitialMsg = do
  Either e Message
ini <- forall (ret :: OpticKind) (inp :: OpticKind)
       (sendResp :: OpticKind) (r :: EffectRow).
Member (ViewEff ret inp sendResp) r =>
Sem r sendResp
getSendResponse
  case Either e Message
ini of
    Right Message
m ->
      forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. forall (r :: EffectRow) (a :: OpticKind).
(Members '[RatelimitEff, TokenEff, LogEff, MetricEff, Embed IO] r,
 Request a, ReadResponse (Result a)) =>
a -> Sem r (Either RestError (Result a))
invoke forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (c :: OpticKind) (m :: OpticKind).
(HasID Channel c, HasID Message m) =>
c -> m -> ChannelRequest ()
DeleteMessage Message
m Message
m
    Left e
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
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 :: forall (r :: EffectRow) (inp :: OpticKind) (sendResp :: OpticKind)
       (a :: OpticKind).
BotC r =>
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 :: OpticKind). ViewInstance a -> [Component]
rendered} <- forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
(StdGen -> (a, StdGen)) -> m a
getStdRandom (forall (g :: OpticKind) (a :: OpticKind).
RandomGen g =>
g -> View a -> (ViewInstance a, g)
`instantiateView` View inp
v)
  sendResp
r <- [Component] -> Sem r sendResp
sendRendered [Component]
rendered
  forall (r :: EffectRow) (sendResp :: OpticKind) (inp :: OpticKind)
       (a :: OpticKind).
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 :: forall (r :: EffectRow) (sendResp :: OpticKind) (inp :: OpticKind)
       (a :: OpticKind).
BotC r =>
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 = forall (r :: EffectRow) (a :: OpticKind).
Member (Final IO) r =>
Sem (Resource : r) a -> Sem r a
P.resourceToIOFinal forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  TQueue Interaction
eventIn <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind). IO (TQueue a)
STM.newTQueueIO

  forall (r :: EffectRow) (a :: OpticKind) (c :: OpticKind)
       (b :: OpticKind).
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
P.bracket
    (forall (e :: Effect) (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (s :: EventType) (r :: EffectRow).
(BotC r, ReactConstraints s) =>
(EHType s -> Sem r ()) -> Sem r (Sem r ())
react @'InteractionEvt (forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. TQueue Interaction -> Interaction -> IO ()
sender TQueue Interaction
eventIn))
    forall (e :: Effect) (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise
    ( \Sem r ()
_ -> do
        forall (e :: Effect) (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (r :: EffectRow) (ret :: OpticKind) (inp :: OpticKind)
       (sendResp :: OpticKind).
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 :: forall (r :: EffectRow).
Interaction -> Sem (InteractionEff : r) () -> Sem r ()
interpretInteraction Interaction
int =
      forall (e :: Effect) (r :: EffectRow) (a :: OpticKind).
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) (x :: OpticKind).
 e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
P.interpret
        ( \case
            InteractionEff (Sem rInitial) x
GetInteraction -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
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 :: forall (r :: EffectRow) (ret :: OpticKind) (inp :: OpticKind)
       (sendResp :: OpticKind).
Member (Embed IO) r =>
Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
interpretView =
      forall (e1 :: Effect) (e2 :: Effect) (r :: EffectRow)
       (a :: OpticKind).
(forall (rInitial :: EffectRow) (x :: OpticKind).
 e1 (Sem rInitial) x -> Tactical e1 (Sem rInitial) (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
P.reinterpretH
        ( \case
            EndView ret
x -> forall (s :: OpticKind) (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify' (forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1 forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ ret
x) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (f :: OpticKind -> OpticKind) (a :: OpticKind) (e :: Effect)
       (m :: OpticKind -> OpticKind) (r :: EffectRow).
Functor f =>
a -> Sem (WithTactics e f m r) (f a)
P.pureT
            ReplaceView View inp
v [Component] -> Sem rInitial ()
m -> do
              inst :: ViewInstance inp
inst@ViewInstance {[Component]
rendered :: [Component]
$sel:rendered:ViewInstance :: forall (a :: OpticKind). ViewInstance a -> [Component]
rendered} <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
(StdGen -> (a, StdGen)) -> m a
getStdRandom (forall (g :: OpticKind) (a :: OpticKind).
RandomGen g =>
g -> View a -> (ViewInstance a, g)
`instantiateView` View inp
v)
              forall (s :: OpticKind) (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify' (forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Field2 s t a b =>
Lens s t a b
_2 forall (k :: OpticKind) (is :: IxList) (s :: OpticKind)
       (t :: OpticKind) (a :: OpticKind) (b :: OpticKind).
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ViewInstance inp
inst)
              forall (m :: OpticKind -> OpticKind) (a :: OpticKind) (e :: Effect)
       (r :: EffectRow).
m a -> Tactical e m r a
P.runTSimple forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Component] -> Sem rInitial ()
m [Component]
rendered
            ViewEff ret inp sendResp (Sem rInitial) x
GetSendResponse -> forall (s :: OpticKind) (a :: OpticKind) (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
P.gets (forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Field3 s t a b =>
Lens s t a b
_3) forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Monad m =>
m a -> (a -> m b) -> m b
>>= forall (f :: OpticKind -> OpticKind) (a :: OpticKind) (e :: Effect)
       (m :: OpticKind -> OpticKind) (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 :: forall (r :: EffectRow) (ret :: OpticKind) (inp :: OpticKind)
       (sendResp :: OpticKind).
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
initialSendResp ViewInstance inp
initialInst TQueue Interaction
inChan inp -> Sem (InteractionEff : ViewEff ret inp sendResp : r) ()
m = forall (s :: OpticKind) (r :: EffectRow) (a :: OpticKind).
s -> Sem (State s : r) a -> Sem r a
P.evalState (forall (a :: OpticKind). 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 :: OpticKind).
ViewInstance a -> Interaction -> ExtractResult a
extract}, sendResp
_) <- forall (s :: OpticKind) (r :: EffectRow).
Member (State s) r =>
Sem r s
P.get
          case Maybe ret
s of
            Just ret
x -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure ret
x
            Maybe ret
Nothing -> do
              Interaction
int <- forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). STM a -> IO a
STM.atomically (forall (a :: OpticKind). TQueue a -> STM a
STM.readTQueue TQueue Interaction
inChan)
              case Interaction -> ExtractResult inp
extract Interaction
int of
                ExtractOk ExtractOkType
SomeExtracted inp
x -> forall (r :: EffectRow) (ret :: OpticKind) (inp :: OpticKind)
       (sendResp :: OpticKind).
Member (Embed IO) r =>
Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
interpretView forall (a :: OpticKind) b. (a -> b) -> a -> b
$ 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
_ -> forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
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 = forall (a :: OpticKind). STM a -> IO a
STM.atomically forall (a :: OpticKind) b. (a -> b) -> a -> b
$ forall (a :: OpticKind). TQueue a -> a -> STM ()
STM.writeTQueue TQueue Interaction
eventIn Interaction
int