Skip to content

Commit 7d1713d

Browse files
reximrexim
authored
Merge pull request #795 from tsoding/794
(#794) Add global BTTV emotes support to !asciify
2 parents 9010307 + aa57ff1 commit 7d1713d

5 files changed

Lines changed: 119 additions & 79 deletions

File tree

‎HyperNerd.cabal‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,8 @@ executable HyperNerd
6060
-- Modules included in this executable, other than Main.
6161
other-modules: Bot
6262
, Bot.Alias
63-
, Bot.BttvFfz
63+
, Bot.Bttv
64+
, Bot.Ffz
6465
, Bot.CustomCommand
6566
, Bot.Dubtrack
6667
, Bot.Friday
@@ -210,7 +211,7 @@ test-suite HyperNerdTest
210211
, array
211212
, http-types
212213

213-
other-modules: Bot.BttvFfz
214+
other-modules: Bot.Bttv
214215
, Bot.Links
215216
, Bot.Replies
216217
, Bot.LinksTest

‎src/Bot.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,12 +11,13 @@ module Bot
1111

1212
import Bot.Alias
1313
import Bot.Asciify
14-
import Bot.BttvFfz
14+
import Bot.Bttv
1515
import Bot.Calc
1616
import Bot.CopyPasta
1717
import Bot.CustomCommand
1818
import Bot.DocLoc
1919
import Bot.Dubtrack
20+
import Bot.Ffz
2021
import Bot.Friday
2122
import Bot.Help
2223
import Bot.Links

‎src/Bot/Asciify.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,8 @@ module Bot.Asciify
66
( asciifyReaction
77
) where
88

9-
import Bot.BttvFfz
9+
import Bot.Bttv
10+
import Bot.Ffz
1011
import Bot.Replies
1112
import Control.Applicative
1213
import qualified Data.ByteString.Lazy as BSL

‎src/Bot/Bttv.hs‎

Lines changed: 108 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,108 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE UnicodeSyntax #-}
3+
{-# LANGUAGE FlexibleInstances #-}
4+
{-# LANGUAGE QuasiQuotes #-}
5+
{-# LANGUAGE TupleSections #-}
6+
7+
module Bot.Bttv
8+
( bttvCommand
9+
, updateBttvEmotesCommand
10+
, bttvUrlByName
11+
) where
12+
13+
import Bot.Replies
14+
import Control.Monad
15+
import Data.Aeson
16+
import Data.Aeson.Types
17+
import Data.List
18+
import qualified Data.Map as M
19+
import Data.Maybe
20+
import Data.Proxy
21+
import qualified Data.Text as T
22+
import Effect
23+
import Entity
24+
import HyperNerd.Comonad
25+
import qualified Network.URI.Encode as URI
26+
import Property
27+
import Reaction
28+
import Text.InterpolatedString.QM
29+
import Transport
30+
31+
data BttvEmote = BttvEmote
32+
{ bttvName :: T.Text
33+
, bttvLargestImageURL :: Maybe T.Text
34+
}
35+
36+
instance IsEntity BttvEmote where
37+
nameOfEntity _ = "BttvEmote"
38+
toProperties entity =
39+
M.fromList $
40+
catMaybes
41+
[ return ("name", PropertyText $ bttvName entity)
42+
, ("largestImageUrl", ) . PropertyText <$> bttvLargestImageURL entity
43+
]
44+
fromProperties properties =
45+
BttvEmote <$> extractProperty "name" properties <*>
46+
pure (extractProperty "largestImageUrl" properties)
47+
48+
newtype BttvRes = BttvRes
49+
{ bttvResEmotes :: [BttvEmote]
50+
}
51+
52+
instance FromJSON BttvRes where
53+
parseJSON (Object v) = BttvRes <$> v .: "emotes"
54+
parseJSON invalid = typeMismatch "BttvRes" invalid
55+
56+
instance FromJSON BttvEmote where
57+
parseJSON (Object v) = BttvEmote <$> code <*> url
58+
where
59+
code = v .: "code"
60+
url =
61+
((\id' -> "https://cdn.betterttv.net/emote/" <> id' <> "/3x") <$>) <$>
62+
(v .: "id")
63+
parseJSON invalid = typeMismatch "BttvEmote" invalid
64+
65+
bttvUrl :: T.Text -> String
66+
bttvUrl channel = [qms|https://api.betterttv.net/2/channels/{encodedChannel}|]
67+
where
68+
encodedChannel = URI.encode $ T.unpack channel
69+
70+
bttvCommand :: Reaction Message ()
71+
bttvCommand =
72+
liftR (const $ selectEntities Proxy All) $
73+
cmapR (T.concat . intersperse " " . map (bttvName . entityPayload)) sayMessage
74+
75+
bttvUrlByName :: T.Text -> Effect (Maybe String)
76+
bttvUrlByName name = do
77+
emote <-
78+
listToMaybe <$>
79+
selectEntities
80+
Proxy
81+
(Filter (PropertyEquals "name" (PropertyText name)) All)
82+
pure (T.unpack <$> (bttvLargestImageURL =<< (entityPayload <$> emote)))
83+
84+
cleanBttvCache :: Reaction Message a
85+
cleanBttvCache =
86+
Reaction $ \_ -> void $ deleteEntities (Proxy :: Proxy BttvEmote) All
87+
88+
updateBttvGlobalEmotes :: Reaction Message a
89+
updateBttvGlobalEmotes =
90+
cmapR (const "https://api.betterttv.net/2/emotes") $
91+
jsonHttpRequestReaction $
92+
liftR (traverse (createEntity Proxy) . bttvResEmotes) ignore
93+
94+
updateBttvLocalEmotes :: Reaction Message a
95+
updateBttvLocalEmotes =
96+
transR duplicate $
97+
cmapR (twitchChannelName . senderChannel . messageSender) $
98+
replyOnNothing "Only works in Twitch channels" $
99+
cmapR bttvUrl $
100+
jsonHttpRequestReaction $
101+
cmapR bttvResEmotes $ liftR (traverse $ createEntity Proxy) ignore
102+
103+
updateBttvEmotesCommand :: Reaction Message a
104+
updateBttvEmotesCommand = onlyForTwitch f
105+
where
106+
f =
107+
cleanBttvCache <> updateBttvGlobalEmotes <> updateBttvLocalEmotes <>
108+
Reaction (\msg -> replyMessage ("BTTV cache has been updated" <$ msg))

src/Bot/BttvFfz.hs renamed to src/Bot/Ffz.hs

Lines changed: 4 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -5,19 +5,15 @@
55
{-# LANGUAGE TupleSections #-}
66
{-# LANGUAGE LambdaCase #-}
77

8-
module Bot.BttvFfz
9-
( ffzCommand
10-
, bttvCommand
8+
module Bot.Ffz
9+
( ffzUrlByName
10+
, ffzCommand
1111
, updateFfzEmotesCommand
12-
, updateBttvEmotesCommand
13-
, ffzUrlByName
14-
, bttvUrlByName
1512
) where
1613

1714
import Bot.Replies
18-
import Control.Monad
19-
import Data.Aeson
2015
import Data.Aeson.Types
16+
import Data.Functor
2117
import qualified Data.HashMap.Strict as HM
2218
import Data.List
2319
import qualified Data.Map as M
@@ -51,40 +47,6 @@ instance IsEntity FfzEmote where
5147
FfzEmote <$> extractProperty "name" properties <*>
5248
pure (extractProperty "largestImageUrl" properties)
5349

54-
data BttvEmote = BttvEmote
55-
{ bttvName :: T.Text
56-
, bttvLargestImageURL :: Maybe T.Text
57-
}
58-
59-
instance IsEntity BttvEmote where
60-
nameOfEntity _ = "BttvEmote"
61-
toProperties entity =
62-
M.fromList $
63-
catMaybes
64-
[ return ("name", PropertyText $ bttvName entity)
65-
, ("largestImageUrl", ) . PropertyText <$> bttvLargestImageURL entity
66-
]
67-
fromProperties properties =
68-
BttvEmote <$> extractProperty "name" properties <*>
69-
pure (extractProperty "largestImageUrl" properties)
70-
71-
newtype BttvRes = BttvRes
72-
{ bttvResEmotes :: [BttvEmote]
73-
}
74-
75-
instance FromJSON BttvRes where
76-
parseJSON (Object v) = BttvRes <$> v .: "emotes"
77-
parseJSON invalid = typeMismatch "BttvRes" invalid
78-
79-
instance FromJSON BttvEmote where
80-
parseJSON (Object v) = BttvEmote <$> code <*> url
81-
where
82-
code = v .: "code"
83-
url =
84-
((\id' -> "https://cdn.betterttv.net/emote/" <> id' <> "/3x") <$>) <$>
85-
(v .: "id")
86-
parseJSON invalid = typeMismatch "BttvEmote" invalid
87-
8850
newtype FfzSet = FfzSet
8951
{ ffzSetEmotes :: [FfzEmote]
9052
}
@@ -132,35 +94,11 @@ ffzUrl channel = [qms|https://api.frankerfacez.com/v1/room/{encodedChannel}|]
13294
where
13395
encodedChannel = URI.encode $ T.unpack channel
13496

135-
bttvUrl :: T.Text -> String
136-
bttvUrl channel = [qms|https://api.betterttv.net/2/channels/{encodedChannel}|]
137-
where
138-
encodedChannel = URI.encode $ T.unpack channel
139-
14097
ffzCommand :: Reaction Message ()
14198
ffzCommand =
14299
liftR (const $ selectEntities Proxy All) $
143100
cmapR (T.concat . intersperse " " . map (ffzName . entityPayload)) sayMessage
144101

145-
bttvCommand :: Reaction Message ()
146-
bttvCommand =
147-
liftR (const $ selectEntities Proxy All) $
148-
cmapR (T.concat . intersperse " " . map (bttvName . entityPayload)) sayMessage
149-
150-
updateBttvEmotesCommand :: Reaction Message ()
151-
updateBttvEmotesCommand =
152-
transR duplicate $
153-
cmapR (twitchChannelName . senderChannel . messageSender) $
154-
replyOnNothing "Only works in Twitch channels" $
155-
cmapR bttvUrl $
156-
jsonHttpRequestReaction $
157-
cmapR bttvResEmotes $
158-
liftR
159-
(\emotes -> do
160-
void $ deleteEntities (Proxy :: Proxy BttvEmote) All
161-
traverse (createEntity Proxy) emotes) $
162-
cmapR (T.concat . intersperse " " . map (bttvName . entityPayload)) sayMessage
163-
164102
updateFfzGlobalEmotes :: Reaction Message a
165103
updateFfzGlobalEmotes =
166104
cmapR (const "https://api.frankerfacez.com/v1/set/global") $
@@ -200,12 +138,3 @@ ffzUrlByName name = do
200138
Proxy
201139
(Filter (PropertyEquals "name" (PropertyText name)) All)
202140
pure (T.unpack <$> (ffzLargestImageURL =<< (entityPayload <$> emote)))
203-
204-
bttvUrlByName :: T.Text -> Effect (Maybe String)
205-
bttvUrlByName name = do
206-
emote <-
207-
listToMaybe <$>
208-
selectEntities
209-
Proxy
210-
(Filter (PropertyEquals "name" (PropertyText name)) All)
211-
pure (T.unpack <$> (bttvLargestImageURL =<< (entityPayload <$> emote)))

0 commit comments

Comments
 (0)