packages feed

moffy-samples 0.1.0.1 → 0.1.0.2

raw patch · 3 files changed

+602/−1 lines, 3 filesdep +hashable

Dependencies added: hashable

Files

moffy-samples.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           moffy-samples-version:        0.1.0.1+version:        0.1.0.2 synopsis:       Samples of moffy description:    Please see the README on GitHub at <https://github.com/YoshikuniJujo/moffy-samples#readme> category:       Control@@ -29,6 +29,8 @@   exposed-modules:       Control.Moffy.Samples.Boxes       Control.Moffy.Samples.Followbox+      Control.Moffy.Samples.FollowboxAnother+      Control.Moffy.Samples.FollowboxOrigin   other-modules:       Paths_moffy_samples   autogen-modules:@@ -42,6 +44,7 @@     , base >=4.7 && <5     , bytestring     , extra-data-yj+    , hashable     , moffy     , moffy-samples-events     , text@@ -68,6 +71,7 @@     , base >=4.7 && <5     , bytestring     , extra-data-yj+    , hashable     , moffy     , moffy-samples     , moffy-samples-events
+ src/Control/Moffy/Samples/FollowboxAnother.hs view
@@ -0,0 +1,319 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections, OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Moffy.Samples.FollowboxAnother (+	-- * followbox+	followbox ) where++import Prelude hiding (break, until, repeat, scanl)++import Control.Arrow ((>>>), second, (***), (&&&))+import Control.Monad (void, forever, (<=<))+import Control.Moffy (React, adjust, adjustSig, emit, waitFor, first, break, until, indexBy, find, repeat, scanl)+import Control.Moffy.Event.Lock (LockId, newLockId, withLock)+import Control.Moffy.Samples.Event.Random (getRandomR)+import Control.Moffy.Samples.Event.Delete (deleteEvent)+import Control.Moffy.Samples.Viewable.Basic (Position, Color(..))+import Control.Moffy.Samples.Followbox.Event (+	SigF, ReactF,+	clearJsons, storeJsons, loadJsons, httpGet, getTimeZone,+	browse, beginSleep, checkBeginSleep, endSleep,+	Error(..), raiseError, checkTerminate )+import Control.Moffy.Samples.Followbox.Clickable (+	Clickable, view, click, clickable, clickableText,+	WithTextExtents, withTextExtents, nextToText, translate,+	FontName, FontSize )+import Control.Moffy.Samples.Followbox.ViewType (+	View(..), View1, white, Png(..), VText(..), Line(..), Image(..) )+import Control.Moffy.Samples.Followbox.TypeSynonym (ErrorMessage, Uri)+import Data.Type.Set+import Data.Type.Flip ((<$%>), (<*%>), ftraverse)+import Data.OneOfThem+import Data.Or (Or(..))+import Data.HashMap.Strict qualified as HM+import Data.Bool+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BSC+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import Data.Time (utcToLocalTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Aeson (Object, Value(..), eitherDecode)+import Data.Aeson.KeyMap (toHashMap)+import Text.Read (readMaybe)+import Codec.Picture qualified as P++import Data.Hashable+import Data.String++import Control.Moffy.Samples.Event.Mouse qualified as Mouse+import Control.Moffy.Samples.Event.Area++import Debug.Trace++---------------------------------------------------------------------------++-- * PARAMETER LIST+-- 	+ NUMBER OF USER TO DISPLAY+-- 	+ MAX NUMBER OF GITHUB USER+-- 	+ BACKGROUND+-- 	+ FONT+-- 	+ AVATAR, NAME AND CROSS+-- * SIG AND REACT+--	+ FOLLOWBOX+--	+ USERS+--	+ GET USER+--	+ GET OBJECT++---------------------------------------------------------------------------+-- PARAMETER LIST+---------------------------------------------------------------------------++-- NUMBER OF USER TO DISPLAY++numOfUsers :: Integer+numOfUsers = 3++-- MAX NUMBER OF GITHUB USER++userPageMax :: Int+userPageMax = 2 ^ (27 :: Int)++-- BACKGROUND++titlePos, nextPos, refreshPos, resetTimePos :: Position+titlePos = (50, 44); nextPos = (500, 44)+refreshPos = (600, 44); resetTimePos = (100, 470)++-- FONT++defaultFont :: FontName+defaultFont = "sans"++middleSize, largeSize :: FontSize+middleSize = 30; largeSize = 36++-- AVATAR, NAME AND CROSS++avatarSizeX, avatarSizeY :: Double+(avatarSizeX, avatarSizeY) = (80, 80)++avatarPos, namePos :: Double -> Position+avatarPos n = (100, 120 + 120 * n)+namePos n = (210, 150 + 120 * n)++crossSize :: Double+crossSize = largeSize / 2++crossPos :: Position -> WithTextExtents -> Position+crossPos p wte = translate (nextToText p wte) wte (1 / 2, 3 / 8)++crossMergin :: Double+crossMergin = 4++---------------------------------------------------------------------------+-- SIG AND REACT+---------------------------------------------------------------------------++-- FOLLOWBOX++followbox :: SigF s AreaView ()+followbox = () <$+	fieldWithResetTime numOfUsers `break` deleteEvent `break` checkTerminate++type AreaView = ([(Int, Maybe (Point, Point))], View)++fieldWithResetTime :: Integer -> SigF s AreaView ()+fieldWithResetTime n = (<>) <$%> field' n <*%> (([] ,) <$%> resetTime)++field' :: Integer -> SigF s AreaView ()+field' n = do+	(nxt, rfs) <- waitFor+		$ (,) <$> link nextPos "Next" <*> link refreshPos "Refresh"+	let	frame = View [title] <> view nxt <> view rfs+--	let	frame = View [title] <> view nxt <> view rfs <> View [expand $ Singleton $ Line' (Color 255 0 0) 30 (30, 30) (100, 100)]+--	let	frame = View [title] <> view nxt <> view rfs <> bar 25+--		clear = emit ([(0, Nothing), (0, Nothing), (0, Nothing)], frame)+		clear = emit ([], frame)+		refresh = forever do+			emit Nothing+			us <- Just . Left <$%> getUsers'+			emit . Just $ Right us+			waitFor . adjust $ click rfs+		clickCrosses lck i = forever do+--			emit =<< waitFor (adjust $ getRandomR (0, 99))+			emit =<< waitFor (withLock lck (adjust $ getRandomR (0, 29) :: ReactF s Int))+--			waitFor $ clickArea ((0, 0 + i * 150), (100, 100 + i * 150))+			waitFor $ (clickArea =<< adjust (getArea i)) `first` click rfs+	lck <- waitFor $ adjust newLockId+	(clear >>) $ second (frame <>) <$%> ((\a b c -> a <> b <> c)+		<$%> (chooseUser 0 <$%> refresh <*%> clickCrosses lck 0)+		<*%> (chooseUser 1 <$%> refresh <*%> clickCrosses lck 1)+		<*%> (chooseUser 2 <$%> refresh <*%> clickCrosses lck 2))+	where+	title = twhite largeSize titlePos "Who to follow"+	link p t = clickableText p+		<$> adjust (withTextExtents defaultFont middleSize t)++bar :: Double -> View+bar p = View [expand . Singleton $ Line' (Color 30 215 10) 50 (80, 300) (80 + p * 25, 300)]++resetTime :: SigF s View ()+resetTime = forever $ emit (View []) >> do+	emit =<< waitFor do+		(t, tz) <- (,) <$> adjust checkBeginSleep <*> adjust getTimeZone+		pure $ View [twhite middleSize resetTimePos . T.pack+			$ "Wait until " <> show (utcToLocalTime tz t)]+	waitFor $ adjust endSleep++twhite :: FontSize -> Position -> T.Text -> View1+twhite fs p = expand . Singleton . Text' white defaultFont fs p++chooseUser :: Integer -> Maybe (Either Int [(Png, T.Text, WithTextExtents)]) -> Int -> AreaView+chooseUser _ (Just (Left i)) _ = ([], bar $ fromIntegral i)+chooseUser (fromIntegral &&& fromIntegral -> (n, n')) (Just (Right us)) i =+	mkUser' n n' (us !! i)+chooseUser (fromIntegral &&& fromIntegral -> (n, n')) Nothing i = -- ([], View [])+	([(n, Nothing)], View [])++-- USERS++mkUser' :: Int -> Double -> (Png, Uri, WithTextExtents) -> AreaView+mkUser' n n' (avt, _uri, wte) =+	let	ap = avatarPos n'; np = namePos n'+		lnk = clickableText np wte; cr = cross $ crossPos np wte+		ara = crossArea $ crossPos np wte+		aview = ([(n, Just ara)], View [expand . Singleton $ Image' ap avt] <> view lnk <> view cr) in+	aview++mkUser :: Int -> Double -> Png -> Uri -> WithTextExtents -> (AreaView, SigF s AreaView())+mkUser n n' avt uri wte =+	let	ap = avatarPos n'; np = namePos n'+		lnk = clickableText np wte; cr = cross $ crossPos np wte+		ara = crossArea $ crossPos np wte+		lsn = waitFor $ listenForUserPage lnk uri+		aview = ([(n, Just ara)], View [expand . Singleton $ Image' ap avt] <> view lnk <> view cr) in+	(aview, lsn)++clickCross :: Int -> ReactF s Int+clickCross i = do+	clickArea =<< adjust (getArea i)+	adjust $ getRandomR (0, 99)++clickArea :: (Point, Point) -> ReactF s ()+clickArea ((l, u), (r, d)) = (() <$)+	. adjust $ find isd $ fst <$%> repeat Mouse.move `indexBy` repeat leftClick+	where isd (x, y) = l <= x && x <= r && u <= y && y <= d++clickOn :: Mouse.Button -> React s (Singleton Mouse.Down) ()+clickOn b0 = do+	b <- Mouse.down+	bool (clickOn b0) (pure ()) (b == b0)++leftClick :: React s (Singleton Mouse.Down) ()+leftClick = clickOn Mouse.ButtonPrimary++listenForUserPage :: Clickable s -> Uri -> ReactF s ()+listenForUserPage nm u = forever $ adjust (click nm) >> adjust (browse u)++crossArea :: Position -> (Position, Position)+crossArea (l, t) = ((l', t'), (r', b'))+	where+	(lt, lb, rt, rb) = ((l, t), (l, b), (r, t), (r, b))+	(r, b) = (l + crossSize, t + crossSize)+	(l', t') = (l - crossMergin, t - crossMergin)+	(r', b') = (r + crossMergin, b + crossMergin)++cross :: Position -> Clickable s+cross (l, t) = clickable (View [lwhite lt rb, lwhite lb rt]) (l', t') (r', b')+	where+	(lt, lb, rt, rb) = ((l, t), (l, b), (r, t), (r, b))+	(r, b) = (l + crossSize, t + crossSize)+	(l', t') = (l - crossMergin, t - crossMergin)+	(r', b') = (r + crossMergin, b + crossMergin)+	lwhite p q = expand . Singleton $ Line' white 4 p q++-- GET USER++getUsers' :: SigF s Int [(Png, T.Text, WithTextExtents)]+getUsers' = mapM (waitFor . userTextExtents) =<< getUsers++userTextExtents ::+	(Png, T.Text, T.Text) -> ReactF s (Png, T.Text, WithTextExtents)+userTextExtents (avt, nm, uri) = do+	wte <- adjust $ withTextExtents defaultFont largeSize nm+	pure (avt, uri, wte)++getUsers :: SigF s Int [(Png, T.Text, T.Text)]+getUsers = waitFor (sequence . map (ex3 . toHashMap) <$> getObjs') >>= err `either` \aunmurls -> do+	let	(aus, nms, urls) = unzip3 aunmurls+	sequence <$> (scanl (+) 0 $ mapM getAvatarPng aus) >>= either err (pure . uncurry3 zip3 . (, nms, urls))+	where+	err e = waitFor (adjust (uncurry raiseError e)) >> getUsers++uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d+uncurry3 f (x, y, z) = f x y z++ex3 :: (Hashable k, IsString k, IsString b) =>+	HM.HashMap k Value -> Either (Error, b) (T.Text, T.Text, T.Text)+ex3 o = (,,)+	<$> ex "avatar_url" (NoAvatarAddress, "No Avatar Address")+	<*> ex "login" (NoLoginName, "No Login Name")+	<*> ex "html_url" (NoHtmlUrl, "No HTML URL")+	where+	ex k e = case HM.lookup k o of Just (String v) -> Right v; _ -> Left e++getAvatarPng :: T.Text -> SigF s Int (Either (Error, ErrorMessage) Png)+getAvatarPng url = do+	emit 1+	r <- waitFor $ (<$> adjust (httpGet url))+		$ snd >>> LBS.toStrict >>> convert >>> either+			(Left . (NoAvatar ,))+			(Right . Png avatarSizeX avatarSizeY)+--	pure $!! r+	pure r++convert :: BS.ByteString -> Either String BS.ByteString+convert img = LBS.toStrict . P.encodePng . P.convertRGB8 <$> P.decodeImage img++-- GET OBJECT++getObj1 :: LockId -> ReactF s Object+getObj1 lck = withLock lck $ adjust loadJsons >>= \case+	[] -> getObj1FromWeb+	o : os -> o <$ adjust (storeJsons os)++getObj1FromWeb :: ReactF s Object+getObj1FromWeb = getObjs >>= \case+	Right (o : os) -> o <$ adjust (storeJsons os)+	Right [] -> adjust (raiseError EmptyJson "Empty JSON") >> getObj1FromWeb+	Left em -> adjust (raiseError NotJson em) >> getObj1FromWeb++getObjs' :: ReactF s [Object]+getObjs' = getObjs >>= \case+	Right [] -> adjust (raiseError EmptyJson "Empty JSON") >> getObjs'+	Right os -> pure os+	Left em -> adjust (raiseError NotJson em) >> getObjs'++getObjs :: ReactF s (Either String [Object])+getObjs = do+	n <- adjust $ getRandomR (0, userPageMax)+	(hdr, bdy) <- trace (show n) . adjust . httpGet $ api n+	case (rmng hdr, rst hdr) of+		(Just rmn, _) | rmn > (0 :: Int) -> pure $ eitherDecode bdy+		(Just _, Just t) ->+			adjust (beginSleep t) >> adjust endSleep >> getObjs+		(Just _, Nothing) -> adjust (uncurry raiseError rstE) >> getObjs+		(Nothing, _) -> adjust (uncurry raiseError rmngE) >> getObjs+	where+	api = ("https://api.github.com/users?since=" <>) . T.pack . show @Int+	rmng = (read . BSC.unpack <$>) . lookup "X-RateLimit-Remaining"+	rst = posixSeconds <=< lookup "X-RateLimit-Reset"+	rmngE = (NoRateLimitRemaining, "No X-RateLimit-Remaining header")+	rstE = (NoRateLimitReset, "No X-RateLimit-Reset header")+	posixSeconds = (posixSecondsToUTCTime . fromInteger <$>)+		. readMaybe . BSC.unpack
+ src/Control/Moffy/Samples/FollowboxOrigin.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE BlockArguments, LambdaCase, TupleSections, OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}++module Control.Moffy.Samples.FollowboxOrigin (+	-- * followbox+	followbox ) where++import Prelude hiding (break, repeat, scanl)++import Control.Arrow ((>>>))+import Control.Monad (void, forever, (<=<))+import Control.Moffy (React, adjust, emit, waitFor, break, indexBy, find, repeat, scanl)+import Control.Moffy.Event.Lock (newLockId, withLock)+import Control.Moffy.Samples.Event.Random (getRandomR)+import Control.Moffy.Samples.Event.Delete (deleteEvent)+import Control.Moffy.Samples.Viewable.Basic (Position, Color(..), LineWidth)+import Control.Moffy.Samples.Followbox.Event (+	SigF, ReactF,+	httpGet, getTimeZone, beginSleep, checkBeginSleep, endSleep,+	Error(..), raiseError, checkTerminate )+import Control.Moffy.Samples.Followbox.Clickable (+	view, click, clickableText, withTextExtents, FontName, FontSize )+import Control.Moffy.Samples.Followbox.ViewType (+	View(..), white, Png(..), VText(..), Line(..), Image(..) )+import Control.Moffy.Samples.Followbox.TypeSynonym (ErrorMessage)+import Data.Type.Set+import Data.Type.Flip ((<$%>), (<*%>))+import Data.OneOfThem+import Data.HashMap.Strict qualified as HM+import Data.Hashable+import Data.Bool+import Data.ByteString.Char8 qualified as BSC+import Data.ByteString.Lazy qualified as LBS+import Data.Text qualified as T+import Data.Time (utcToLocalTime, UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Aeson (Object, Value(..), eitherDecode)+import Data.Aeson.KeyMap (toHashMap)+import Text.Read (readMaybe)+import Codec.Picture qualified as P++import Control.Moffy.Samples.Event.Mouse qualified as Mouse+import Control.Moffy.Samples.Event.Area++---------------------------------------------------------------------------++-- * PARAMETER LIST+-- 	+ MAX NUMBER OF GITHUB USER+-- 	+ BACKGROUND+-- 	+ FONT+-- 	+ AVATAR, NAME AND CROSS+-- 	+ COLORS+-- * SIG AND REACT+--	+ FOLLOWBOX+--	+ USER VIEW+--	+ GET USERS+--	+ GET OBJECT+-- * MOUSE EVENTS+-- * VIEWS+-- * ERRORS++---------------------------------------------------------------------------+-- PARAMETER LIST+---------------------------------------------------------------------------++-- MAX NUMBER OF GITHUB USER++userPageMax :: Int+userPageMax = 2 ^ (27 :: Int)++-- BACKGROUND++titlePos, refreshPos, resetTimePos :: Position+titlePos = (50, 44); refreshPos = (600, 65)+resetTimePos = (100, 470)++-- FONT++defaultFont :: FontName+defaultFont = "sans"++middleSize, largeSize :: FontSize+middleSize = 30; largeSize = 40++-- AVATAR, NAME AND CROSS++avatarSizeX, avatarSizeY :: Double+(avatarSizeX, avatarSizeY) = (80, 80)++avatarPos, namePos :: Int -> Position+avatarPos n = (100, 120 + 120 * fromIntegral n)+namePos n = (210, 150 + 120 * fromIntegral n)++crossSize :: Double+crossSize = largeSize / 2++crossPos :: Int -> Position+crossPos n = (500, 162 + 120 * fromIntegral n)++crossMergin :: Double+crossMergin = 5++-- COLORS++barColor :: Color+barColor = Color 0x32 0xcd 0x32++nameColor :: Color+nameColor = Color 0x00 0xcd 0x00++---------------------------------------------------------------------------+-- SIG AND REACT+---------------------------------------------------------------------------++-- FOLLOWBOX++followbox :: SigF s View ()+followbox = void $ fieldWithResetTime `break` deleteEvent `break` checkTerminate++fieldWithResetTime :: SigF s View ()+fieldWithResetTime = (<>) <$%> field <*%> resetTime++field :: SigF s View ()+field = do+	rfs <- waitFor $ link refreshPos "Refresh"+	lck <- waitFor $ adjust newLockId+	let	frame = title <> view rfs+		refresh = forever do+			emit Nothing+			us <- Just . Left <$%> users+			emit . Just $ Right us+			waitFor . adjust $ click rfs+		close i = forever do+			emit =<< waitFor (withLock lck+				(adjust $ getRandomR (0, 29) :: ReactF s Int))+			waitFor . clickArea $ crossArea i+	emit frame+	(frame <>) <$%> ((\a b c -> a <> b <> c)+		<$%> (chooseUser 0 <$%> refresh <*%> close 0)+		<*%> (chooseUser 1 <$%> refresh <*%> close 1)+		<*%> (chooseUser 2 <$%> refresh <*%> close 2))+	where+	title = text white largeSize titlePos "Who to follow"+	link p t = clickableText p+		<$> adjust (withTextExtents defaultFont middleSize t)++chooseUser :: Int -> Maybe (Either Int [(Png, T.Text)]) -> Int -> View+chooseUser _ (Just (Left i)) _ = bar $ fromIntegral i+chooseUser n (Just (Right us)) i = userView n (us !! (i `mod` length us))+chooseUser _ Nothing _ = View []++resetTime :: SigF s View ()+resetTime = forever do+	emit $ View []+	emit =<< waitFor do+		(t, tz) <- (,) <$> adjust checkBeginSleep <*> adjust getTimeZone+		pure . text white middleSize resetTimePos . T.pack+			$ "Wait until " <> show (utcToLocalTime tz t)+	waitFor $ adjust endSleep++-- USER VIEW++userView :: Int -> (Png, T.Text) -> View+userView n (avt, nm) = image (avatarPos n) avt <> name n nm <> cross n++name :: Int -> T.Text -> View+name n nm = text nameColor largeSize (namePos n) nm++cross :: Int -> View+cross (crossPos -> (l, t)) = line white 4 lt rb <> line white 4 lb rt+	where+	(lt, lb, rt, rb) = ((l, t), (l, b), (r, t), (r, b))+	(r, b) = (l + crossSize, t + crossSize)++crossArea :: Int -> (Position, Position)+crossArea (crossPos -> (l, t)) = ((l', t'), (r', b'))+	where+	(r, b) = (l + crossSize, t + crossSize)+	(l', t') = (l - crossMergin, t - crossMergin)+	(r', b') = (r + crossMergin, b + crossMergin)++-- GET USERS++users :: SigF s Int [(Png, T.Text)]+users = waitFor (mapM ex2 <$> getObjs') >>= err \(unzip -> (avs, nms)) ->+	sequence <$> ssum (avatar `mapM` avs) >>= err (pure . flip zip nms)+	where+	ex2 (toHashMap -> o) = (,)+		<$> extract "avatar_url" o noAvatarAddress+		<*> extract "login" o noLoginName+	ssum = scanl (+) 0+	err = either \e -> waitFor (adjust (uncurry raiseError e)) >> users++extract :: Hashable k => k -> HM.HashMap k Value -> e -> Either e T.Text+extract k o e = case HM.lookup k o of Just (String v) -> Right v; _ -> Left e++avatar :: T.Text -> SigF s Int (Either (Error, ErrorMessage) Png)+avatar url = emit 1 >> waitFor (png . snd <$> adjust (httpGet url))++png :: LBS.ByteString -> Either (Error, String) Png+png = LBS.toStrict >>> convert >>>+	either (Left . (NoAvatar ,)) (Right . Png avatarSizeX avatarSizeY)+	where convert img =+		LBS.toStrict . P.encodePng . P.convertRGB8 <$> P.decodeImage img++bar :: Double -> View+bar p = line barColor 50 (80, 300) (80 + p * 25, 300)++-- GET OBJECT++getObjs' :: ReactF s [Object]+getObjs' = getObjs >>= \case+	Left em -> adjust (raiseError NotJson em) >> getObjs'+	Right [] -> adjust (raiseError EmptyJson "Empty JSON") >> getObjs'+	Right os -> pure os++getObjs :: ReactF s (Either String [Object])+getObjs = do+	n <- adjust $ getRandomR (0, userPageMax)+	(hdr, bdy) <- adjust . httpGet $ api n+	case (rmng hdr, rst hdr) of+		(Just rmn, _) | rmn > (0 :: Int) -> pure $ eitherDecode bdy+		(Just _, Just t) -> sleep t >> getObjs+		(Just _, Nothing) -> err noRateLimitReset >> getObjs+		(Nothing, _) -> err noRateLimitRemaining >> getObjs+	where+	api = ("https://api.github.com/users?since=" <>) . T.pack . show @Int+	rmng = (read . BSC.unpack <$>) . lookup "X-RateLimit-Remaining"+	rst = ut <=< lookup "X-RateLimit-Reset"+	ut = (posixSecondsToUTCTime . fromInteger <$>) . readMaybe . BSC.unpack+	err :: (Error, String) -> ReactF s ()+	err = adjust . uncurry raiseError++sleep :: UTCTime -> ReactF s ()+sleep t = adjust (beginSleep t) >> adjust endSleep++---------------------------------------------------------------------------+-- MOUSE EVENTS+---------------------------------------------------------------------------++clickArea :: (Point, Point) -> ReactF s ()+clickArea ((l, u), (r, d)) = void . adjust+	. find inside $ fst <$%> repeat Mouse.move `indexBy` repeat leftClick+	where inside (x, y) = l <= x && x <= r && u <= y && y <= d++leftClick :: React s (Singleton Mouse.Down) ()+leftClick = clickOn Mouse.ButtonPrimary++clickOn :: Mouse.Button -> React s (Singleton Mouse.Down) ()+clickOn b0 = bool (clickOn b0) (pure ()) . (== b0) =<< Mouse.down++---------------------------------------------------------------------------+-- VIEWS+---------------------------------------------------------------------------++text :: Color -> FontSize -> Position -> T.Text -> View+text c fs p = View . (: []) . expand . Singleton . Text' c defaultFont fs p++line :: Color -> LineWidth -> Position -> Position -> View+line c w p q = View . (: []) . expand . Singleton $ Line' c w p q++image :: Position -> Png -> View+image p = View . (: []) . expand . Singleton . Image' p++---------------------------------------------------------------------------+-- ERRORS+---------------------------------------------------------------------------++noRateLimitRemaining,+	noRateLimitReset, noAvatarAddress, noLoginName :: (Error, String)+noRateLimitRemaining = (NoRateLimitRemaining, "No X-RateLimit-Remaining header")+noRateLimitReset = (NoRateLimitReset, "No X-RateLimit-Reset header")+noAvatarAddress = (NoAvatarAddress, "No Avatar Address")+noLoginName = (NoLoginName, "No Login Name")