{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BlockArguments, LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE DataKinds, TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs -fno-warn-orphans #-}

module Control.Moffy.Samples.Followbox.Event (
	-- * Followbox Event
	SigF, ReactF, FollowboxEv,
	-- * Store and Load Jsons
	StoreJsons(..), pattern OccStoreJsons, LoadJsons, pattern OccLoadJsons,
	clearJsons, storeJsons, loadJsons,
	-- * Request Data
	-- ** Http Get
	HttpGet(..), pattern OccHttpGet, httpGet,
--	-- ** Calc Text Extents
--	CalcTextExtents(..), pattern OccCalcTextExtents, calcTextExtents,
	-- ** Get Time Zone
	GetTimeZone, pattern OccGetTimeZone, getTimeZone,
	-- * Browse
	Browse(..), pattern OccBrowse, browse,
	-- * Sleep
	BeginSleep(..), pattern OccBeginSleep, EndSleep, pattern OccEndSleep,
	beginSleep, checkBeginSleep, endSleep,
	-- * Raise Error
	RaiseError(..), pattern OccRaiseError, Error(..), ErrorResult(..),
	raiseError, checkTerminate ) where

import GHC.Generics (Generic)
import Control.DeepSeq

import Control.Moffy (Sig, React, Request(..), await)
import Control.Moffy.Event.ThreadId (GetThreadId)
import Control.Moffy.Event.Lock (LockEv)
import Control.Moffy.Samples.Event.Random (RandomEv)
import Control.Moffy.Samples.Event.Delete (DeleteEvent)
import Control.Moffy.Samples.Event.Mouse qualified as Mouse (Move, Down, Up)
import Control.Moffy.Samples.Event.CalcTextExtents
import Data.Type.Set (Set(Nil), Singleton, numbered, (:-), (:+:))
import Data.OneOrMore (Selectable(..))
import Data.Bool (bool)
import Data.Aeson (Object)
import Data.Time (UTCTime, TimeZone)
import Network.HTTP.Simple (Header)

import qualified Data.ByteString.Lazy as LBS

import Control.Moffy.Samples.Followbox.TypeSynonym (Uri, ErrorMessage)

import Control.Moffy.Samples.Event.Area

---------------------------------------------------------------------------

-- * STORE AND LOAD JSON OBJECT LIST
-- * REQUEST DATA
-- 	+ HTTP GET
--	+ CALC TEXT EXTENTS
--	+ TIME ZONE
-- * BROWSE
-- * SLEEP
-- * RAISE ERROR
-- * FOLLOWBOX EVENT TYPE

---------------------------------------------------------------------------
-- STORE AND LOAD JSON OBJECT LIST
---------------------------------------------------------------------------

newtype StoreJsons = StoreJsonsReq [Object] deriving Int -> StoreJsons -> ShowS
[StoreJsons] -> ShowS
StoreJsons -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreJsons] -> ShowS
$cshowList :: [StoreJsons] -> ShowS
show :: StoreJsons -> String
$cshow :: StoreJsons -> String
showsPrec :: Int -> StoreJsons -> ShowS
$cshowsPrec :: Int -> StoreJsons -> ShowS
Show
numbered [t| StoreJsons |]
instance Selectable StoreJsons where StoreJsons
l select :: StoreJsons -> StoreJsons -> StoreJsons
`select` StoreJsons
_r = StoreJsons
l
instance Request StoreJsons where
	data Occurred StoreJsons = OccStoreJsons [Object]

clearJsons :: React s (Singleton StoreJsons) ()
clearJsons :: forall s. React s (Singleton StoreJsons) ()
clearJsons = forall s. [Object] -> React s (Singleton StoreJsons) ()
storeJsons []

storeJsons :: [Object] -> React s (Singleton StoreJsons) ()
storeJsons :: forall s. [Object] -> React s (Singleton StoreJsons) ()
storeJsons [Object]
os = forall a. a -> a -> Bool -> a
bool (forall s. [Object] -> React s (Singleton StoreJsons) ()
storeJsons [Object]
os) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
	forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await ([Object] -> StoreJsons
StoreJsonsReq [Object]
os) \(OccStoreJsons [Object]
os') -> [Object]
os forall a. Eq a => a -> a -> Bool
== [Object]
os'

data LoadJsons = LoadJsonsReq deriving (Int -> LoadJsons -> ShowS
[LoadJsons] -> ShowS
LoadJsons -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadJsons] -> ShowS
$cshowList :: [LoadJsons] -> ShowS
show :: LoadJsons -> String
$cshow :: LoadJsons -> String
showsPrec :: Int -> LoadJsons -> ShowS
$cshowsPrec :: Int -> LoadJsons -> ShowS
Show, LoadJsons -> LoadJsons -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadJsons -> LoadJsons -> Bool
$c/= :: LoadJsons -> LoadJsons -> Bool
== :: LoadJsons -> LoadJsons -> Bool
$c== :: LoadJsons -> LoadJsons -> Bool
Eq, Eq LoadJsons
LoadJsons -> LoadJsons -> Bool
LoadJsons -> LoadJsons -> Ordering
LoadJsons -> LoadJsons -> LoadJsons
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LoadJsons -> LoadJsons -> LoadJsons
$cmin :: LoadJsons -> LoadJsons -> LoadJsons
max :: LoadJsons -> LoadJsons -> LoadJsons
$cmax :: LoadJsons -> LoadJsons -> LoadJsons
>= :: LoadJsons -> LoadJsons -> Bool
$c>= :: LoadJsons -> LoadJsons -> Bool
> :: LoadJsons -> LoadJsons -> Bool
$c> :: LoadJsons -> LoadJsons -> Bool
<= :: LoadJsons -> LoadJsons -> Bool
$c<= :: LoadJsons -> LoadJsons -> Bool
< :: LoadJsons -> LoadJsons -> Bool
$c< :: LoadJsons -> LoadJsons -> Bool
compare :: LoadJsons -> LoadJsons -> Ordering
$ccompare :: LoadJsons -> LoadJsons -> Ordering
Ord)
numbered [t| LoadJsons |]
instance Request LoadJsons where data Occurred LoadJsons = OccLoadJsons [Object]

loadJsons :: React s (Singleton LoadJsons) [Object]
loadJsons :: forall s. React s (Singleton LoadJsons) [Object]
loadJsons = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await LoadJsons
LoadJsonsReq \(OccLoadJsons [Object]
os) -> [Object]
os

---------------------------------------------------------------------------
-- REQUEST DATA
---------------------------------------------------------------------------

-- HTTP GET

newtype HttpGet = HttpGetReq Uri deriving (Int -> HttpGet -> ShowS
[HttpGet] -> ShowS
HttpGet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpGet] -> ShowS
$cshowList :: [HttpGet] -> ShowS
show :: HttpGet -> String
$cshow :: HttpGet -> String
showsPrec :: Int -> HttpGet -> ShowS
$cshowsPrec :: Int -> HttpGet -> ShowS
Show, HttpGet -> HttpGet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpGet -> HttpGet -> Bool
$c/= :: HttpGet -> HttpGet -> Bool
== :: HttpGet -> HttpGet -> Bool
$c== :: HttpGet -> HttpGet -> Bool
Eq, Eq HttpGet
HttpGet -> HttpGet -> Bool
HttpGet -> HttpGet -> Ordering
HttpGet -> HttpGet -> HttpGet
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HttpGet -> HttpGet -> HttpGet
$cmin :: HttpGet -> HttpGet -> HttpGet
max :: HttpGet -> HttpGet -> HttpGet
$cmax :: HttpGet -> HttpGet -> HttpGet
>= :: HttpGet -> HttpGet -> Bool
$c>= :: HttpGet -> HttpGet -> Bool
> :: HttpGet -> HttpGet -> Bool
$c> :: HttpGet -> HttpGet -> Bool
<= :: HttpGet -> HttpGet -> Bool
$c<= :: HttpGet -> HttpGet -> Bool
< :: HttpGet -> HttpGet -> Bool
$c< :: HttpGet -> HttpGet -> Bool
compare :: HttpGet -> HttpGet -> Ordering
$ccompare :: HttpGet -> HttpGet -> Ordering
Ord)
numbered [t| HttpGet |]
instance Request HttpGet where
	data Occurred HttpGet = OccHttpGet Uri [Header] LBS.ByteString

httpGet :: Uri -> React s (Singleton HttpGet) ([Header], LBS.ByteString)
httpGet :: forall s. Uri -> React s (Singleton HttpGet) ([Header], ByteString)
httpGet Uri
u = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall s. Uri -> React s (Singleton HttpGet) ([Header], ByteString)
httpGet Uri
u) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (Uri -> HttpGet
HttpGetReq Uri
u)
	\(OccHttpGet Uri
u' [Header]
hs ByteString
c) -> forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just ([Header]
hs, ByteString
c)) forall a b. (a -> b) -> a -> b
$ Uri
u forall a. Eq a => a -> a -> Bool
== Uri
u'

-- TIME ZONE

data GetTimeZone = GetTimeZoneReq deriving (Int -> GetTimeZone -> ShowS
[GetTimeZone] -> ShowS
GetTimeZone -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTimeZone] -> ShowS
$cshowList :: [GetTimeZone] -> ShowS
show :: GetTimeZone -> String
$cshow :: GetTimeZone -> String
showsPrec :: Int -> GetTimeZone -> ShowS
$cshowsPrec :: Int -> GetTimeZone -> ShowS
Show, GetTimeZone -> GetTimeZone -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTimeZone -> GetTimeZone -> Bool
$c/= :: GetTimeZone -> GetTimeZone -> Bool
== :: GetTimeZone -> GetTimeZone -> Bool
$c== :: GetTimeZone -> GetTimeZone -> Bool
Eq, Eq GetTimeZone
GetTimeZone -> GetTimeZone -> Bool
GetTimeZone -> GetTimeZone -> Ordering
GetTimeZone -> GetTimeZone -> GetTimeZone
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GetTimeZone -> GetTimeZone -> GetTimeZone
$cmin :: GetTimeZone -> GetTimeZone -> GetTimeZone
max :: GetTimeZone -> GetTimeZone -> GetTimeZone
$cmax :: GetTimeZone -> GetTimeZone -> GetTimeZone
>= :: GetTimeZone -> GetTimeZone -> Bool
$c>= :: GetTimeZone -> GetTimeZone -> Bool
> :: GetTimeZone -> GetTimeZone -> Bool
$c> :: GetTimeZone -> GetTimeZone -> Bool
<= :: GetTimeZone -> GetTimeZone -> Bool
$c<= :: GetTimeZone -> GetTimeZone -> Bool
< :: GetTimeZone -> GetTimeZone -> Bool
$c< :: GetTimeZone -> GetTimeZone -> Bool
compare :: GetTimeZone -> GetTimeZone -> Ordering
$ccompare :: GetTimeZone -> GetTimeZone -> Ordering
Ord)
numbered [t| GetTimeZone |]
instance Request GetTimeZone where
	data Occurred GetTimeZone = OccGetTimeZone TimeZone deriving Int -> Occurred GetTimeZone -> ShowS
[Occurred GetTimeZone] -> ShowS
Occurred GetTimeZone -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurred GetTimeZone] -> ShowS
$cshowList :: [Occurred GetTimeZone] -> ShowS
show :: Occurred GetTimeZone -> String
$cshow :: Occurred GetTimeZone -> String
showsPrec :: Int -> Occurred GetTimeZone -> ShowS
$cshowsPrec :: Int -> Occurred GetTimeZone -> ShowS
Show

getTimeZone :: React s (Singleton GetTimeZone) TimeZone
getTimeZone :: forall s. React s (Singleton GetTimeZone) TimeZone
getTimeZone = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await GetTimeZone
GetTimeZoneReq \(OccGetTimeZone TimeZone
tz) -> TimeZone
tz

---------------------------------------------------------------------------
-- BROWSE
---------------------------------------------------------------------------

newtype Browse = Browse Uri deriving (Int -> Browse -> ShowS
[Browse] -> ShowS
Browse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Browse] -> ShowS
$cshowList :: [Browse] -> ShowS
show :: Browse -> String
$cshow :: Browse -> String
showsPrec :: Int -> Browse -> ShowS
$cshowsPrec :: Int -> Browse -> ShowS
Show, Browse -> Browse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Browse -> Browse -> Bool
$c/= :: Browse -> Browse -> Bool
== :: Browse -> Browse -> Bool
$c== :: Browse -> Browse -> Bool
Eq, Eq Browse
Browse -> Browse -> Bool
Browse -> Browse -> Ordering
Browse -> Browse -> Browse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Browse -> Browse -> Browse
$cmin :: Browse -> Browse -> Browse
max :: Browse -> Browse -> Browse
$cmax :: Browse -> Browse -> Browse
>= :: Browse -> Browse -> Bool
$c>= :: Browse -> Browse -> Bool
> :: Browse -> Browse -> Bool
$c> :: Browse -> Browse -> Bool
<= :: Browse -> Browse -> Bool
$c<= :: Browse -> Browse -> Bool
< :: Browse -> Browse -> Bool
$c< :: Browse -> Browse -> Bool
compare :: Browse -> Browse -> Ordering
$ccompare :: Browse -> Browse -> Ordering
Ord)
numbered [t| Browse |]
instance Request Browse where data Occurred Browse = OccBrowse deriving Int -> Occurred Browse -> ShowS
[Occurred Browse] -> ShowS
Occurred Browse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurred Browse] -> ShowS
$cshowList :: [Occurred Browse] -> ShowS
show :: Occurred Browse -> String
$cshow :: Occurred Browse -> String
showsPrec :: Int -> Occurred Browse -> ShowS
$cshowsPrec :: Int -> Occurred Browse -> ShowS
Show

browse :: Uri -> React s (Singleton Browse) ()
browse :: forall s. Uri -> React s (Singleton Browse) ()
browse Uri
u = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (Uri -> Browse
Browse Uri
u) \Occurred Browse
R:OccurredBrowse
OccBrowse -> ()

---------------------------------------------------------------------------
-- SLEEP
---------------------------------------------------------------------------

data BeginSleep = BeginSleep UTCTime | CheckBeginSleep deriving (Int -> BeginSleep -> ShowS
[BeginSleep] -> ShowS
BeginSleep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BeginSleep] -> ShowS
$cshowList :: [BeginSleep] -> ShowS
show :: BeginSleep -> String
$cshow :: BeginSleep -> String
showsPrec :: Int -> BeginSleep -> ShowS
$cshowsPrec :: Int -> BeginSleep -> ShowS
Show, BeginSleep -> BeginSleep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeginSleep -> BeginSleep -> Bool
$c/= :: BeginSleep -> BeginSleep -> Bool
== :: BeginSleep -> BeginSleep -> Bool
$c== :: BeginSleep -> BeginSleep -> Bool
Eq, Eq BeginSleep
BeginSleep -> BeginSleep -> Bool
BeginSleep -> BeginSleep -> Ordering
BeginSleep -> BeginSleep -> BeginSleep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BeginSleep -> BeginSleep -> BeginSleep
$cmin :: BeginSleep -> BeginSleep -> BeginSleep
max :: BeginSleep -> BeginSleep -> BeginSleep
$cmax :: BeginSleep -> BeginSleep -> BeginSleep
>= :: BeginSleep -> BeginSleep -> Bool
$c>= :: BeginSleep -> BeginSleep -> Bool
> :: BeginSleep -> BeginSleep -> Bool
$c> :: BeginSleep -> BeginSleep -> Bool
<= :: BeginSleep -> BeginSleep -> Bool
$c<= :: BeginSleep -> BeginSleep -> Bool
< :: BeginSleep -> BeginSleep -> Bool
$c< :: BeginSleep -> BeginSleep -> Bool
compare :: BeginSleep -> BeginSleep -> Ordering
$ccompare :: BeginSleep -> BeginSleep -> Ordering
Ord)
numbered [t| BeginSleep |]
instance Request BeginSleep where
	data Occurred BeginSleep = OccBeginSleep UTCTime deriving Int -> Occurred BeginSleep -> ShowS
[Occurred BeginSleep] -> ShowS
Occurred BeginSleep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurred BeginSleep] -> ShowS
$cshowList :: [Occurred BeginSleep] -> ShowS
show :: Occurred BeginSleep -> String
$cshow :: Occurred BeginSleep -> String
showsPrec :: Int -> Occurred BeginSleep -> ShowS
$cshowsPrec :: Int -> Occurred BeginSleep -> ShowS
Show

beginSleep :: UTCTime -> React s (Singleton BeginSleep) ()
beginSleep :: forall s. UTCTime -> React s (Singleton BeginSleep) ()
beginSleep UTCTime
t = forall a. a -> a -> Bool -> a
bool (forall s. UTCTime -> React s (Singleton BeginSleep) ()
beginSleep UTCTime
t) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (UTCTime -> BeginSleep
BeginSleep UTCTime
t) \case
	OccBeginSleep UTCTime
t' | UTCTime
t forall a. Eq a => a -> a -> Bool
== UTCTime
t' -> Bool
True; Occurred BeginSleep
_ -> Bool
False

checkBeginSleep :: React s (Singleton BeginSleep) UTCTime
checkBeginSleep :: forall s. React s (Singleton BeginSleep) UTCTime
checkBeginSleep = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await BeginSleep
CheckBeginSleep \case OccBeginSleep UTCTime
t -> UTCTime
t

data EndSleep = EndSleepReq deriving (Int -> EndSleep -> ShowS
[EndSleep] -> ShowS
EndSleep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndSleep] -> ShowS
$cshowList :: [EndSleep] -> ShowS
show :: EndSleep -> String
$cshow :: EndSleep -> String
showsPrec :: Int -> EndSleep -> ShowS
$cshowsPrec :: Int -> EndSleep -> ShowS
Show, EndSleep -> EndSleep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndSleep -> EndSleep -> Bool
$c/= :: EndSleep -> EndSleep -> Bool
== :: EndSleep -> EndSleep -> Bool
$c== :: EndSleep -> EndSleep -> Bool
Eq, Eq EndSleep
EndSleep -> EndSleep -> Bool
EndSleep -> EndSleep -> Ordering
EndSleep -> EndSleep -> EndSleep
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EndSleep -> EndSleep -> EndSleep
$cmin :: EndSleep -> EndSleep -> EndSleep
max :: EndSleep -> EndSleep -> EndSleep
$cmax :: EndSleep -> EndSleep -> EndSleep
>= :: EndSleep -> EndSleep -> Bool
$c>= :: EndSleep -> EndSleep -> Bool
> :: EndSleep -> EndSleep -> Bool
$c> :: EndSleep -> EndSleep -> Bool
<= :: EndSleep -> EndSleep -> Bool
$c<= :: EndSleep -> EndSleep -> Bool
< :: EndSleep -> EndSleep -> Bool
$c< :: EndSleep -> EndSleep -> Bool
compare :: EndSleep -> EndSleep -> Ordering
$ccompare :: EndSleep -> EndSleep -> Ordering
Ord)
numbered [t| EndSleep |]
instance Request EndSleep where
	data Occurred EndSleep = OccEndSleep deriving Int -> Occurred EndSleep -> ShowS
[Occurred EndSleep] -> ShowS
Occurred EndSleep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Occurred EndSleep] -> ShowS
$cshowList :: [Occurred EndSleep] -> ShowS
show :: Occurred EndSleep -> String
$cshow :: Occurred EndSleep -> String
showsPrec :: Int -> Occurred EndSleep -> ShowS
$cshowsPrec :: Int -> Occurred EndSleep -> ShowS
Show

endSleep :: React s (Singleton EndSleep) ()
endSleep :: forall s. React s (Singleton EndSleep) ()
endSleep = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await EndSleep
EndSleepReq \Occurred EndSleep
R:OccurredEndSleep
OccEndSleep -> ()

---------------------------------------------------------------------------
-- RAISE ERROR
---------------------------------------------------------------------------

data Error
	= NoRateLimitRemaining | NoRateLimitReset
	| NotJson | EmptyJson | NoLoginName | NoAvatarAddress | NoAvatar
	| NoHtmlUrl | Trace | CatchError deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Eq Error
Error -> Error -> Bool
Error -> Error -> Ordering
Error -> Error -> Error
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Error -> Error -> Error
$cmin :: Error -> Error -> Error
max :: Error -> Error -> Error
$cmax :: Error -> Error -> Error
>= :: Error -> Error -> Bool
$c>= :: Error -> Error -> Bool
> :: Error -> Error -> Bool
$c> :: Error -> Error -> Bool
<= :: Error -> Error -> Bool
$c<= :: Error -> Error -> Bool
< :: Error -> Error -> Bool
$c< :: Error -> Error -> Bool
compare :: Error -> Error -> Ordering
$ccompare :: Error -> Error -> Ordering
Ord, forall x. Rep Error x -> Error
forall x. Error -> Rep Error x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Error x -> Error
$cfrom :: forall x. Error -> Rep Error x
Generic)

instance NFData Error

data ErrorResult = Continue | Terminate deriving Int -> ErrorResult -> ShowS
[ErrorResult] -> ShowS
ErrorResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorResult] -> ShowS
$cshowList :: [ErrorResult] -> ShowS
show :: ErrorResult -> String
$cshow :: ErrorResult -> String
showsPrec :: Int -> ErrorResult -> ShowS
$cshowsPrec :: Int -> ErrorResult -> ShowS
Show

data RaiseError = RaiseError Error ErrorMessage deriving (Int -> RaiseError -> ShowS
[RaiseError] -> ShowS
RaiseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RaiseError] -> ShowS
$cshowList :: [RaiseError] -> ShowS
show :: RaiseError -> String
$cshow :: RaiseError -> String
showsPrec :: Int -> RaiseError -> ShowS
$cshowsPrec :: Int -> RaiseError -> ShowS
Show, RaiseError -> RaiseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RaiseError -> RaiseError -> Bool
$c/= :: RaiseError -> RaiseError -> Bool
== :: RaiseError -> RaiseError -> Bool
$c== :: RaiseError -> RaiseError -> Bool
Eq, Eq RaiseError
RaiseError -> RaiseError -> Bool
RaiseError -> RaiseError -> Ordering
RaiseError -> RaiseError -> RaiseError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RaiseError -> RaiseError -> RaiseError
$cmin :: RaiseError -> RaiseError -> RaiseError
max :: RaiseError -> RaiseError -> RaiseError
$cmax :: RaiseError -> RaiseError -> RaiseError
>= :: RaiseError -> RaiseError -> Bool
$c>= :: RaiseError -> RaiseError -> Bool
> :: RaiseError -> RaiseError -> Bool
$c> :: RaiseError -> RaiseError -> Bool
<= :: RaiseError -> RaiseError -> Bool
$c<= :: RaiseError -> RaiseError -> Bool
< :: RaiseError -> RaiseError -> Bool
$c< :: RaiseError -> RaiseError -> Bool
compare :: RaiseError -> RaiseError -> Ordering
$ccompare :: RaiseError -> RaiseError -> Ordering
Ord)
numbered [t| RaiseError |]
instance Request RaiseError where
	data Occurred RaiseError = OccRaiseError Error ErrorResult

raiseError :: Error -> ErrorMessage -> React s (Singleton RaiseError) ()
raiseError :: forall s. Error -> String -> React s (Singleton RaiseError) ()
raiseError Error
e String
em = forall a. a -> a -> Bool -> a
bool (forall s. Error -> String -> React s (Singleton RaiseError) ()
raiseError Error
e String
em) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
	forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (Error -> String -> RaiseError
RaiseError Error
e String
em) \(OccRaiseError Error
e' ErrorResult
_er) -> Error
e forall a. Eq a => a -> a -> Bool
== Error
e'

catchError :: React s (Singleton RaiseError) ErrorResult
catchError :: forall s. React s (Singleton RaiseError) ErrorResult
catchError = forall e r s. e -> (Occurred e -> r) -> React s (Singleton e) r
await (Error -> String -> RaiseError
RaiseError Error
CatchError String
"") \(OccRaiseError Error
_ ErrorResult
er) -> ErrorResult
er

checkTerminate :: React s (Singleton RaiseError) ()
checkTerminate :: forall s. React s (Singleton RaiseError) ()
checkTerminate = forall s. React s (Singleton RaiseError) ErrorResult
catchError
	forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case ErrorResult
Continue -> forall s. React s (Singleton RaiseError) ()
checkTerminate; ErrorResult
Terminate -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

---------------------------------------------------------------------------
-- FOLLOWBOX EVENT TYPE
---------------------------------------------------------------------------

type SigF s = Sig s FollowboxEv
type ReactF s r = React s FollowboxEv r

type FollowboxEv = SetArea :- GetArea :-
	GetThreadId :- LockEv :+: RandomEv :+: DeleteEvent :- MouseEv :+:
	StoreJsons :- LoadJsons :- HttpGet :- CalcTextExtents :- GetTimeZone :-
	Browse :- BeginSleep :- EndSleep :- RaiseError :- 'Nil

type MouseEv = Mouse.Move :- Mouse.Down :- Mouse.Up :- 'Nil