{-# 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 Calamity.Types.Model.Channel.Component qualified as C
import Calamity.Types.Model.Channel.Message (Message)
import Calamity.Types.Model.Interaction
import Calamity.Types.TokenEff (TokenEff)
import Control.Concurrent.STM qualified as STM
import Control.Monad (guard, void)
import Data.Aeson ((.:), (.:?))
import Data.Aeson qualified as Aeson
import Data.Aeson.Optics
import Data.List qualified
import Data.Set qualified as S
import Data.Text (Text)
import GHC.TypeLits qualified as E
import Optics
import Polysemy qualified as P
import Polysemy.Resource qualified as P
import Polysemy.State qualified as P
import System.Random

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
$sel:component:ViewComponent :: forall (a :: OpticKind). ViewComponent a -> Component
component :: Component
component, Interaction -> ExtractResult a
$sel:parse:ViewComponent :: forall (a :: OpticKind).
ViewComponent a -> Interaction -> ExtractResult a
parse :: Interaction -> ExtractResult a
parse} = ViewComponent {Component
$sel:component:ViewComponent :: Component
component :: Component
component, $sel:parse:ViewComponent :: Interaction -> ExtractResult b
parse = (a -> b) -> ExtractResult a -> ExtractResult b
forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> ExtractResult a -> ExtractResult b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap a -> b
f (ExtractResult a -> ExtractResult b)
-> (Interaction -> ExtractResult a)
-> Interaction
-> ExtractResult b
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 = View a -> View a
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) = b -> View b
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 (g :: OpticKind). RandomGen g => g -> (ViewComponent b, g))
-> View b
forall (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView (\g
r -> let (ViewComponent a
x', g
r') = g -> (ViewComponent a, g)
forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g)
x g
r in (a -> b
f (a -> b) -> ViewComponent a -> ViewComponent b
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) = View b -> View b
forall (a :: OpticKind). View a -> View a
RowView ((a -> b) -> View a -> View b
forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> View a -> View b
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) = View (x -> b) -> View x -> View b
forall (a :: OpticKind) (x :: OpticKind).
View (x -> a) -> View x -> View a
MultView (((x -> a) -> x -> b) -> View (x -> a) -> View (x -> b)
forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> View a -> View b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
fmap (a -> b
f (a -> b) -> (x -> a) -> x -> b
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 = a -> View a
forall (a :: OpticKind). a -> View a
NilView
  <*> :: forall (a :: OpticKind) (b :: OpticKind).
View (a -> b) -> View a -> View b
(<*>) = 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
(>>=) = 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 :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtractOkType -> ShowS
showsPrec :: Int -> ExtractOkType -> ShowS
$cshow :: ExtractOkType -> String
show :: ExtractOkType -> String
$cshowList :: [ExtractOkType] -> ShowS
showList :: [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 :: 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
$cshowsPrec :: forall (a :: OpticKind). Show a => Int -> ExtractResult a -> ShowS
showsPrec :: Int -> ExtractResult a -> ShowS
$cshow :: forall (a :: OpticKind). Show a => ExtractResult a -> String
show :: ExtractResult a -> String
$cshowList :: forall (a :: OpticKind). Show a => [ExtractResult a] -> ShowS
showList :: [ExtractResult a] -> ShowS
Show, (forall (a :: OpticKind) (b :: OpticKind).
 (a -> b) -> ExtractResult a -> ExtractResult b)
-> (forall (a :: OpticKind) (b :: OpticKind).
    a -> ExtractResult b -> ExtractResult a)
-> Functor ExtractResult
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
$cfmap :: forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> ExtractResult a -> ExtractResult b
fmap :: forall (a :: OpticKind) (b :: OpticKind).
(a -> b) -> ExtractResult a -> ExtractResult b
$c<$ :: forall (a :: OpticKind) (b :: OpticKind).
a -> ExtractResult b -> ExtractResult a
<$ :: forall (a :: OpticKind) (b :: OpticKind).
a -> ExtractResult b -> ExtractResult a
Functor)

instance Applicative ExtractResult where
  pure :: forall (a :: OpticKind). a -> ExtractResult a
pure = ExtractOkType -> a -> ExtractResult a
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 = ExtractOkType -> b -> ExtractResult b
forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk (ExtractOkType
ta ExtractOkType -> ExtractOkType -> ExtractOkType
forall (a :: OpticKind). Semigroup a => a -> a -> a
<> ExtractOkType
tb) (b -> ExtractResult b) -> b -> ExtractResult b
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ a -> b
f a
x
  ExtractResult (a -> b)
_ <*> ExtractResult a
_ = ExtractResult b
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
data_ :: Maybe InteractionData
$sel:data_:Interaction :: Interaction -> Maybe InteractionData
data_, InteractionType
type_ :: InteractionType
$sel:type_:Interaction :: Interaction -> InteractionType
type_} = do
  Bool -> Maybe ()
forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ InteractionType
type_ InteractionType -> InteractionType -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== InteractionType
MessageComponentType
  InteractionData
data' <- Maybe InteractionData
data_
  InteractionData
data' InteractionData
-> Optic' A_Lens NoIx InteractionData (Maybe CustomID)
-> Maybe CustomID
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InteractionData (Maybe CustomID)
#customID

guardComponentType :: Interaction -> C.ComponentType -> Maybe ()
guardComponentType :: Interaction -> ComponentType -> Maybe ()
guardComponentType Interaction {Maybe InteractionData
$sel:data_:Interaction :: Interaction -> Maybe InteractionData
data_ :: Maybe InteractionData
data_} ComponentType
expected = do
  InteractionData
data' <- Maybe InteractionData
data_
  Bool -> Maybe ()
forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ InteractionData
data' InteractionData
-> Optic' A_Lens NoIx InteractionData (Maybe ComponentType)
-> Maybe ComponentType
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InteractionData (Maybe ComponentType)
#componentType Maybe ComponentType -> Maybe ComponentType -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== ComponentType -> Maybe ComponentType
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) = ExtractOkType -> Maybe a -> ExtractResult (Maybe a)
forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted (a -> Maybe a
forall (a :: OpticKind). a -> Maybe a
Just a
a)
extractOkFromMaybe Maybe a
Nothing = ExtractOkType -> Maybe a -> ExtractResult (Maybe a)
forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
NoneExtracted Maybe a
forall (a :: OpticKind). Maybe a
Nothing

extractOkFromBool :: Bool -> ExtractResult Bool
extractOkFromBool :: Bool -> ExtractResult Bool
extractOkFromBool Bool
True = ExtractOkType -> Bool -> ExtractResult Bool
forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
SomeExtracted Bool
True
extractOkFromBool Bool
False = ExtractOkType -> Bool -> ExtractResult Bool
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' ((Optic A_Lens NoIx Button Button ButtonStyle ButtonStyle
#style Optic A_Lens NoIx Button Button ButtonStyle ButtonStyle
-> ButtonStyle -> Button -> Button
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) (Button -> Button) -> (Button -> Button) -> Button -> Button
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. (Optic A_Lens NoIx Button Button (Maybe Text) (Maybe Text)
#label Optic A_Lens NoIx Button Button (Maybe Text) (Maybe Text)
-> Text -> Button -> Button
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 (g :: OpticKind).
 RandomGen g =>
 g -> (ViewComponent Bool, g))
-> View Bool
forall (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView ((forall (g :: OpticKind).
  RandomGen g =>
  g -> (ViewComponent Bool, g))
 -> View Bool)
-> (forall (g :: OpticKind).
    RandomGen g =>
    g -> (ViewComponent Bool, g))
-> View Bool
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall (g :: OpticKind) (a :: OpticKind).
(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 :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Button -> Button
f (Button -> Component) -> Button -> Component
forall (a :: OpticKind) 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 :: OpticKind). a -> Maybe a
Just Bool
True
          Maybe Bool -> Maybe Bool -> Bool
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
                Bool -> Maybe Bool
forall (a :: OpticKind). a -> Maybe a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ CustomID
customID CustomID -> CustomID -> Bool
forall (a :: OpticKind). 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 :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. Interaction -> Bool
parse'
   in (Component
-> (Interaction -> ExtractResult Bool) -> ViewComponent Bool
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 (Maybe [Text] -> Maybe Text)
-> View (Maybe [Text]) -> View (Maybe Text)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> [SelectOption] -> (Select -> Select) -> View (Maybe [Text])
select' ((Text -> SelectOption) -> [Text] -> [SelectOption]
forall (a :: OpticKind) (b :: OpticKind). (a -> b) -> [a] -> [b]
map (\Text
x -> Text -> Text -> SelectOption
C.sopt Text
x Text
x) [Text]
opts) Select -> Select
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
      Bool -> Maybe ()
forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [Text] -> Int
forall (a :: OpticKind). [a] -> Int
forall (t :: OpticKind -> OpticKind) (a :: OpticKind).
Foldable t =>
t a -> Int
length [Text]
o Int -> Int -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== Int
1
      case [Text]
o of
        [Text
x] -> Text -> Maybe Text
forall (a :: OpticKind). a -> Maybe a
Just Text
x
        [Text]
_ -> Maybe 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 (g :: OpticKind).
 RandomGen g =>
 g -> (ViewComponent (Maybe [Text]), g))
-> View (Maybe [Text])
forall (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView ((forall (g :: OpticKind).
  RandomGen g =>
  g -> (ViewComponent (Maybe [Text]), g))
 -> View (Maybe [Text]))
-> (forall (g :: OpticKind).
    RandomGen g =>
    g -> (ViewComponent (Maybe [Text]), g))
-> View (Maybe [Text])
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall (g :: OpticKind) (a :: OpticKind).
(RandomGen g, Uniform a) =>
g -> (a, g)
uniform g
g
      comp :: Select
comp = Select -> Select
f (Select -> Select) -> Select -> Select
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ [SelectOption] -> CustomID -> Select
C.select [SelectOption]
opts CustomID
cid
      finalValues :: Set Text
finalValues = [Text] -> Set Text
forall (a :: OpticKind). Ord a => [a] -> Set a
S.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Select
comp Select -> Optic' A_Traversal NoIx Select Text -> [Text]
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Optic A_Lens NoIx Select Select [SelectOption] [SelectOption]
#options Optic A_Lens NoIx Select Select [SelectOption] [SelectOption]
-> Optic
     A_Traversal
     NoIx
     [SelectOption]
     [SelectOption]
     SelectOption
     SelectOption
-> Optic A_Traversal NoIx Select Select SelectOption SelectOption
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
% Optic
  A_Traversal
  NoIx
  [SelectOption]
  [SelectOption]
  SelectOption
  SelectOption
forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic A_Traversal NoIx Select Select SelectOption SelectOption
-> Optic A_Lens NoIx SelectOption SelectOption Text Text
-> Optic' A_Traversal NoIx Select Text
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
% Optic A_Lens NoIx SelectOption SelectOption Text Text
#value
      parse :: Interaction -> ExtractResult (Maybe [Text])
parse Interaction
int = Maybe [Text] -> ExtractResult (Maybe [Text])
forall (a :: OpticKind). Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe (Maybe [Text] -> ExtractResult (Maybe [Text]))
-> Maybe [Text] -> ExtractResult (Maybe [Text])
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
        CustomID
customID <- Interaction -> Maybe CustomID
extractCustomID Interaction
int
        Bool -> Maybe ()
forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ CustomID
customID CustomID -> CustomID -> Bool
forall (a :: OpticKind). Eq a => a -> a -> Bool
== CustomID
cid
        Interaction -> ComponentType -> Maybe ()
guardComponentType Interaction
int ComponentType
C.SelectType
        [Text]
values <- Interaction
int Interaction
-> Optic' An_AffineTraversal NoIx Interaction [Text]
-> Maybe [Text]
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic
  A_Lens
  NoIx
  Interaction
  Interaction
  (Maybe InteractionData)
  (Maybe InteractionData)
#data_ Optic
  A_Lens
  NoIx
  Interaction
  Interaction
  (Maybe InteractionData)
  (Maybe InteractionData)
-> Optic
     A_Prism
     NoIx
     (Maybe InteractionData)
     (Maybe InteractionData)
     InteractionData
     InteractionData
-> Optic
     An_AffineTraversal
     NoIx
     Interaction
     Interaction
     InteractionData
     InteractionData
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
% Optic
  A_Prism
  NoIx
  (Maybe InteractionData)
  (Maybe InteractionData)
  InteractionData
  InteractionData
forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Interaction
  Interaction
  InteractionData
  InteractionData
-> Optic
     A_Lens
     NoIx
     InteractionData
     InteractionData
     (Maybe [Text])
     (Maybe [Text])
-> Optic
     An_AffineTraversal
     NoIx
     Interaction
     Interaction
     (Maybe [Text])
     (Maybe [Text])
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
% Optic
  A_Lens
  NoIx
  InteractionData
  InteractionData
  (Maybe [Text])
  (Maybe [Text])
#values Optic
  An_AffineTraversal
  NoIx
  Interaction
  Interaction
  (Maybe [Text])
  (Maybe [Text])
-> Optic A_Prism NoIx (Maybe [Text]) (Maybe [Text]) [Text] [Text]
-> Optic' An_AffineTraversal NoIx Interaction [Text]
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
% Optic A_Prism NoIx (Maybe [Text]) (Maybe [Text]) [Text] [Text]
forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just
        let values' :: Set Text
values' = [Text] -> Set Text
forall (a :: OpticKind). Ord a => [a] -> Set a
S.fromList [Text]
values
        Bool -> Maybe ()
forall (f :: OpticKind -> OpticKind). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Set Text -> Set Text -> Bool
forall (a :: OpticKind). Ord a => Set a -> Set a -> Bool
S.isSubsetOf Set Text
values' Set Text
finalValues
        [Text] -> Maybe [Text]
forall (a :: OpticKind). a -> Maybe a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure [Text]
values
   in (Component
-> (Interaction -> ExtractResult (Maybe [Text]))
-> ViewComponent (Maybe [Text])
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
(Int -> TextInputDecoded -> ShowS)
-> (TextInputDecoded -> String)
-> ([TextInputDecoded] -> ShowS)
-> Show TextInputDecoded
forall (a :: OpticKind).
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextInputDecoded -> ShowS
showsPrec :: Int -> TextInputDecoded -> ShowS
$cshow :: TextInputDecoded -> String
show :: TextInputDecoded -> String
$cshowList :: [TextInputDecoded] -> ShowS
showList :: [TextInputDecoded] -> ShowS
Show)

$(makeFieldLabelsNoPrefix ''TextInputDecoded)

instance Aeson.FromJSON TextInputDecoded where
  parseJSON :: Value -> Parser TextInputDecoded
parseJSON = String
-> (Object -> Parser TextInputDecoded)
-> Value
-> Parser TextInputDecoded
forall (a :: OpticKind).
String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"TextInputDecoded" ((Object -> Parser TextInputDecoded)
 -> Value -> Parser TextInputDecoded)
-> (Object -> Parser TextInputDecoded)
-> Value
-> Parser TextInputDecoded
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \Object
v ->
    Maybe Text -> CustomID -> TextInputDecoded
TextInputDecoded
      (Maybe Text -> CustomID -> TextInputDecoded)
-> Parser (Maybe Text) -> Parser (CustomID -> TextInputDecoded)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Functor f =>
(a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall (a :: OpticKind).
FromJSON a =>
Object -> Key -> Parser (Maybe a)
.:? Key
"value"
      Parser (CustomID -> TextInputDecoded)
-> Parser CustomID -> Parser TextInputDecoded
forall (a :: OpticKind) (b :: OpticKind).
Parser (a -> b) -> Parser a -> Parser b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser CustomID
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 = Maybe Text -> ExtractResult (Maybe Text)
forall (a :: OpticKind). Maybe a -> ExtractResult (Maybe a)
extractOkFromMaybe (Maybe Text -> ExtractResult (Maybe Text))
-> Maybe Text -> ExtractResult (Maybe Text)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ do
  Maybe [Value]
components <- Interaction
int Interaction
-> Optic' An_AffineTraversal NoIx Interaction (Maybe [Value])
-> Maybe (Maybe [Value])
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Optic
  A_Lens
  NoIx
  Interaction
  Interaction
  (Maybe InteractionData)
  (Maybe InteractionData)
#data_ Optic
  A_Lens
  NoIx
  Interaction
  Interaction
  (Maybe InteractionData)
  (Maybe InteractionData)
-> Optic
     A_Prism
     NoIx
     (Maybe InteractionData)
     (Maybe InteractionData)
     InteractionData
     InteractionData
-> Optic
     An_AffineTraversal
     NoIx
     Interaction
     Interaction
     InteractionData
     InteractionData
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
% Optic
  A_Prism
  NoIx
  (Maybe InteractionData)
  (Maybe InteractionData)
  InteractionData
  InteractionData
forall (a :: OpticKind) (b :: OpticKind).
Prism (Maybe a) (Maybe b) a b
_Just Optic
  An_AffineTraversal
  NoIx
  Interaction
  Interaction
  InteractionData
  InteractionData
-> Optic
     A_Lens
     NoIx
     InteractionData
     InteractionData
     (Maybe [Value])
     (Maybe [Value])
-> Optic' An_AffineTraversal NoIx Interaction (Maybe [Value])
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
% Optic
  A_Lens
  NoIx
  InteractionData
  InteractionData
  (Maybe [Value])
  (Maybe [Value])
#components
  -- currently, each text input is a singleton actionrow containing a single textinput component

  let textInputs :: [Value]
textInputs = Maybe [Value]
components Maybe [Value]
-> Optic' A_Traversal NoIx (Maybe [Value]) Value -> [Value]
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Fold =>
s -> Optic' k is s a -> [a]
^.. Traversal (Maybe [Value]) (Maybe [Value]) [Value] [Value]
forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed Traversal (Maybe [Value]) (Maybe [Value]) [Value] [Value]
-> Optic A_Traversal NoIx [Value] [Value] Value Value
-> Optic' A_Traversal NoIx (Maybe [Value]) Value
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
% Optic A_Traversal NoIx [Value] [Value] Value Value
forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed Optic' A_Traversal NoIx (Maybe [Value]) Value
-> Optic An_AffineTraversal NoIx Value Value Value Value
-> Optic' A_Traversal NoIx (Maybe [Value]) Value
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
% Key -> Optic An_AffineTraversal NoIx Value Value Value Value
forall (t :: OpticKind).
AsValue t =>
Key -> AffineTraversal' t Value
key Key
"components" Optic' A_Traversal NoIx (Maybe [Value]) Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Optic
     A_Traversal
     NoIx
     (Maybe [Value])
     (Maybe [Value])
     (Vector Value)
     (Vector Value)
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
% Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall (t :: OpticKind). AsValue t => Prism' t (Vector Value)
_Array Optic
  A_Traversal
  NoIx
  (Maybe [Value])
  (Maybe [Value])
  (Vector Value)
  (Vector Value)
-> Optic A_Traversal NoIx (Vector Value) (Vector Value) Value Value
-> Optic' A_Traversal NoIx (Maybe [Value]) Value
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
% Optic A_Traversal NoIx (Vector Value) (Vector Value) Value Value
forall (t :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Traversable t =>
Traversal (t a) (t b) a b
traversed
      Result [TextInputDecoded]
inputs' :: Aeson.Result [TextInputDecoded] = (Value -> Result TextInputDecoded)
-> [Value] -> 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)
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Value -> Result TextInputDecoded
forall (a :: OpticKind). FromJSON a => Value -> Result a
Aeson.fromJSON [Value]
textInputs

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

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

  TextInputDecoded
thisValue TextInputDecoded
-> Optic' A_Lens NoIx TextInputDecoded (Maybe Text) -> Maybe Text
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx 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 :: OpticKind).
 RandomGen g =>
 g -> (ViewComponent Text, g))
-> View Text
forall (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView ((forall (g :: OpticKind).
  RandomGen g =>
  g -> (ViewComponent Text, g))
 -> View Text)
-> (forall (g :: OpticKind).
    RandomGen g =>
    g -> (ViewComponent Text, g))
-> View Text
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall (g :: OpticKind) (a :: OpticKind).
(RandomGen g, Uniform a) =>
g -> (a, g)
uniform g
g
      comp :: Component
comp = TextInput -> Component
C.TextInput' (TextInput -> Component) -> TextInput -> Component
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 = ExtractResult (Maybe Text) -> ExtractResult Text
forall {a :: OpticKind}. ExtractResult (Maybe a) -> ExtractResult a
ensure (ExtractResult (Maybe Text) -> ExtractResult Text)
-> (Interaction -> ExtractResult (Maybe Text))
-> Interaction
-> ExtractResult Text
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 (Component
-> (Interaction -> ExtractResult Text) -> ViewComponent Text
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)) = ExtractOkType -> a -> ExtractResult a
forall (a :: OpticKind). ExtractOkType -> a -> ExtractResult a
ExtractOk ExtractOkType
v a
x
    ensure ExtractResult (Maybe a)
_ = ExtractResult 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 (g :: OpticKind).
 RandomGen g =>
 g -> (ViewComponent (Maybe Text), g))
-> View (Maybe Text)
forall (a :: OpticKind).
(forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g))
-> View a
SingView ((forall (g :: OpticKind).
  RandomGen g =>
  g -> (ViewComponent (Maybe Text), g))
 -> View (Maybe Text))
-> (forall (g :: OpticKind).
    RandomGen g =>
    g -> (ViewComponent (Maybe Text), g))
-> View (Maybe Text)
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ \g
g ->
  let (CustomID
cid, g
g') = g -> (CustomID, g)
forall (g :: OpticKind) (a :: OpticKind).
(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 :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. TextInput -> TextInput
f (TextInput -> Component) -> TextInput -> Component
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 (Component
-> (Interaction -> ExtractResult (Maybe Text))
-> ViewComponent (Maybe Text)
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 -> ((Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
forall (a :: OpticKind).
(Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
ViewInstance (ExtractResult a -> Interaction -> ExtractResult a
forall (a :: OpticKind) (b :: OpticKind). a -> b -> a
const (ExtractResult a -> Interaction -> ExtractResult a)
-> ExtractResult a -> Interaction -> ExtractResult a
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ ExtractOkType -> a -> ExtractResult a
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') = g -> (ViewComponent a, g)
forall (g :: OpticKind). RandomGen g => g -> (ViewComponent a, g)
f g
g
          i :: ViewInstance a
i = (Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
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]
$sel:rendered:ViewInstance :: forall (a :: OpticKind). ViewInstance a -> [Component]
rendered :: [Component]
rendered}, g
g') = g -> View a -> (ViewInstance a, 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') = g -> View (x -> a) -> (ViewInstance (x -> a), 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'') = g -> View x -> (ViewInstance x, 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 ExtractResult (x -> a) -> ExtractResult x -> ExtractResult a
forall (a :: OpticKind) (b :: OpticKind).
ExtractResult (a -> b) -> ExtractResult a -> ExtractResult b
forall (f :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Applicative f =>
f (a -> b) -> f a -> f b
<*> Interaction -> ExtractResult x
ib Interaction
i
       in ((Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
forall (a :: OpticKind).
(Interaction -> ExtractResult a) -> [Component] -> ViewInstance a
ViewInstance Interaction -> ExtractResult a
inv ([Component]
ra [Component] -> [Component] -> [Component]
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 <- Sem r (Either e Message)
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 ->
      Sem r (Either RestError ()) -> Sem r ()
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Functor f =>
f a -> f ()
void (Sem r (Either RestError ()) -> Sem r ())
-> (ChannelRequest () -> Sem r (Either RestError ()))
-> ChannelRequest ()
-> Sem r ()
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. ChannelRequest () -> Sem r (Either RestError ())
ChannelRequest ()
-> Sem r (Either RestError (Result (ChannelRequest ())))
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 (ChannelRequest () -> Sem r ()) -> ChannelRequest () -> Sem r ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ Message -> Message -> ChannelRequest ()
forall (c :: OpticKind) (m :: OpticKind).
(HasID Channel c, HasID Message m) =>
c -> m -> ChannelRequest ()
DeleteMessage Message
m Message
m
    Left e
_ -> () -> Sem r ()
forall (a :: OpticKind). a -> Sem r a
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]
$sel:rendered:ViewInstance :: forall (a :: OpticKind). ViewInstance a -> [Component]
rendered :: [Component]
rendered} <- (StdGen -> (ViewInstance inp, StdGen)) -> Sem r (ViewInstance inp)
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
(StdGen -> (a, StdGen)) -> m a
getStdRandom (StdGen -> View inp -> (ViewInstance inp, StdGen)
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
  sendResp
-> ViewInstance inp
-> (inp -> Sem (InteractionEff : ViewEff a inp sendResp : r) ())
-> Sem r a
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 = Sem (Resource : r) a -> Sem r a
forall (r :: EffectRow) (a :: OpticKind).
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 :: OpticKind) b. (a -> b) -> a -> b
$ do
  TQueue Interaction
eventIn <- IO (TQueue Interaction) -> Sem (Resource : r) (TQueue Interaction)
forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed IO (TQueue Interaction)
forall (a :: OpticKind). 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 :: OpticKind) (c :: OpticKind)
       (b :: OpticKind).
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 :: Effect) (r :: EffectRow) (a :: OpticKind).
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 :: 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 (IO () -> Sem r ()
forall (m :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
Member (Embed m) r =>
m a -> Sem r a
P.embed (IO () -> Sem r ())
-> (Interaction -> IO ()) -> Interaction -> Sem r ()
forall (b :: OpticKind) (c :: OpticKind) (a :: OpticKind).
(b -> c) -> (a -> b) -> a -> c
. TQueue Interaction -> Interaction -> IO ()
sender TQueue Interaction
eventIn))
    Sem r () -> Sem (Resource : r) ()
forall (e :: Effect) (r :: EffectRow) (a :: OpticKind).
Sem r a -> Sem (e : r) a
P.raise
    ( \Sem r ()
_ -> do
        Sem r a -> Sem (Resource : r) a
forall (e :: Effect) (r :: EffectRow) (a :: OpticKind).
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 :: OpticKind) 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 :: 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 (rInitial :: EffectRow) (x :: OpticKind).
 InteractionEff (Sem rInitial) x -> Sem r x)
-> Sem (InteractionEff : r) () -> Sem r ()
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 -> x -> Sem r x
forall (a :: OpticKind). a -> Sem r a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
Applicative f =>
a -> f a
pure x
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 (rInitial :: EffectRow) (x :: OpticKind).
 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 :: 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 -> ((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 :: OpticKind) (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify' (Lens
  (Maybe ret, ViewInstance inp, sendResp)
  (Maybe ret, ViewInstance inp, sendResp)
  (Maybe ret)
  (Maybe ret)
forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Field1 s t a b =>
Lens s t a b
_1 Lens
  (Maybe ret, ViewInstance inp, sendResp)
  (Maybe ret, ViewInstance inp, sendResp)
  (Maybe ret)
  (Maybe ret)
-> ret
-> (Maybe ret, ViewInstance inp, sendResp)
-> (Maybe ret, ViewInstance inp, sendResp)
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) 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 x))
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (f x)
forall (a :: OpticKind) (b :: OpticKind).
Sem
  (WithTactics
     (ViewEff ret inp sendResp)
     f
     (Sem rInitial)
     (State (Maybe ret, ViewInstance inp, sendResp) : r))
  a
-> (a
    -> Sem
         (WithTactics
            (ViewEff ret inp sendResp)
            f
            (Sem rInitial)
            (State (Maybe ret, ViewInstance inp, sendResp) : r))
         b)
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     b
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
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 x)
()
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     (f ())
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]
$sel:rendered:ViewInstance :: forall (a :: OpticKind). ViewInstance a -> [Component]
rendered :: [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 :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
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 :: OpticKind) b. (a -> b) -> a -> b
$ (StdGen -> (ViewInstance inp, StdGen)) -> IO (ViewInstance inp)
forall (m :: OpticKind -> OpticKind) (a :: OpticKind).
MonadIO m =>
(StdGen -> (a, StdGen)) -> m a
getStdRandom (StdGen -> View inp -> (ViewInstance inp, StdGen)
forall (g :: OpticKind) (a :: OpticKind).
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 :: OpticKind) (r :: EffectRow).
Member (State s) r =>
(s -> s) -> Sem r ()
P.modify' (Lens
  (Maybe ret, ViewInstance inp, sendResp)
  (Maybe ret, ViewInstance inp, sendResp)
  (ViewInstance inp)
  (ViewInstance inp)
forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
Field2 s t a b =>
Lens s t a b
_2 Lens
  (Maybe ret, ViewInstance inp, sendResp)
  (Maybe ret, ViewInstance inp, sendResp)
  (ViewInstance inp)
  (ViewInstance inp)
-> ViewInstance inp
-> (Maybe ret, ViewInstance inp, sendResp)
-> (Maybe ret, ViewInstance inp, sendResp)
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)
              Sem rInitial ()
-> Tactical
     (ViewEff ret inp sendResp)
     (Sem rInitial)
     (State (Maybe ret, ViewInstance inp, sendResp) : r)
     ()
forall (m :: OpticKind -> OpticKind) (a :: OpticKind) (e :: Effect)
       (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 :: OpticKind) 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 :: OpticKind) (a :: OpticKind) (r :: EffectRow).
Member (State s) r =>
(s -> a) -> Sem r a
P.gets ((Maybe ret, ViewInstance inp, sendResp)
-> Optic' A_Lens NoIx (Maybe ret, ViewInstance inp, sendResp) x
-> x
forall (k :: OpticKind) (s :: OpticKind) (is :: IxList)
       (a :: OpticKind).
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Maybe ret, ViewInstance inp, sendResp) x
forall (s :: OpticKind) (t :: OpticKind) (a :: OpticKind)
       (b :: OpticKind).
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 (a :: OpticKind) (b :: OpticKind).
Sem
  (WithTactics
     (ViewEff ret inp sendResp)
     f
     (Sem rInitial)
     (State (Maybe ret, ViewInstance inp, sendResp) : r))
  a
-> (a
    -> Sem
         (WithTactics
            (ViewEff ret inp sendResp)
            f
            (Sem rInitial)
            (State (Maybe ret, ViewInstance inp, sendResp) : r))
         b)
-> Sem
     (WithTactics
        (ViewEff ret inp sendResp)
        f
        (Sem rInitial)
        (State (Maybe ret, ViewInstance inp, sendResp) : r))
     b
forall (m :: OpticKind -> OpticKind) (a :: OpticKind)
       (b :: OpticKind).
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 :: 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 = (Maybe ret, ViewInstance inp, sendResp)
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ret
-> Sem r ret
forall (s :: OpticKind) (r :: EffectRow) (a :: OpticKind).
s -> Sem (State s : r) a -> Sem r a
P.evalState (Maybe ret
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
$sel:extract:ViewInstance :: forall (a :: OpticKind).
ViewInstance a -> Interaction -> ExtractResult a
extract :: Interaction -> ExtractResult inp
extract}, sendResp
_) <- Sem
  (State (Maybe ret, ViewInstance inp, sendResp) : r)
  (Maybe ret, ViewInstance inp, sendResp)
forall (s :: OpticKind) (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 (a :: OpticKind).
a -> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) a
forall (f :: OpticKind -> OpticKind) (a :: OpticKind).
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 :: OpticKind -> OpticKind) (r :: EffectRow)
       (a :: OpticKind).
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 :: OpticKind) b. (a -> b) -> a -> b
$ STM Interaction -> IO Interaction
forall (a :: OpticKind). STM a -> IO a
STM.atomically (TQueue Interaction -> STM Interaction
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 -> Sem (ViewEff ret inp sendResp : r) ()
-> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) ()
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 (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 :: OpticKind) 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 (a :: OpticKind).
a -> Sem (State (Maybe ret, ViewInstance inp, sendResp) : r) a
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 = STM () -> IO ()
forall (a :: OpticKind). STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall (a :: OpticKind) b. (a -> b) -> a -> b
$ TQueue Interaction -> Interaction -> STM ()
forall (a :: OpticKind). TQueue a -> a -> STM ()
STM.writeTQueue TQueue Interaction
eventIn Interaction
int