{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
module Advent.API (
AdventAPI
, adventAPI
, adventAPIClient
, adventAPIPuzzleClient
, HTMLTags
, FromTags(..)
, Articles
, Divs
, Scripts
, RawText
, processHTML
) where
import Advent.Types
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Bifunctor
import Data.Char
import Data.Finite
import Data.Foldable
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map (Map)
import Data.Maybe
import Data.Ord
import Data.Proxy
import Data.Text (Text)
import Data.Time hiding (Day)
import GHC.TypeLits
import Servant.API
import Servant.Client
import Text.HTML.TagSoup.Tree (TagTree(..))
import Text.Read (readMaybe)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Network.HTTP.Media as M
import qualified Text.HTML.TagSoup as H
import qualified Text.HTML.TagSoup.Tree as H
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif
#if !MIN_VERSION_time(1,9,0)
import Data.Time.LocalTime.Compat
#endif
data RawText
instance Accept RawText where
contentType :: Proxy RawText -> MediaType
contentType Proxy RawText
_ = ByteString
"text" ByteString -> ByteString -> MediaType
M.// ByteString
"plain"
instance MimeUnrender RawText Text where
mimeUnrender :: Proxy RawText -> ByteString -> Either String Text
mimeUnrender Proxy RawText
_ = (UnicodeException -> String)
-> Either UnicodeException Text -> Either String Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first UnicodeException -> String
forall a. Show a => a -> String
show (Either UnicodeException Text -> Either String Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
data HTMLTags (tag :: Symbol)
type Articles = HTMLTags "article"
type Divs = HTMLTags "div"
type Scripts = HTMLTags "script"
class FromTags tag a where
fromTags :: p tag -> [Text] -> Maybe a
instance Accept (HTMLTags cls) where
contentType :: Proxy (HTMLTags cls) -> MediaType
contentType Proxy (HTMLTags cls)
_ = ByteString
"text" ByteString -> ByteString -> MediaType
M.// ByteString
"html"
instance (FromTags tag a, KnownSymbol tag) => MimeUnrender (HTMLTags tag) a where
mimeUnrender :: Proxy (HTMLTags tag) -> ByteString -> Either String a
mimeUnrender Proxy (HTMLTags tag)
_ ByteString
str = do
Text
x <- (UnicodeException -> String)
-> Either UnicodeException Text -> Either String Text
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first UnicodeException -> String
forall a. Show a => a -> String
show (Either UnicodeException Text -> Either String Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> Either String Text)
-> ByteString -> Either String Text
forall a b. (a -> b) -> a -> b
$ ByteString
str
Either String a
-> (a -> Either String a) -> Maybe a -> Either String a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String a
forall a b. a -> Either a b
Left String
"No parse") a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe a -> Either String a)
-> (Text -> Maybe a) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy tag -> [Text] -> Maybe a
forall k (tag :: k) a (p :: k -> *).
FromTags tag a =>
p tag -> [Text] -> Maybe a
fromTags (Proxy tag
forall k (t :: k). Proxy t
Proxy @tag)
([Text] -> Maybe a) -> (Text -> [Text]) -> Text -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> [Text]
processHTML (Proxy tag -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy tag
forall k (t :: k). Proxy t
Proxy @tag))
(Text -> Either String a) -> Text -> Either String a
forall a b. (a -> b) -> a -> b
$ Text
x
instance FromTags cls [Text] where
fromTags :: p cls -> [Text] -> Maybe [Text]
fromTags p cls
_ = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just
instance FromTags cls Text where
fromTags :: p cls -> [Text] -> Maybe Text
fromTags p cls
_ = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
instance (Ord a, Enum a, Bounded a) => FromTags cls (Map a Text) where
fromTags :: p cls -> [Text] -> Maybe (Map a Text)
fromTags p cls
_ = Map a Text -> Maybe (Map a Text)
forall a. a -> Maybe a
Just (Map a Text -> Maybe (Map a Text))
-> ([Text] -> Map a Text) -> [Text] -> Maybe (Map a Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Text)] -> Map a Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, Text)] -> Map a Text)
-> ([Text] -> [(a, Text)]) -> [Text] -> Map a Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [Text] -> [(a, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a
forall a. Bounded a => a
minBound ..]
instance (FromTags cls a, FromTags cls b) => FromTags cls (a :<|> b) where
fromTags :: p cls -> [Text] -> Maybe (a :<|> b)
fromTags p cls
p [Text]
xs = a -> b -> a :<|> b
forall a b. a -> b -> a :<|> b
(:<|>) (a -> b -> a :<|> b) -> Maybe a -> Maybe (b -> a :<|> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p cls -> [Text] -> Maybe a
forall k (tag :: k) a (p :: k -> *).
FromTags tag a =>
p tag -> [Text] -> Maybe a
fromTags p cls
p [Text]
xs Maybe (b -> a :<|> b) -> Maybe b -> Maybe (a :<|> b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> p cls -> [Text] -> Maybe b
forall k (tag :: k) a (p :: k -> *).
FromTags tag a =>
p tag -> [Text] -> Maybe a
fromTags p cls
p [Text]
xs
instance FromTags "article" SubmitRes where
fromTags :: p "article" -> [Text] -> Maybe SubmitRes
fromTags p "article"
_ = SubmitRes -> Maybe SubmitRes
forall a. a -> Maybe a
Just (SubmitRes -> Maybe SubmitRes)
-> ([Text] -> SubmitRes) -> [Text] -> Maybe SubmitRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SubmitRes
parseSubmitRes (Text -> SubmitRes) -> ([Text] -> Text) -> [Text] -> SubmitRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Maybe Text -> Text) -> ([Text] -> Maybe Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe
instance FromTags "div" DailyLeaderboard where
fromTags :: p "div" -> [Text] -> Maybe DailyLeaderboard
fromTags p "div"
_ = DailyLeaderboard -> Maybe DailyLeaderboard
forall a. a -> Maybe a
Just (DailyLeaderboard -> Maybe DailyLeaderboard)
-> ([Text] -> DailyLeaderboard) -> [Text] -> Maybe DailyLeaderboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DailyLeaderboardMember] -> DailyLeaderboard
assembleDLB ([DailyLeaderboardMember] -> DailyLeaderboard)
-> ([Text] -> [DailyLeaderboardMember])
-> [Text]
-> DailyLeaderboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe DailyLeaderboardMember)
-> [Text] -> [DailyLeaderboardMember]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe DailyLeaderboardMember
parseMember
where
parseMember :: Text -> Maybe DailyLeaderboardMember
parseMember :: Text -> Maybe DailyLeaderboardMember
parseMember Text
contents = do
Rank
dlbmRank <- (Finite 100 -> Rank) -> Maybe (Finite 100) -> Maybe Rank
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Finite 100 -> Rank
Rank (Maybe (Finite 100) -> Maybe Rank)
-> (Integer -> Maybe (Finite 100)) -> Integer -> Maybe Rank
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe (Finite 100)
forall (n :: Nat). KnownNat n => Integer -> Maybe (Finite n)
packFinite (Integer -> Maybe (Finite 100))
-> (Integer -> Integer) -> Integer -> Maybe (Finite 100)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
subtract Integer
1
(Integer -> Maybe Rank) -> Maybe Integer -> Maybe Rank
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> ((Text, [Attribute Text]) -> String)
-> (Text, [Attribute Text])
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (String -> String)
-> ((Text, [Attribute Text]) -> String)
-> (Text, [Attribute Text])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [Attribute Text]) -> Text)
-> (Text, [Attribute Text])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> Text
forall a b. (a, b) -> a
fst
((Text, [Attribute Text]) -> Maybe Integer)
-> Maybe (Text, [Attribute Text]) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"span" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"leaderboard-position")
NominalDiffTime
dlbmDecTime <- (LocalTime -> NominalDiffTime)
-> Maybe LocalTime -> Maybe NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalTime -> NominalDiffTime
mkDiff
(Maybe LocalTime -> Maybe NominalDiffTime)
-> ((Text, [Attribute Text]) -> Maybe LocalTime)
-> (Text, [Attribute Text])
-> Maybe NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> Maybe LocalTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%b %d %H:%M:%S"
(String -> Maybe LocalTime)
-> ((Text, [Attribute Text]) -> String)
-> (Text, [Attribute Text])
-> Maybe LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [Attribute Text]) -> Text)
-> (Text, [Attribute Text])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> Text
forall a b. (a, b) -> a
fst
((Text, [Attribute Text]) -> Maybe NominalDiffTime)
-> Maybe (Text, [Attribute Text]) -> Maybe NominalDiffTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"span" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"leaderboard-time")
Either Integer Text
dlbmUser <- [TagTree Text] -> Maybe (Either Integer Text)
eitherUser [TagTree Text]
tr
DailyLeaderboardMember -> Maybe DailyLeaderboardMember
forall (f :: * -> *) a. Applicative f => a -> f a
pure DLBM :: Rank
-> NominalDiffTime
-> Either Integer Text
-> Maybe Text
-> Maybe Text
-> Bool
-> DailyLeaderboardMember
DLBM{Bool
Maybe Text
Either Integer Text
NominalDiffTime
Rank
dlbmSupporter :: Bool
dlbmImage :: Maybe Text
dlbmLink :: Maybe Text
dlbmUser :: Either Integer Text
dlbmDecTime :: NominalDiffTime
dlbmRank :: Rank
dlbmImage :: Maybe Text
dlbmSupporter :: Bool
dlbmLink :: Maybe Text
dlbmUser :: Either Integer Text
dlbmDecTime :: NominalDiffTime
dlbmRank :: Rank
..}
where
dlbmLink :: Maybe Text
dlbmLink = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" ([Attribute Text] -> Maybe Text)
-> ((Text, [Attribute Text]) -> [Attribute Text])
-> (Text, [Attribute Text])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> [Attribute Text]
forall a b. (a, b) -> b
snd ((Text, [Attribute Text]) -> Maybe Text)
-> Maybe (Text, [Attribute Text]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"a" Maybe Text
forall a. Maybe a
Nothing
dlbmSupporter :: Bool
dlbmSupporter = Text
"AoC++" Text -> Text -> Bool
`T.isInfixOf` Text
contents
dlbmImage :: Maybe Text
dlbmImage = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src" ([Attribute Text] -> Maybe Text)
-> ((Text, [Attribute Text]) -> [Attribute Text])
-> (Text, [Attribute Text])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> [Attribute Text]
forall a b. (a, b) -> b
snd ((Text, [Attribute Text]) -> Maybe Text)
-> Maybe (Text, [Attribute Text]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"img" Maybe Text
forall a. Maybe a
Nothing
tr :: [TagTree Text]
tr = Text -> [TagTree Text]
forall str. StringLike str => str -> [TagTree str]
H.parseTree Text
contents
uni :: [TagTree Text]
uni = [TagTree Text] -> [TagTree Text]
forall str. [TagTree str] -> [TagTree str]
H.universeTree [TagTree Text]
tr
assembleDLB :: [DailyLeaderboardMember] -> DailyLeaderboard
assembleDLB = DailyLeaderboard -> DailyLeaderboard
flipper (DailyLeaderboard -> DailyLeaderboard)
-> ([DailyLeaderboardMember] -> DailyLeaderboard)
-> [DailyLeaderboardMember]
-> DailyLeaderboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Maybe Rank), DailyLeaderboard) -> DailyLeaderboard
forall a b. (a, b) -> b
snd ((Maybe (Maybe Rank), DailyLeaderboard) -> DailyLeaderboard)
-> ([DailyLeaderboardMember]
-> (Maybe (Maybe Rank), DailyLeaderboard))
-> [DailyLeaderboardMember]
-> DailyLeaderboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe (Maybe Rank), DailyLeaderboard)
-> DailyLeaderboardMember
-> (Maybe (Maybe Rank), DailyLeaderboard))
-> (Maybe (Maybe Rank), DailyLeaderboard)
-> [DailyLeaderboardMember]
-> (Maybe (Maybe Rank), DailyLeaderboard)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Maybe (Maybe Rank)
-> DailyLeaderboard
-> DailyLeaderboardMember
-> (Maybe (Maybe Rank), DailyLeaderboard))
-> (Maybe (Maybe Rank), DailyLeaderboard)
-> DailyLeaderboardMember
-> (Maybe (Maybe Rank), DailyLeaderboard)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe (Maybe Rank)
-> DailyLeaderboard
-> DailyLeaderboardMember
-> (Maybe (Maybe Rank), DailyLeaderboard)
go) (Maybe (Maybe Rank)
forall a. Maybe a
Nothing, Map Rank DailyLeaderboardMember
-> Map Rank DailyLeaderboardMember -> DailyLeaderboard
DLB Map Rank DailyLeaderboardMember
forall k a. Map k a
M.empty Map Rank DailyLeaderboardMember
forall k a. Map k a
M.empty)
where
flipper :: DailyLeaderboard -> DailyLeaderboard
flipper dlb :: DailyLeaderboard
dlb@(DLB Map Rank DailyLeaderboardMember
a Map Rank DailyLeaderboardMember
b)
| Map Rank DailyLeaderboardMember -> Bool
forall k a. Map k a -> Bool
M.null Map Rank DailyLeaderboardMember
a = Map Rank DailyLeaderboardMember
-> Map Rank DailyLeaderboardMember -> DailyLeaderboard
DLB Map Rank DailyLeaderboardMember
b Map Rank DailyLeaderboardMember
a
| Bool
otherwise = DailyLeaderboard
dlb
go :: Maybe (Maybe Rank)
-> DailyLeaderboard
-> DailyLeaderboardMember
-> (Maybe (Maybe Rank), DailyLeaderboard)
go Maybe (Maybe Rank)
counter DailyLeaderboard
dlb m :: DailyLeaderboardMember
m@DLBM{Bool
Maybe Text
Either Integer Text
NominalDiffTime
Rank
dlbmSupporter :: Bool
dlbmImage :: Maybe Text
dlbmLink :: Maybe Text
dlbmUser :: Either Integer Text
dlbmDecTime :: NominalDiffTime
dlbmRank :: Rank
dlbmSupporter :: DailyLeaderboardMember -> Bool
dlbmImage :: DailyLeaderboardMember -> Maybe Text
dlbmLink :: DailyLeaderboardMember -> Maybe Text
dlbmUser :: DailyLeaderboardMember -> Either Integer Text
dlbmDecTime :: DailyLeaderboardMember -> NominalDiffTime
dlbmRank :: DailyLeaderboardMember -> Rank
..} = case Maybe (Maybe Rank)
counter of
Maybe (Maybe Rank)
Nothing -> (Maybe (Maybe Rank), DailyLeaderboard)
dlb2
Just Maybe Rank
Nothing -> (Maybe (Maybe Rank), DailyLeaderboard)
forall a. (Maybe (Maybe a), DailyLeaderboard)
dlb1
Just (Just Rank
i)
| Rank
dlbmRank Rank -> Rank -> Bool
forall a. Ord a => a -> a -> Bool
<= Rank
i -> (Maybe (Maybe Rank), DailyLeaderboard)
forall a. (Maybe (Maybe a), DailyLeaderboard)
dlb1
| Bool
otherwise -> (Maybe (Maybe Rank), DailyLeaderboard)
dlb2
where
dlb1 :: (Maybe (Maybe a), DailyLeaderboard)
dlb1 = (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing , DailyLeaderboard
dlb { dlbStar1 :: Map Rank DailyLeaderboardMember
dlbStar1 = Rank
-> DailyLeaderboardMember
-> Map Rank DailyLeaderboardMember
-> Map Rank DailyLeaderboardMember
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Rank
dlbmRank DailyLeaderboardMember
m (DailyLeaderboard -> Map Rank DailyLeaderboardMember
dlbStar1 DailyLeaderboard
dlb) })
dlb2 :: (Maybe (Maybe Rank), DailyLeaderboard)
dlb2 = (Maybe Rank -> Maybe (Maybe Rank)
forall a. a -> Maybe a
Just (Rank -> Maybe Rank
forall a. a -> Maybe a
Just Rank
dlbmRank), DailyLeaderboard
dlb { dlbStar2 :: Map Rank DailyLeaderboardMember
dlbStar2 = Rank
-> DailyLeaderboardMember
-> Map Rank DailyLeaderboardMember
-> Map Rank DailyLeaderboardMember
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Rank
dlbmRank DailyLeaderboardMember
m (DailyLeaderboard -> Map Rank DailyLeaderboardMember
dlbStar2 DailyLeaderboard
dlb) })
mkDiff :: LocalTime -> NominalDiffTime
mkDiff LocalTime
t = LocalTime
t LocalTime -> LocalTime -> NominalDiffTime
`diffLocalTime` LocalTime
decemberFirst
decemberFirst :: LocalTime
decemberFirst = Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Int -> Int -> Day
fromGregorian Integer
1970 Int
12 Int
1) TimeOfDay
midnight
instance FromTags "div" GlobalLeaderboard where
fromTags :: p "div" -> [Text] -> Maybe GlobalLeaderboard
fromTags p "div"
_ = GlobalLeaderboard -> Maybe GlobalLeaderboard
forall a. a -> Maybe a
Just (GlobalLeaderboard -> Maybe GlobalLeaderboard)
-> ([Text] -> GlobalLeaderboard)
-> [Text]
-> Maybe GlobalLeaderboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Rank (Integer, NonEmpty GlobalLeaderboardMember)
-> GlobalLeaderboard
GLB (Map Rank (Integer, NonEmpty GlobalLeaderboardMember)
-> GlobalLeaderboard)
-> ([Text] -> Map Rank (Integer, NonEmpty GlobalLeaderboardMember))
-> [Text]
-> GlobalLeaderboard
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> Map Rank (Integer, NonEmpty GlobalLeaderboardMember)
reScore (Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> Map Rank (Integer, NonEmpty GlobalLeaderboardMember))
-> ([Text]
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember))
-> [Text]
-> Map Rank (Integer, NonEmpty GlobalLeaderboardMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty GlobalLeaderboardMember
-> NonEmpty GlobalLeaderboardMember
-> NonEmpty GlobalLeaderboardMember)
-> [(Down Integer, NonEmpty GlobalLeaderboardMember)]
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith NonEmpty GlobalLeaderboardMember
-> NonEmpty GlobalLeaderboardMember
-> NonEmpty GlobalLeaderboardMember
forall a. Semigroup a => a -> a -> a
(<>)
([(Down Integer, NonEmpty GlobalLeaderboardMember)]
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember))
-> ([Text] -> [(Down Integer, NonEmpty GlobalLeaderboardMember)])
-> [Text]
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GlobalLeaderboardMember
-> (Down Integer, NonEmpty GlobalLeaderboardMember))
-> [GlobalLeaderboardMember]
-> [(Down Integer, NonEmpty GlobalLeaderboardMember)]
forall a b. (a -> b) -> [a] -> [b]
map (\GlobalLeaderboardMember
x -> (Integer -> Down Integer
forall a. a -> Down a
Down (GlobalLeaderboardMember -> Integer
glbmScore GlobalLeaderboardMember
x), GlobalLeaderboardMember
x GlobalLeaderboardMember
-> [GlobalLeaderboardMember] -> NonEmpty GlobalLeaderboardMember
forall a. a -> [a] -> NonEmpty a
:| []))
([GlobalLeaderboardMember]
-> [(Down Integer, NonEmpty GlobalLeaderboardMember)])
-> ([Text] -> [GlobalLeaderboardMember])
-> [Text]
-> [(Down Integer, NonEmpty GlobalLeaderboardMember)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe GlobalLeaderboardMember)
-> [Text] -> [GlobalLeaderboardMember]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe GlobalLeaderboardMember
parseMember
where
parseMember :: Text -> Maybe GlobalLeaderboardMember
parseMember :: Text -> Maybe GlobalLeaderboardMember
parseMember Text
contents = do
Integer
glbmScore <- String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> ((Text, [Attribute Text]) -> String)
-> (Text, [Attribute Text])
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (String -> String)
-> ((Text, [Attribute Text]) -> String)
-> (Text, [Attribute Text])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [Attribute Text]) -> Text)
-> (Text, [Attribute Text])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> Text
forall a b. (a, b) -> a
fst
((Text, [Attribute Text]) -> Maybe Integer)
-> Maybe (Text, [Attribute Text]) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"span" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"leaderboard-totalscore")
Either Integer Text
glbmUser <- [TagTree Text] -> Maybe (Either Integer Text)
eitherUser [TagTree Text]
tr
GlobalLeaderboardMember -> Maybe GlobalLeaderboardMember
forall (f :: * -> *) a. Applicative f => a -> f a
pure GLBM :: Rank
-> Integer
-> Either Integer Text
-> Maybe Text
-> Maybe Text
-> Bool
-> GlobalLeaderboardMember
GLBM{Bool
Integer
Maybe Text
Either Integer Text
Rank
glbmSupporter :: Bool
glbmImage :: Maybe Text
glbmLink :: Maybe Text
glbmUser :: Either Integer Text
glbmRank :: Rank
glbmImage :: Maybe Text
glbmSupporter :: Bool
glbmLink :: Maybe Text
glbmRank :: Rank
glbmUser :: Either Integer Text
glbmScore :: Integer
glbmScore :: Integer
..}
where
glbmRank :: Rank
glbmRank = Finite 100 -> Rank
Rank Finite 100
0
glbmLink :: Maybe Text
glbmLink = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" ([Attribute Text] -> Maybe Text)
-> ((Text, [Attribute Text]) -> [Attribute Text])
-> (Text, [Attribute Text])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> [Attribute Text]
forall a b. (a, b) -> b
snd ((Text, [Attribute Text]) -> Maybe Text)
-> Maybe (Text, [Attribute Text]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"a" Maybe Text
forall a. Maybe a
Nothing
glbmSupporter :: Bool
glbmSupporter = Text
"AoC++" Text -> Text -> Bool
`T.isInfixOf` Text
contents
glbmImage :: Maybe Text
glbmImage = Text -> [Attribute Text] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src" ([Attribute Text] -> Maybe Text)
-> ((Text, [Attribute Text]) -> [Attribute Text])
-> (Text, [Attribute Text])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> [Attribute Text]
forall a b. (a, b) -> b
snd ((Text, [Attribute Text]) -> Maybe Text)
-> Maybe (Text, [Attribute Text]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"img" Maybe Text
forall a. Maybe a
Nothing
tr :: [TagTree Text]
tr = Text -> [TagTree Text]
forall str. StringLike str => str -> [TagTree str]
H.parseTree Text
contents
uni :: [TagTree Text]
uni = [TagTree Text] -> [TagTree Text]
forall str. [TagTree str] -> [TagTree str]
H.universeTree [TagTree Text]
tr
reScore :: Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> Map Rank (Integer, NonEmpty GlobalLeaderboardMember)
reScore = (NonEmpty GlobalLeaderboardMember
-> (Integer, NonEmpty GlobalLeaderboardMember))
-> Map Rank (NonEmpty GlobalLeaderboardMember)
-> Map Rank (Integer, NonEmpty GlobalLeaderboardMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NonEmpty GlobalLeaderboardMember
xs -> (GlobalLeaderboardMember -> Integer
glbmScore (NonEmpty GlobalLeaderboardMember -> GlobalLeaderboardMember
forall a. NonEmpty a -> a
NE.head NonEmpty GlobalLeaderboardMember
xs), NonEmpty GlobalLeaderboardMember
xs))
(Map Rank (NonEmpty GlobalLeaderboardMember)
-> Map Rank (Integer, NonEmpty GlobalLeaderboardMember))
-> (Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> Map Rank (NonEmpty GlobalLeaderboardMember))
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> Map Rank (Integer, NonEmpty GlobalLeaderboardMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Rank, NonEmpty GlobalLeaderboardMember)]
-> Map Rank (NonEmpty GlobalLeaderboardMember)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
([(Rank, NonEmpty GlobalLeaderboardMember)]
-> Map Rank (NonEmpty GlobalLeaderboardMember))
-> (Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> [(Rank, NonEmpty GlobalLeaderboardMember)])
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> Map Rank (NonEmpty GlobalLeaderboardMember)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)]
-> Finite 100 -> [(Rank, NonEmpty GlobalLeaderboardMember)])
-> Finite 100
-> State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)]
-> [(Rank, NonEmpty GlobalLeaderboardMember)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)]
-> Finite 100 -> [(Rank, NonEmpty GlobalLeaderboardMember)]
forall s a. State s a -> s -> a
evalState Finite 100
0
(State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)]
-> [(Rank, NonEmpty GlobalLeaderboardMember)])
-> (Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)])
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> [(Rank, NonEmpty GlobalLeaderboardMember)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty GlobalLeaderboardMember
-> StateT
(Finite 100) Identity (Rank, NonEmpty GlobalLeaderboardMember))
-> [NonEmpty GlobalLeaderboardMember]
-> State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NonEmpty GlobalLeaderboardMember
-> StateT
(Finite 100) Identity (Rank, NonEmpty GlobalLeaderboardMember)
forall (m :: * -> *) (t :: * -> *).
(MonadState (Finite 100) m, Traversable t) =>
t GlobalLeaderboardMember -> m (Rank, t GlobalLeaderboardMember)
go
([NonEmpty GlobalLeaderboardMember]
-> State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)])
-> (Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> [NonEmpty GlobalLeaderboardMember])
-> Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> State (Finite 100) [(Rank, NonEmpty GlobalLeaderboardMember)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Down Integer) (NonEmpty GlobalLeaderboardMember)
-> [NonEmpty GlobalLeaderboardMember]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
where
go :: t GlobalLeaderboardMember -> m (Rank, t GlobalLeaderboardMember)
go t GlobalLeaderboardMember
xs = do
Finite 100
currScore <- m (Finite 100)
forall s (m :: * -> *). MonadState s m => m s
get
t GlobalLeaderboardMember
xs' <- t GlobalLeaderboardMember
-> (GlobalLeaderboardMember -> m GlobalLeaderboardMember)
-> m (t GlobalLeaderboardMember)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM t GlobalLeaderboardMember
xs ((GlobalLeaderboardMember -> m GlobalLeaderboardMember)
-> m (t GlobalLeaderboardMember))
-> (GlobalLeaderboardMember -> m GlobalLeaderboardMember)
-> m (t GlobalLeaderboardMember)
forall a b. (a -> b) -> a -> b
$ \GlobalLeaderboardMember
x -> GlobalLeaderboardMember
x { glbmRank :: Rank
glbmRank = Finite 100 -> Rank
Rank Finite 100
currScore } GlobalLeaderboardMember -> m () -> m GlobalLeaderboardMember
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Finite 100 -> Finite 100) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Finite 100 -> Finite 100
forall a. Enum a => a -> a
succ
(Rank, t GlobalLeaderboardMember)
-> m (Rank, t GlobalLeaderboardMember)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Finite 100 -> Rank
Rank Finite 100
currScore, t GlobalLeaderboardMember
xs')
instance FromTags "script" NextDayTime where
fromTags :: p "script" -> [Text] -> Maybe NextDayTime
fromTags p "script"
_ = (Maybe NextDayTime -> Maybe NextDayTime -> Maybe NextDayTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NextDayTime -> Maybe NextDayTime
forall a. a -> Maybe a
Just NextDayTime
NoNextDayTime) (Maybe NextDayTime -> Maybe NextDayTime)
-> ([Text] -> Maybe NextDayTime) -> [Text] -> Maybe NextDayTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NextDayTime] -> Maybe NextDayTime
forall a. [a] -> Maybe a
listToMaybe ([NextDayTime] -> Maybe NextDayTime)
-> ([Text] -> [NextDayTime]) -> [Text] -> Maybe NextDayTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe NextDayTime) -> [Text] -> [NextDayTime]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe NextDayTime
findNDT
where
findNDT :: Text -> Maybe NextDayTime
findNDT Text
body = do
String
eta <- Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
grabKey Text
"server_eta" Text
body
Text
yd <- Text -> Text -> Maybe Text
grabKey Text
"key" Text
body
Int
sec <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
eta
Text
dayStr <- [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn Text
"-" (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
yd
Day
dy <- Integer -> Maybe Day
mkDay (Integer -> Maybe Day) -> Maybe Integer -> Maybe Day
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
dayStr)
NextDayTime -> Maybe NextDayTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NextDayTime -> Maybe NextDayTime)
-> NextDayTime -> Maybe NextDayTime
forall a b. (a -> b) -> a -> b
$ Day -> Int -> NextDayTime
NextDayTime Day
dy Int
sec
grabKey :: Text -> Text -> Maybe Text
grabKey Text
t Text
str =
Attribute Text -> Text
forall a b. (a, b) -> a
fst (Attribute Text -> Text)
-> (Text -> Attribute Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Attribute Text
T.breakOn Text
";\n" (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripPrefix Text
t' (Attribute Text -> Text
forall a b. (a, b) -> b
snd (Text -> Text -> Attribute Text
T.breakOn Text
t' Text
str))
where
t' :: Text
t' = Text
"var " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = "
type AdventAPI =
Capture "year" Integer
:> (Get '[Scripts] NextDayTime
:<|> "day" :> Capture "day" Day
:> (Get '[Articles] (Map Part Text)
:<|> "input" :> Get '[RawText] Text
:<|> "answer"
:> ReqBody '[FormUrlEncoded] SubmitInfo
:> Post '[Articles] (Text :<|> SubmitRes)
)
:<|> ("leaderboard"
:> (Get '[Divs] GlobalLeaderboard
:<|> "day" :> Capture "day" Day :> Get '[Divs] DailyLeaderboard
:<|> "private" :> "view"
:> Capture "code" PublicCode
:> Get '[JSON] Leaderboard
))
)
adventAPI :: Proxy AdventAPI
adventAPI :: Proxy AdventAPI
adventAPI = Proxy AdventAPI
forall k (t :: k). Proxy t
Proxy
adventAPIClient
:: Integer
-> ClientM NextDayTime
:<|> (Day -> ClientM (Map Part Text) :<|> ClientM Text :<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)) )
:<|> ClientM GlobalLeaderboard
:<|> (Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard)
adventAPIClient :: Integer
-> ClientM NextDayTime
:<|> ((Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
:<|> (ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard))))
adventAPIClient = Proxy AdventAPI -> Client ClientM AdventAPI
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy AdventAPI
adventAPI
adventAPIPuzzleClient
:: Integer
-> Day
-> ClientM (Map Part Text) :<|> ClientM Text :<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))
adventAPIPuzzleClient :: Integer
-> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
adventAPIPuzzleClient Integer
y = Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
pis
where
ClientM NextDayTime
_ :<|> Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
pis :<|> ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard))
_ = Integer
-> ClientM NextDayTime
:<|> ((Day
-> ClientM (Map Part Text)
:<|> (ClientM Text
:<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
:<|> (ClientM GlobalLeaderboard
:<|> ((Day -> ClientM DailyLeaderboard)
:<|> (PublicCode -> ClientM Leaderboard))))
adventAPIClient Integer
y
userNameNaked :: [TagTree Text] -> Maybe Text
userNameNaked :: [TagTree Text] -> Maybe Text
userNameNaked = ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text)
-> ([TagTree Text] -> [Text]) -> [TagTree Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([TagTree Text] -> [Text]) -> [TagTree Text] -> Maybe Text)
-> ((TagTree Text -> Maybe Text) -> [TagTree Text] -> [Text])
-> (TagTree Text -> Maybe Text)
-> [TagTree Text]
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TagTree Text -> Maybe Text) -> [TagTree Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((TagTree Text -> Maybe Text) -> [TagTree Text] -> Maybe Text)
-> (TagTree Text -> Maybe Text) -> [TagTree Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ \TagTree Text
x -> do
TagLeaf (H.TagText (Text -> Text
T.strip->Text
u)) <- TagTree Text -> Maybe (TagTree Text)
forall a. a -> Maybe a
Just TagTree Text
x
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (Bool -> Bool) -> Bool -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
u
Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
u
findTag :: [TagTree Text] -> Text -> Maybe Text -> Maybe (Text, [H.Attribute Text])
findTag :: [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
tag Maybe Text
cls = [(Text, [Attribute Text])] -> Maybe (Text, [Attribute Text])
forall a. [a] -> Maybe a
listToMaybe ([(Text, [Attribute Text])] -> Maybe (Text, [Attribute Text]))
-> ((TagTree Text -> Maybe (Text, [Attribute Text]))
-> [(Text, [Attribute Text])])
-> (TagTree Text -> Maybe (Text, [Attribute Text]))
-> Maybe (Text, [Attribute Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TagTree Text -> Maybe (Text, [Attribute Text]))
-> [TagTree Text] -> [(Text, [Attribute Text])])
-> [TagTree Text]
-> (TagTree Text -> Maybe (Text, [Attribute Text]))
-> [(Text, [Attribute Text])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TagTree Text -> Maybe (Text, [Attribute Text]))
-> [TagTree Text] -> [(Text, [Attribute Text])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [TagTree Text]
uni ((TagTree Text -> Maybe (Text, [Attribute Text]))
-> Maybe (Text, [Attribute Text]))
-> (TagTree Text -> Maybe (Text, [Attribute Text]))
-> Maybe (Text, [Attribute Text])
forall a b. (a -> b) -> a -> b
$ \TagTree Text
x -> do
TagBranch Text
tag' [Attribute Text]
attr [TagTree Text]
cld <- TagTree Text -> Maybe (TagTree Text)
forall a. a -> Maybe a
Just TagTree Text
x
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text
tag' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tag
Maybe Text -> (Text -> Maybe ()) -> Maybe ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Text
cls ((Text -> Maybe ()) -> Maybe ()) -> (Text -> Maybe ()) -> Maybe ()
forall a b. (a -> b) -> a -> b
$ \Text
c -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Text
"class", Text
c) Attribute Text -> [Attribute Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Attribute Text]
attr
(Text, [Attribute Text]) -> Maybe (Text, [Attribute Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TagTree Text] -> Text
forall str. StringLike str => [TagTree str] -> str
H.renderTree [TagTree Text]
cld, [Attribute Text]
attr)
eitherUser :: [TagTree Text] -> Maybe (Either Integer Text)
eitherUser :: [TagTree Text] -> Maybe (Either Integer Text)
eitherUser [TagTree Text]
tr = [Maybe (Either Integer Text)] -> Maybe (Either Integer Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
Text -> Either Integer Text
forall a b. b -> Either a b
Right (Text -> Either Integer Text)
-> Maybe Text -> Maybe (Either Integer Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TagTree Text] -> Maybe Text
userNameNaked [TagTree Text]
tr
, (Text -> Either Integer Text)
-> Maybe Text -> Maybe (Either Integer Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Integer Text
forall a b. b -> Either a b
Right (Maybe Text -> Maybe (Either Integer Text))
-> Maybe Text -> Maybe (Either Integer Text)
forall a b. (a -> b) -> a -> b
$ [TagTree Text] -> Maybe Text
userNameNaked ([TagTree Text] -> Maybe Text)
-> ((Text, [Attribute Text]) -> [TagTree Text])
-> (Text, [Attribute Text])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [TagTree Text]
forall str. StringLike str => str -> [TagTree str]
H.parseTree (Text -> [TagTree Text])
-> ((Text, [Attribute Text]) -> Text)
-> (Text, [Attribute Text])
-> [TagTree Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> Text
forall a b. (a, b) -> a
fst
((Text, [Attribute Text]) -> Maybe Text)
-> Maybe (Text, [Attribute Text]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"a" Maybe Text
forall a. Maybe a
Nothing
, (Integer -> Either Integer Text)
-> Maybe Integer -> Maybe (Either Integer Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Either Integer Text
forall a b. a -> Either a b
Left (Maybe Integer -> Maybe (Either Integer Text))
-> Maybe Integer -> Maybe (Either Integer Text)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer)
-> ((Text, [Attribute Text]) -> String)
-> (Text, [Attribute Text])
-> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit (String -> String)
-> ((Text, [Attribute Text]) -> String)
-> (Text, [Attribute Text])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [Attribute Text]) -> Text)
-> (Text, [Attribute Text])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [Attribute Text]) -> Text
forall a b. (a, b) -> a
fst
((Text, [Attribute Text]) -> Maybe Integer)
-> Maybe (Text, [Attribute Text]) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [Attribute Text])
findTag [TagTree Text]
uni Text
"span" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"leaderboard-anon")
]
where
uni :: [TagTree Text]
uni = [TagTree Text] -> [TagTree Text]
forall str. [TagTree str] -> [TagTree str]
H.universeTree [TagTree Text]
tr
processHTML
:: String
-> Text
-> [Text]
processHTML :: String -> Text -> [Text]
processHTML String
tag = (TagTree Text -> Maybe Text) -> [TagTree Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TagTree Text -> Maybe Text
getTag
([TagTree Text] -> [Text])
-> (Text -> [TagTree Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TagTree Text] -> [TagTree Text]
forall str. [TagTree str] -> [TagTree str]
H.universeTree
([TagTree Text] -> [TagTree Text])
-> (Text -> [TagTree Text]) -> Text -> [TagTree Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [TagTree Text]
forall str. Eq str => [Tag str] -> [TagTree str]
H.tagTree
([Tag Text] -> [TagTree Text])
-> (Text -> [Tag Text]) -> Text -> [TagTree Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tag Text] -> [Tag Text]
forall str. [Tag str] -> [Tag str]
cleanTags
([Tag Text] -> [Tag Text])
-> (Text -> [Tag Text]) -> Text -> [Tag Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
H.parseTags
where
getTag :: TagTree Text -> Maybe Text
getTag :: TagTree Text -> Maybe Text
getTag (TagBranch Text
n [Attribute Text]
_ [TagTree Text]
ts) = [TagTree Text] -> Text
forall str. StringLike str => [TagTree str] -> str
H.renderTree [TagTree Text]
ts Text -> Maybe () -> Maybe Text
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack String
tag)
getTag TagTree Text
_ = Maybe Text
forall a. Maybe a
Nothing
cleanTags
:: [H.Tag str]
-> [H.Tag str]
cleanTags :: [Tag str] -> [Tag str]
cleanTags = (State [str] [Tag str] -> [str] -> [Tag str])
-> [str] -> State [str] [Tag str] -> [Tag str]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State [str] [Tag str] -> [str] -> [Tag str]
forall s a. State s a -> s -> a
evalState [] (State [str] [Tag str] -> [Tag str])
-> ([Tag str] -> State [str] [Tag str]) -> [Tag str] -> [Tag str]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag str -> StateT [str] Identity (Tag str))
-> [Tag str] -> State [str] [Tag str]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Tag str -> StateT [str] Identity (Tag str)
forall (f :: * -> *) a. MonadState [a] f => Tag a -> f (Tag a)
go
where
go :: Tag a -> f (Tag a)
go Tag a
t = case Tag a
t of
H.TagOpen a
n [Attribute a]
_ -> Tag a
t Tag a -> f () -> f (Tag a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ([a] -> [a]) -> f ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
H.TagClose a
_ -> f [a]
forall s (m :: * -> *). MonadState s m => m s
get f [a] -> ([a] -> f (Tag a)) -> f (Tag a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> Tag a -> f (Tag a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag a
t
a
m:[a]
ms -> a -> Tag a
forall str. str -> Tag str
H.TagClose a
m Tag a -> f () -> f (Tag a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [a] -> f ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [a]
ms
Tag a
_ -> Tag a -> f (Tag a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag a
t