{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase, TupleSections, OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PatternSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Control.Moffy.Samples.Followbox.Handle (
	-- * Handle
	HandleF, HandleF', handleFollowboxWith, GuiEv,
	-- * State
	FollowboxState(..), initialFollowboxState,
	) where

import Control.Moffy.Samples.Event.Delete
import Control.Moffy.Samples.Event.Mouse qualified as Mouse
import Control.Moffy.Samples.Event.CalcTextExtents (CalcTextExtents)
import Control.Moffy.Handle (
	Handle, Handle', HandleSt, HandleSt', HandleIo', liftHandle',
	retrySt, beforeSt, mergeSt )
import Control.Moffy.Handle.ThreadId (handleGetThreadId)
import Control.Moffy.Handle.Lock (LockState(..), LockId, handleLock)
import Control.Moffy.Samples.Handle.Random (RandomState(..), handleRandom)
import Data.Type.Set (Singleton, (:-), (:+:), pattern Nil)
import Data.OneOrMore as Oom (pattern Singleton)
import Data.Bool (bool)
import Data.List (delete)
import Data.String (fromString)
import Data.Aeson (Object)
import Data.Time (UTCTime, getCurrentTime, getCurrentTimeZone, diffUTCTime, DiffTime)
import System.Random (StdGen)
import System.Process (spawnProcess)

import qualified Data.Text as T
import qualified Network.HTTP.Simple as H

import Control.Moffy.Samples.Followbox.Event (
	FollowboxEv, StoreJsons(..), pattern OccStoreJsons,
	LoadJsons, pattern OccLoadJsons, HttpGet(..), pattern OccHttpGet,
	GetTimeZone, pattern OccGetTimeZone, Browse(..), pattern OccBrowse,
	BeginSleep(..), pattern OccBeginSleep, EndSleep, pattern OccEndSleep,
	RaiseError(..), pattern OccRaiseError, Error(..), ErrorResult(..) )
import Control.Moffy.Samples.Followbox.TypeSynonym (Browser, GithubNameToken)

import Data.OneOrMoreApp as Ooma

import Control.Concurrent.STM
import Control.Moffy.Samples.Handle.Area qualified as A
import Control.Moffy.Samples.Event.Area qualified as A
import Data.Map (Map)

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

-- * STATE
-- 	+ FOLLOWBOX STATE
-- 	+ PUT AND GET EACH STATE
-- * HANDLE
--	+ FOLLOWBOX
--	+ MOUSE
--	+ STORE AND LOAD JSONS
--	+ REQUEST DATA
--	+ BROWSE
--	+ BEGIN AND END SLEEP
--	+ RAISE ERROR
-- * HELPER FUNCTION

---------------------------------------------------------------------------
-- STATE
---------------------------------------------------------------------------

type GuiEv = DeleteEvent :- MouseEv

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

-- FOLLOWOBOX STATE

data FollowboxState = FollowboxState {
	FollowboxState -> Int
fsNextLockId :: Int, FollowboxState -> [LockId]
fsLockState :: [LockId], FollowboxState -> [Object]
fsObjects :: [Object],
	FollowboxState -> Maybe UTCTime
fsSleepUntil :: Maybe UTCTime, FollowboxState -> StdGen
fsRandomGen :: StdGen
	} deriving Int -> FollowboxState -> ShowS
[FollowboxState] -> ShowS
FollowboxState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FollowboxState] -> ShowS
$cshowList :: [FollowboxState] -> ShowS
show :: FollowboxState -> String
$cshow :: FollowboxState -> String
showsPrec :: Int -> FollowboxState -> ShowS
$cshowsPrec :: Int -> FollowboxState -> ShowS
Show

initialFollowboxState :: StdGen -> FollowboxState
initialFollowboxState :: StdGen -> FollowboxState
initialFollowboxState StdGen
g = FollowboxState {
	fsNextLockId :: Int
fsNextLockId = Int
0, fsLockState :: [LockId]
fsLockState = [], fsObjects :: [Object]
fsObjects = [],
	fsSleepUntil :: Maybe UTCTime
fsSleepUntil = forall a. Maybe a
Nothing, fsRandomGen :: StdGen
fsRandomGen = StdGen
g }

type HandleF m es = HandleSt FollowboxState m es
type HandleF' m es = HandleIo' FollowboxState FollowboxState m es

-- PUT AND GET EACH STATE

instance LockState FollowboxState where
	getNextLockId :: FollowboxState -> Int
getNextLockId = FollowboxState -> Int
fsNextLockId; putNextLockId :: FollowboxState -> Int -> FollowboxState
putNextLockId FollowboxState
s Int
l = FollowboxState
s { fsNextLockId :: Int
fsNextLockId = Int
l }
	isLocked :: FollowboxState -> LockId -> Bool
isLocked FollowboxState
s LockId
l = LockId
l forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FollowboxState -> [LockId]
fsLockState FollowboxState
s
	lockIt :: FollowboxState -> LockId -> FollowboxState
lockIt FollowboxState
s LockId
l = FollowboxState
s { fsLockState :: [LockId]
fsLockState = LockId
l forall a. a -> [a] -> [a]
: FollowboxState -> [LockId]
fsLockState FollowboxState
s }
	unlockIt :: FollowboxState -> LockId -> FollowboxState
unlockIt FollowboxState
s LockId
l = FollowboxState
s { fsLockState :: [LockId]
fsLockState = forall a. Eq a => a -> [a] -> [a]
delete LockId
l forall a b. (a -> b) -> a -> b
$ FollowboxState -> [LockId]
fsLockState FollowboxState
s }

instance RandomState FollowboxState where
	getRandomGen :: FollowboxState -> StdGen
getRandomGen = FollowboxState -> StdGen
fsRandomGen; putRandomGen :: FollowboxState -> StdGen -> FollowboxState
putRandomGen FollowboxState
s StdGen
g = FollowboxState
s { fsRandomGen :: StdGen
fsRandomGen = StdGen
g }

---------------------------------------------------------------------------
-- HANDLE
---------------------------------------------------------------------------

-- FOLLOWBOX

handleFollowboxWith ::
	(Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv)) ->
	f -> TVar (Map Int (A.Point, A.Point)) -> Browser -> Maybe GithubNameToken ->
	HandleF IO (GuiEv :+: FollowboxEv)
handleFollowboxWith :: forall f.
(Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv))
-> f
-> TVar (Map Int (Point, Point))
-> String
-> Maybe GithubNameToken
-> HandleF IO (GuiEv :+: FollowboxEv)
handleFollowboxWith Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv)
h f
f TVar (Map Int (Point, Point))
va String
brws Maybe GithubNameToken
mba = forall (m :: * -> *) st (es :: Set (*)).
Monad m =>
HandleSt' st m es -> HandleSt st m es
retrySt forall a b. (a -> b) -> a -> b
$
	forall (m :: * -> *) (es :: Set (*)) st.
Functor m =>
Handle' m es -> HandleSt' st m es
liftHandle' (TVar (Map Int (Point, Point))
-> Handle' IO (SetArea :- (GetArea ':~ 'Nil))
A.handle TVar (Map Int (Point, Point))
va) forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall (m :: * -> *) (es :: Set (*)) st.
Functor m =>
Handle' m es -> HandleSt' st m es
liftHandle' forall (m :: * -> *).
Applicative m =>
Handle' m (Singleton GetThreadId)
handleGetThreadId forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt` forall s (m :: * -> *).
(LockState s, Monad m) =>
HandleSt' s m LockEv
handleLock forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall s (m :: * -> *).
(RandomState s, Monad m) =>
HandleSt' s m RandomEv
handleRandom forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall (m :: * -> *). Monad m => HandleF' m (Singleton StoreJsons)
handleStoreJsons forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt` forall (m :: * -> *). Monad m => HandleF' m (Singleton LoadJsons)
handleLoadJsons forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall (f :: * -> *) (es :: Set (*)) st.
Functor f =>
Handle f es -> HandleSt' st f es
liftOnJust (Maybe GithubNameToken -> Handle IO (Singleton HttpGet)
handleHttpGet Maybe GithubNameToken
mba) forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall (f :: * -> *) (es :: Set (*)) st.
Functor f =>
Handle f es -> HandleSt' st f es
liftOnJust Handle IO (Singleton GetTimeZone)
handleGetTimeZone forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall (f :: * -> *) (es :: Set (*)) st.
Functor f =>
Handle f es -> HandleSt' st f es
liftOnJust (String -> Handle IO (Singleton Browse)
handleBrowse String
brws) forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall (m :: * -> *). Monad m => HandleF' m (Singleton BeginSleep)
handleBeginSleep forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt` HandleF' IO (EndSleep ':~ 'Nil)
handleEndSleep forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es'),
 MergeableOccurred es es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`mergeSt`
	forall (m :: * -> *) (es :: Set (*)) st.
Functor m =>
Handle' m es -> HandleSt' st m es
liftHandle' Handle' IO (Singleton RaiseError)
handleRaiseError forall (m :: * -> *) (es :: Set (*)) (es' :: Set (*)) st.
(Monad m, ExpandableHandle es (es :+: es'),
 ExpandableHandle es' (es :+: es')) =>
HandleSt' st m es
-> HandleSt' st m es' -> HandleSt' st m (es :+: es')
`beforeSt` forall f.
(Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv))
-> f -> HandleF' IO (CalcTextExtents :- GuiEv)
handleMouseWithSleep Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv)
h f
f

-- MOUSE

handleMouseWithSleep ::
	(Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv)) ->
	f -> HandleF' IO (CalcTextExtents :- GuiEv)
handleMouseWithSleep :: forall f.
(Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv))
-> f -> HandleF' IO (CalcTextExtents :- GuiEv)
handleMouseWithSleep Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv)
h f
f EvReqs (CalcTextExtents :- GuiEv)
rqs FollowboxState
s = (, FollowboxState
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case FollowboxState -> Maybe UTCTime
fsSleepUntil FollowboxState
s of
	Maybe UTCTime
Nothing -> Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv)
h forall a. Maybe a
Nothing f
f EvReqs (CalcTextExtents :- GuiEv)
rqs
	Just UTCTime
t -> IO UTCTime
getCurrentTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \UTCTime
now ->
		Maybe DiffTime -> f -> Handle' IO (CalcTextExtents :- GuiEv)
h (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ UTCTime
t UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
now) f
f EvReqs (CalcTextExtents :- GuiEv)
rqs

-- STORE AND LOAD JSONS

handleStoreJsons :: Monad m => HandleF' m (Singleton StoreJsons)
handleStoreJsons :: forall (m :: * -> *). Monad m => HandleF' m (Singleton StoreJsons)
handleStoreJsons (Oom.Singleton (StoreJsonsReq [Object]
os)) FollowboxState
s =
	forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall a b. (a -> b) -> a -> b
$ [Object] -> Occurred StoreJsons
OccStoreJsons [Object]
os, FollowboxState
s { fsObjects :: [Object]
fsObjects = [Object]
os })

handleLoadJsons :: Monad m => HandleF' m (Singleton LoadJsons)
handleLoadJsons :: forall (m :: * -> *). Monad m => HandleF' m (Singleton LoadJsons)
handleLoadJsons EvReqs (Singleton LoadJsons)
_rqs FollowboxState
s = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Object] -> Occurred LoadJsons
OccLoadJsons forall a b. (a -> b) -> a -> b
$ FollowboxState -> [Object]
fsObjects FollowboxState
s, FollowboxState
s)

-- REQUEST DATA

handleHttpGet :: Maybe GithubNameToken -> Handle IO (Singleton HttpGet)
handleHttpGet :: Maybe GithubNameToken -> Handle IO (Singleton HttpGet)
handleHttpGet Maybe GithubNameToken
mgnt (Oom.Singleton (HttpGetReq Uri
u)) = do
	Response ByteString
r <- forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
H.httpLBS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Request -> Request
H.setRequestBasicAuth) Maybe GithubNameToken
mgnt
		forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> [ByteString] -> Request -> Request
H.setRequestHeader HeaderName
"User-Agent" [ByteString
"Yoshio"]
		forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ Uri -> String
T.unpack Uri
u
	forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ forall a. HeaderName -> Response a -> [ByteString]
H.getResponseHeader HeaderName
"X-RateLimit-Remaining" Response ByteString
r
	forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton
		forall a b. (a -> b) -> a -> b
$ Uri -> [Header] -> ByteString -> Occurred HttpGet
OccHttpGet Uri
u (forall a. Response a -> [Header]
H.getResponseHeaders Response ByteString
r) (forall a. Response a -> a
H.getResponseBody Response ByteString
r)

handleGetTimeZone :: Handle IO (Singleton GetTimeZone)
handleGetTimeZone :: Handle IO (Singleton GetTimeZone)
handleGetTimeZone EvReqs (Singleton GetTimeZone)
_reqs = forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> Occurred GetTimeZone
OccGetTimeZone forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO TimeZone
getCurrentTimeZone

-- BROWSE

handleBrowse :: Browser -> Handle IO (Singleton Browse)
handleBrowse :: String -> Handle IO (Singleton Browse)
handleBrowse String
brws (Oom.Singleton (Browse Uri
u)) =
	forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton Occurred Browse
OccBrowse forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> [String] -> IO ProcessHandle
spawnProcess String
brws [Uri -> String
T.unpack Uri
u]

-- BEGIN AND END SLEEP

handleBeginSleep :: Monad m => HandleF' m (Singleton BeginSleep)
handleBeginSleep :: forall (m :: * -> *). Monad m => HandleF' m (Singleton BeginSleep)
handleBeginSleep (Oom.Singleton BeginSleep
bs) FollowboxState
s = case BeginSleep
bs of
	BeginSleep UTCTime
t -> case FollowboxState -> Maybe UTCTime
fsSleepUntil FollowboxState
s of
		Just UTCTime
t' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall a b. (a -> b) -> a -> b
$ UTCTime -> Occurred BeginSleep
OccBeginSleep UTCTime
t', FollowboxState
s)
		Maybe UTCTime
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (
			forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall a b. (a -> b) -> a -> b
$ UTCTime -> Occurred BeginSleep
OccBeginSleep UTCTime
t,
			FollowboxState
s { fsSleepUntil :: Maybe UTCTime
fsSleepUntil = forall a. a -> Maybe a
Just UTCTime
t } )
	BeginSleep
CheckBeginSleep -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, FollowboxState
s)

handleEndSleep :: HandleF' IO (Singleton EndSleep)
handleEndSleep :: HandleF' IO (EndSleep ':~ 'Nil)
handleEndSleep EvReqs (EndSleep ':~ 'Nil)
_rqs FollowboxState
s = case FollowboxState -> Maybe UTCTime
fsSleepUntil FollowboxState
s of
	Just UTCTime
t -> IO UTCTime
getCurrentTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> a -> Bool -> a
bool
		(forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Maybe a
Nothing, FollowboxState
s))
		(forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton Occurred EndSleep
OccEndSleep,
			FollowboxState
s { fsSleepUntil :: Maybe UTCTime
fsSleepUntil = forall a. Maybe a
Nothing })) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime
t forall a. Ord a => a -> a -> Bool
<=)
	Maybe UTCTime
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton Occurred EndSleep
OccEndSleep, FollowboxState
s)

-- RAISE ERROR

handleRaiseError :: Handle' IO (Singleton RaiseError)
handleRaiseError :: Handle' IO (Singleton RaiseError)
handleRaiseError (Oom.Singleton (RaiseError Error
e String
em)) = case Error -> Maybe ErrorResult
er Error
e of
	Maybe ErrorResult
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
	Just ErrorResult
r -> forall a. a -> Maybe a
Just (forall a (f :: * -> *). a -> OneOrMoreApp ('SetApp f (Singleton a))
Ooma.Singleton forall a b. (a -> b) -> a -> b
$ Error -> ErrorResult -> Occurred RaiseError
OccRaiseError Error
e ErrorResult
r) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> IO ()
putStrLn String
emsg
	where
	emsg :: String
emsg = String
"ERROR: " forall a. Semigroup a => a -> a -> a
<> String
em
	er :: Error -> Maybe ErrorResult
er = \case
		Error
NoRateLimitRemaining -> forall a. a -> Maybe a
Just ErrorResult
Terminate
		Error
NoRateLimitReset -> forall a. a -> Maybe a
Just ErrorResult
Terminate
		Error
NotJson -> forall a. a -> Maybe a
Just ErrorResult
Terminate
		Error
EmptyJson -> forall a. a -> Maybe a
Just ErrorResult
Continue
		Error
NoLoginName -> forall a. a -> Maybe a
Just ErrorResult
Terminate
		Error
NoAvatarAddress -> forall a. a -> Maybe a
Just ErrorResult
Terminate
		Error
NoAvatar -> forall a. a -> Maybe a
Just ErrorResult
Terminate
		Error
NoHtmlUrl -> forall a. a -> Maybe a
Just ErrorResult
Terminate
		Error
Trace -> forall a. a -> Maybe a
Just ErrorResult
Continue
		Error
CatchError -> forall a. Maybe a
Nothing

---------------------------------------------------------------------------
-- HELPER FUNCTION
---------------------------------------------------------------------------

liftOnJust :: Functor f => Handle f es -> HandleSt' st f es
liftOnJust :: forall (f :: * -> *) (es :: Set (*)) st.
Functor f =>
Handle f es -> HandleSt' st f es
liftOnJust = forall (m :: * -> *) (es :: Set (*)) st.
Functor m =>
Handle' m es -> HandleSt' st m es
liftHandle' forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)