{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE ViewPatterns          #-}

-- |
-- Module      : Advent.API
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : [email protected]
-- Stability   : experimental
-- Portability : non-portable
--
-- Raw Servant API for Advent of Code.  Can be useful for building mock
-- servers, generating documentation and other servanty things, or
-- low-level raw requests.
--
-- If you use this to make requests directly, please use responsibly: do
-- not make automated requests more than once per day and throttle all
-- manual requestes.  See notes in "Advent".
--
-- @since 0.2.0.0
--

module Advent.API (
  -- * Servant API
    AdventAPI
  , AoCUserAgent(..)
  , adventAPI
  , adventAPIClient
  , adventAPIPuzzleClient
  -- * Types
  , HTMLTags
  , FromTags(..)
  , Articles
  , Divs
  , Scripts
  , RawText
  -- * Internal
  , 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

-- | Raw "text/plain" MIME type
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 a b c. (a -> b) -> Either a c -> Either b c
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

-- | Interpret repsonse as a list of HTML 'T.Text' found in the given type of
-- tag
--
-- @since 0.2.3.0
data HTMLTags (tag :: Symbol)

-- | Interpret a response as a list of HTML 'T.Text' found in @<article>@ tags.
type Articles = HTMLTags "article"

-- | Interpret a response as a list of HTML 'T.Text' found in @<div>@ tags.
--
-- @since 0.2.3.0
type Divs     = HTMLTags "div"

-- | Interpret a response as a list of HTML 'T.Text' found in @<script>@ tags.
type Scripts = HTMLTags "script"

-- | Class for interpreting a list of 'T.Text' in tags to some desired
-- output.
--
-- @since 0.2.3.0
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 a b c. (a -> b) -> Either a c -> Either b c
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 a. 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
forall (p :: Symbol -> *). p tag -> [Text] -> Maybe a
fromTags (forall {k} (t :: k). Proxy t
forall (t :: Symbol). 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 (forall {k} (t :: k). Proxy t
forall (t :: Symbol). 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 :: forall (p :: k -> *). p cls -> [Text] -> Maybe [Text]
fromTags p cls
_ = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just

instance FromTags cls Text where
    fromTags :: forall (p :: k -> *). 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 :: forall (p :: k -> *). 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 :: forall (p :: k -> *). 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
forall (p :: k -> *). p cls -> [Text] -> Maybe a
fromTags p cls
p [Text]
xs Maybe (b -> a :<|> b) -> Maybe b -> Maybe (a :<|> b)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe 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
forall (p :: k -> *). p cls -> [Text] -> Maybe b
fromTags p cls
p [Text]
xs

instance FromTags "article" SubmitRes where
    fromTags :: forall (p :: Symbol -> *). 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 m. Monoid m => Maybe m -> m
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 :: forall (p :: Symbol -> *).
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 a b. (a -> b) -> Maybe a -> Maybe b
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, [(Text, Text)]) -> String)
-> (Text, [(Text, 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, [(Text, Text)]) -> String)
-> (Text, [(Text, Text)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [(Text, Text)]) -> Text)
-> (Text, [(Text, Text)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> Text
forall a b. (a, b) -> a
fst
                    ((Text, [(Text, Text)]) -> Maybe Integer)
-> Maybe (Text, [(Text, Text)]) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalTime -> NominalDiffTime
mkDiff
                         (Maybe LocalTime -> Maybe NominalDiffTime)
-> ((Text, [(Text, Text)]) -> Maybe LocalTime)
-> (Text, [(Text, 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, [(Text, Text)]) -> String)
-> (Text, [(Text, Text)])
-> Maybe LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [(Text, Text)]) -> Text)
-> (Text, [(Text, Text)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> Text
forall a b. (a, b) -> a
fst
                       ((Text, [(Text, Text)]) -> Maybe NominalDiffTime)
-> Maybe (Text, [(Text, Text)]) -> Maybe NominalDiffTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DLBM{Bool
Maybe Text
Either Integer Text
NominalDiffTime
Rank
dlbmRank :: Rank
dlbmDecTime :: NominalDiffTime
dlbmUser :: Either Integer Text
dlbmLink :: Maybe Text
dlbmSupporter :: Bool
dlbmImage :: Maybe Text
dlbmSupporter :: Bool
dlbmImage :: Maybe Text
dlbmLink :: Maybe Text
dlbmUser :: Either Integer Text
dlbmDecTime :: NominalDiffTime
dlbmRank :: Rank
..}
          where
            dlbmLink :: Maybe Text
dlbmLink      = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" ([(Text, Text)] -> Maybe Text)
-> ((Text, [(Text, Text)]) -> [(Text, Text)])
-> (Text, [(Text, Text)])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> [(Text, Text)]
forall a b. (a, b) -> b
snd ((Text, [(Text, Text)]) -> Maybe Text)
-> Maybe (Text, [(Text, Text)]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src" ([(Text, Text)] -> Maybe Text)
-> ((Text, [(Text, Text)]) -> [(Text, Text)])
-> (Text, [(Text, Text)])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> [(Text, Text)]
forall a b. (a, b) -> b
snd ((Text, [(Text, Text)]) -> Maybe Text)
-> Maybe (Text, [(Text, Text)]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 b a. (b -> a -> b) -> b -> [a] -> b
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 :: DailyLeaderboardMember -> Bool
dlbmImage :: DailyLeaderboardMember -> Maybe Text
dlbmLink :: DailyLeaderboardMember -> Maybe Text
dlbmUser :: DailyLeaderboardMember -> Either Integer Text
dlbmDecTime :: DailyLeaderboardMember -> NominalDiffTime
dlbmRank :: DailyLeaderboardMember -> Rank
dlbmRank :: Rank
dlbmDecTime :: NominalDiffTime
dlbmUser :: Either Integer Text
dlbmLink :: Maybe Text
dlbmImage :: Maybe Text
dlbmSupporter :: Bool
..} = 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 = M.insert dlbmRank m (dlbStar1 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 = M.insert dlbmRank m (dlbStar2 dlb) })
        mkDiff :: LocalTime -> NominalDiffTime
mkDiff LocalTime
t = LocalTime
t LocalTime -> LocalTime -> NominalDiffTime
`diffLocalTime` LocalTime
decemberFirst
        decemberFirst :: LocalTime
decemberFirst = Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Integer
1970 MonthOfYear
12 MonthOfYear
1) TimeOfDay
midnight

instance FromTags "div" GlobalLeaderboard where
    fromTags :: forall (p :: Symbol -> *).
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, [(Text, Text)]) -> String)
-> (Text, [(Text, 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, [(Text, Text)]) -> String)
-> (Text, [(Text, Text)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [(Text, Text)]) -> Text)
-> (Text, [(Text, Text)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> Text
forall a b. (a, b) -> a
fst
                     ((Text, [(Text, Text)]) -> Maybe Integer)
-> Maybe (Text, [(Text, Text)]) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GLBM{Bool
Integer
Maybe Text
Either Integer Text
Rank
glbmScore :: Integer
glbmScore :: Integer
glbmUser :: Either Integer Text
glbmRank :: Rank
glbmLink :: Maybe Text
glbmSupporter :: Bool
glbmImage :: Maybe Text
glbmSupporter :: Bool
glbmImage :: Maybe Text
glbmLink :: Maybe Text
glbmUser :: Either Integer Text
glbmRank :: Rank
..}
          where
            glbmRank :: Rank
glbmRank      = Finite 100 -> Rank
Rank Finite 100
0
            glbmLink :: Maybe Text
glbmLink      = Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"href" ([(Text, Text)] -> Maybe Text)
-> ((Text, [(Text, Text)]) -> [(Text, Text)])
-> (Text, [(Text, Text)])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> [(Text, Text)]
forall a b. (a, b) -> b
snd ((Text, [(Text, Text)]) -> Maybe Text)
-> Maybe (Text, [(Text, Text)]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"src" ([(Text, Text)] -> Maybe Text)
-> ((Text, [(Text, Text)]) -> [(Text, Text)])
-> (Text, [(Text, Text)])
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> [(Text, Text)]
forall a b. (a, b) -> b
snd ((Text, [(Text, Text)]) -> Maybe Text)
-> Maybe (Text, [(Text, Text)]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 a b. (a -> b) -> Map Rank a -> Map Rank b
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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse NonEmpty GlobalLeaderboardMember
-> StateT
     (Finite 100) Identity (Rank, NonEmpty GlobalLeaderboardMember)
forall {t :: * -> *} {m :: * -> *}.
(Traversable t, MonadState (Finite 100) m) =>
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 a. Map (Down Integer) a -> [a]
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 currScore } GlobalLeaderboardMember -> m () -> m GlobalLeaderboardMember
forall a b. a -> m b -> m a
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 a. a -> m a
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 :: forall (p :: Symbol -> *).
p "script" -> [Text] -> Maybe NextDayTime
fromTags p "script"
_ = (Maybe NextDayTime -> Maybe NextDayTime -> Maybe NextDayTime
forall a. Maybe a -> Maybe a -> Maybe a
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
        -- var server_eta = 25112;
        -- var key = "2020-15-"+server_eta;
        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
          MonthOfYear
sec    <- String -> Maybe MonthOfYear
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
. MonthOfYear -> [Text] -> [Text]
forall a. MonthOfYear -> [a] -> [a]
drop MonthOfYear
1 ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> [Text]
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 a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NextDayTime -> Maybe NextDayTime)
-> NextDayTime -> Maybe NextDayTime
forall a b. (a -> b) -> a -> b
$ Day -> MonthOfYear -> NextDayTime
NextDayTime Day
dy MonthOfYear
sec
        grabKey :: Text -> Text -> Maybe Text
grabKey Text
t Text
str =
            (Text, Text) -> Text
forall a b. (a, b) -> a
fst ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, 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' ((Text, Text) -> Text
forall a b. (a, b) -> b
snd (HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, 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
" = "

-- | A structured user agent, based on
-- <https://www.reddit.com/r/adventofcode/comments/z9dhtd/please_include_your_contact_info_in_the_useragent/>
data AoCUserAgent = AoCUserAgent
    { AoCUserAgent -> Text
_auaRepo :: Text      -- ^ repository where your code is hosted
    , AoCUserAgent -> Text
_auaEmail :: Text     -- ^ email address or contact
    }
  deriving (MonthOfYear -> AoCUserAgent -> String -> String
[AoCUserAgent] -> String -> String
AoCUserAgent -> String
(MonthOfYear -> AoCUserAgent -> String -> String)
-> (AoCUserAgent -> String)
-> ([AoCUserAgent] -> String -> String)
-> Show AoCUserAgent
forall a.
(MonthOfYear -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: MonthOfYear -> AoCUserAgent -> String -> String
showsPrec :: MonthOfYear -> AoCUserAgent -> String -> String
$cshow :: AoCUserAgent -> String
show :: AoCUserAgent -> String
$cshowList :: [AoCUserAgent] -> String -> String
showList :: [AoCUserAgent] -> String -> String
Show)

instance ToHttpApiData AoCUserAgent where
  toQueryParam :: AoCUserAgent -> Text
toQueryParam AoCUserAgent{Text
_auaRepo :: AoCUserAgent -> Text
_auaEmail :: AoCUserAgent -> Text
_auaRepo :: Text
_auaEmail :: Text
..} = Text
_auaRepo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
_auaEmail

-- | REST API of Advent of Code.
--
-- Note that most of these requests assume a "session=" cookie.
type AdventAPI =
      Header "User-Agent" AoCUserAgent
   :> 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
       ))
      )


-- | 'Proxy' used for /servant/ functions.
adventAPI :: Proxy AdventAPI
adventAPI :: Proxy AdventAPI
adventAPI = Proxy AdventAPI
forall {k} (t :: k). Proxy t
Proxy

-- | 'ClientM' requests based on 'AdventAPI', generated by servant.
adventAPIClient
    :: Maybe AoCUserAgent
    -> Integer
    -> ClientM NextDayTime
  :<|> (Day -> ClientM (Map Part Text) :<|> ClientM Text :<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)) )
  :<|> ClientM GlobalLeaderboard
  :<|> (Day -> ClientM DailyLeaderboard)
  :<|> (PublicCode -> ClientM Leaderboard)
adventAPIClient :: Maybe AoCUserAgent
-> 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

-- | A subset of 'adventAPIClient' for only puzzle-related API routes, not
-- leaderboard ones.
adventAPIPuzzleClient
    :: Maybe AoCUserAgent
    -> Integer
    -> Day
    -> ClientM (Map Part Text) :<|> ClientM Text :<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))
adventAPIPuzzleClient :: Maybe AoCUserAgent
-> Integer
-> Day
-> ClientM (Map Part Text)
   :<|> (ClientM Text
         :<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes)))
adventAPIPuzzleClient Maybe AoCUserAgent
aua 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))
_ = Maybe AoCUserAgent
-> Integer
-> ClientM NextDayTime
   :<|> ((Day
          -> ClientM (Map Part Text)
             :<|> (ClientM Text
                   :<|> (SubmitInfo -> ClientM (Text :<|> SubmitRes))))
         :<|> (ClientM GlobalLeaderboard
               :<|> ((Day -> ClientM DailyLeaderboard)
                     :<|> (PublicCode -> ClientM Leaderboard))))
adventAPIClient Maybe AoCUserAgent
aua 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 a. a -> Maybe a
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, [(Text, Text)])
findTag [TagTree Text]
uni Text
tag Maybe Text
cls = [(Text, [(Text, Text)])] -> Maybe (Text, [(Text, Text)])
forall a. [a] -> Maybe a
listToMaybe ([(Text, [(Text, Text)])] -> Maybe (Text, [(Text, Text)]))
-> ((TagTree Text -> Maybe (Text, [(Text, Text)]))
    -> [(Text, [(Text, Text)])])
-> (TagTree Text -> Maybe (Text, [(Text, Text)]))
-> Maybe (Text, [(Text, Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TagTree Text -> Maybe (Text, [(Text, Text)]))
 -> [TagTree Text] -> [(Text, [(Text, Text)])])
-> [TagTree Text]
-> (TagTree Text -> Maybe (Text, [(Text, Text)]))
-> [(Text, [(Text, Text)])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TagTree Text -> Maybe (Text, [(Text, Text)]))
-> [TagTree Text] -> [(Text, [(Text, Text)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [TagTree Text]
uni ((TagTree Text -> Maybe (Text, [(Text, Text)]))
 -> Maybe (Text, [(Text, Text)]))
-> (TagTree Text -> Maybe (Text, [(Text, Text)]))
-> Maybe (Text, [(Text, Text)])
forall a b. (a -> b) -> a -> b
$ \TagTree Text
x -> do
  TagBranch Text
tag' [(Text, 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) (Text, Text) -> [(Text, Text)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Text, Text)]
attr
  (Text, [(Text, Text)]) -> Maybe (Text, [(Text, Text)])
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TagTree Text] -> Text
forall str. StringLike str => [TagTree str] -> str
H.renderTree [TagTree Text]
cld, [(Text, 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 a b. (a -> b) -> Maybe a -> Maybe b
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, [(Text, Text)]) -> [TagTree Text])
-> (Text, [(Text, 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, [(Text, Text)]) -> Text)
-> (Text, [(Text, Text)])
-> [TagTree Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> Text
forall a b. (a, b) -> a
fst
               ((Text, [(Text, Text)]) -> Maybe Text)
-> Maybe (Text, [(Text, Text)]) -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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 a b. (a -> b) -> Maybe a -> Maybe b
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, [(Text, Text)]) -> String)
-> (Text, [(Text, 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, [(Text, Text)]) -> String)
-> (Text, [(Text, Text)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((Text, [(Text, Text)]) -> Text)
-> (Text, [(Text, Text)])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, [(Text, Text)]) -> Text
forall a b. (a, b) -> a
fst
               ((Text, [(Text, Text)]) -> Maybe Integer)
-> Maybe (Text, [(Text, Text)]) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [TagTree Text]
-> Text -> Maybe Text -> Maybe (Text, [(Text, 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

-- | Process an HTML webpage into a list of all contents in the given tag
-- type
processHTML
    :: String       -- ^ tag type
    -> Text         -- ^ html
    -> [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 [(Text, Text)]
_ [TagTree Text]
ts) = [TagTree Text] -> Text
forall str. StringLike str => [TagTree str] -> str
H.renderTree [TagTree Text]
ts Text -> Maybe () -> Maybe Text
forall a b. a -> Maybe b -> Maybe a
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

-- | Some days, including:
--
-- * 2015 Day 6 Part 1
-- * 2016 Day 2 Part 2
--
-- Have malformed HTML tags; the first has @<p></code>@ and the second has
-- @<span></title>@.  This function cleans up all tags so that any closing
-- tags ignore their actual tag type and instead close the last opened tag
-- (if there is any).  If no tag is currently open then it just leaves it
-- unchanged.
cleanTags
    :: [H.Tag str]
    -> [H.Tag str]
cleanTags :: forall str. [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a b. a -> f b -> f 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 a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        []   -> Tag a -> f (Tag a)
forall a. a -> f 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 a b. a -> f b -> f 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 a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tag a
t