{-# 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}
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)
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
data
=
|
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 a
=
ExtractOkType a
|
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
{
:: Interaction -> ExtractResult a
, forall (a :: OpticKind). ViewInstance a -> [Component]
rendered :: [C.Component]
}
data ViewEff ret inp sendResp m a where
EndView :: ret -> ViewEff ret inp sendResp m ()
ReplaceView :: View inp -> ([C.Component] -> m ()) -> ViewEff ret inp sendResp m ()
GetSendResponse :: ViewEff ret inp sendResp m sendResp
P.makeSem ''ViewEff
extractCustomID :: Interaction -> Maybe CustomID
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)
(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
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
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))
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')
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
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
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
textInput ::
C.TextInputStyle ->
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
textInput' ::
C.TextInputStyle ->
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')
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'')
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 ()
runView ::
BotC r =>
View inp ->
([C.Component] -> P.Sem r sendResp) ->
(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
runViewInstance ::
BotC r =>
sendResp ->
ViewInstance inp ->
(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 ()
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