advent-of-code-api 0.2.12.0 → 0.2.13.0

raw patch · 4 files changed

+76/−2 lines, 4 filesdep +splitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: split

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• advent-of-code-api.cabal +2/−1
• src/Advent.hs +23/−1
• src/Advent/API.hs +41/−0

@@ -1,6 +1,16 @@ Changelog ========= +Version 0.2.13.0+----------------++*November 9, 2026*++<https://github.com/mstksg/advent-of-code-api/releases/tag/v0.2.13.0>++*   Add `AoCAcceptedAnswer`, to fetch the accepted answer (if any) for each+    part of a day.+ Version 0.2.12.0 ---------------- 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:               advent-of-code-api-version:            0.2.12.0+version:            0.2.13.0 synopsis:           Advent of Code REST API bindings and servant API description:   Haskell bindings for Advent of Code REST API and a servant API.  Please use@@ -70,6 +70,7 @@     , servant     , servant-client     , servant-client-core+    , split     , stm     , tagsoup     , text

@@ -178,6 +178,15 @@   --   -- /Cacheing rules/: Is cached forever, per day per session key.   AoCInput :: Day -> AoC Text+  -- | Fetch the accepted answer (if any) for each part of a given day,+  -- parsed from the day prompt page.+  --+  -- /Cacheing rules/: Same as 'AoCPrompt'.+  --+  -- @since 0.2.13.0+  AoCAcceptedAnswer ::+    Day ->+    AoC (Map Part Text)   -- | Submit a plaintext answer (the 'String') to a given day and part.   -- Receive a server reponse (as HTML) and a response code 'SubmitRes'.   --@@ -267,6 +276,7 @@ aocDay :: AoC a -> Maybe Day aocDay (AoCPrompt d) = Just d aocDay (AoCInput d) = Just d+aocDay (AoCAcceptedAnswer d) = Just d aocDay (AoCSubmit d _ _) = Just d aocDay (AoCLeaderboard _) = Nothing aocDay (AoCDailyLeaderboard d) = Just d@@ -374,8 +384,11 @@ aocReq aua sess yr = \case   AoCPrompt i -> let r :<|> _ :<|> _ = adventAPIPuzzleClient aua yr i in r sess   AoCInput i -> let _ :<|> r :<|> _ = adventAPIPuzzleClient aua yr i in r (reqSess sess)+  AoCAcceptedAnswer i ->+    let _ :<|> _ :<|> _ :<|> r = adventAPIPuzzleClient aua yr i+     in getAcceptedAnswers <$> r (reqSess sess)   AoCSubmit i p ans ->-    let _ :<|> _ :<|> r = adventAPIPuzzleClient aua yr i+    let _ :<|> _ :<|> r :<|> _ = adventAPIPuzzleClient aua yr i      in r (reqSess sess) (SubmitInfo p ans) <&> \(x :<|> y) -> (x, y)   AoCLeaderboard c ->     let _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> r = adventAPIClient aua yr@@ -406,6 +419,7 @@ apiCache sess yr = \case   AoCPrompt d -> Just $ printf "prompt/%04d/%02d.html" yr (dayInt d)   AoCInput d -> Just $ printf "input/%s%04d/%02d.txt" keyDir yr (dayInt d)+  AoCAcceptedAnswer d -> Just $ printf "accepted/%s%04d/%02d.txt" keyDir yr (dayInt d)   AoCSubmit{} -> Nothing   AoCLeaderboard{} -> Nothing   AoCDailyLeaderboard d -> Just $ printf "daily/%04d/%02d.json" yr (dayInt d)@@ -542,6 +556,14 @@     SL       { _slSave = either (const Nothing) Just       , _slLoad = Just . Right+      }+  AoCAcceptedAnswer{} ->+    SL+      { _slSave = either (const Nothing) (Just . encodeMap)+      , _slLoad = \str ->+          let mp = decodeMap str+              hasAll = S.null (expectedParts `S.difference` M.keysSet mp)+           in Right mp <$ guard hasAll       }   AoCSubmit{} -> noCache   AoCLeaderboard{} -> noCache

@@ -47,6 +47,7 @@   Divs,   Scripts,   RawText,+  AcceptedAnswers (..),    -- * Internal   processHTML,@@ -63,6 +64,7 @@ import Data.Foldable import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE+import Data.List.Split (splitWhen) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe@@ -118,6 +120,11 @@ -- | Interpret a response as a list of HTML 'T.Text' found in @<pre>@ tags. type Pres = HTMLTags "pre" +-- | Interpret a response as a list of HTML 'T.Text' found in @<main>@ tags.+--+-- @since 0.2.13.0+type Mains = HTMLTags "main"+ -- | Class for interpreting a list of 'T.Text' in tags to some desired -- output. --@@ -151,6 +158,14 @@ instance FromTags "article" SubmitRes where   fromTags _ = Just . parseSubmitRes . fold . listToMaybe +-- | Accepted answers for each part of a day.+--+-- @since 0.2.13.0+newtype AcceptedAnswers = AcceptedAnswers {getAcceptedAnswers :: Map Part Text}++instance FromTags "main" AcceptedAnswers where+  fromTags _ = Just . AcceptedAnswers . parseAcceptedAnswers . fold . listToMaybe+ instance FromTags "div" DailyLeaderboard where   fromTags _ = Just . assembleDLB . mapMaybe parseMember     where@@ -290,6 +305,8 @@                       :> Header' '[Required, Strict] "Cookie" SessionKey                       :> ReqBody '[FormUrlEncoded] SubmitInfo                       :> Post '[Articles] (Text :<|> SubmitRes)+                    :<|> Header' '[Required, Strict] "Cookie" SessionKey+                      :> Get '[Mains] AcceptedAnswers                 )            :<|> ( "leaderboard"                     :> ( Get '[Divs] GlobalLeaderboard@@ -317,6 +334,7 @@            (Maybe SessionKey -> ClientM (Map Part Text))              :<|> (SessionKey -> ClientM Text)              :<|> (SessionKey -> SubmitInfo -> ClientM (Text :<|> SubmitRes))+             :<|> (SessionKey -> ClientM AcceptedAnswers)          )     :<|> ClientM GlobalLeaderboard     :<|> (Day -> ClientM DailyLeaderboard)@@ -332,6 +350,7 @@   (Maybe SessionKey -> ClientM (Map Part Text))     :<|> (SessionKey -> ClientM Text)     :<|> (SessionKey -> SubmitInfo -> ClientM (Text :<|> SubmitRes))+    :<|> (SessionKey -> ClientM AcceptedAnswers) adventAPIPuzzleClient aua y = pis   where     _ :<|> _ :<|> pis :<|> _ = adventAPIClient aua y@@ -387,6 +406,28 @@     ]   where     uni = H.universeTree tr++parseAcceptedAnswers :: Text -> Map Part Text+parseAcceptedAnswers =+  M.mapMaybe id+    . M.fromList+    . zip [minBound ..]+    . map findAnswer+    . siblingsAfterArticles+    . H.parseTree+  where+    siblingsAfterArticles :: [TagTree Text] -> [[TagTree Text]]+    siblingsAfterArticles = drop 1 . splitWhen isArticle+    isArticle (TagBranch "article" _ _) = True+    isArticle _ = False+    findAnswer :: [TagTree Text] -> Maybe Text+    findAnswer siblings =+      listToMaybe+        [ innerText cs'+        | TagBranch "p" _ cs <- siblings+        , "your puzzle answer was" `T.isInfixOf` T.toLower (innerText cs)+        , TagBranch "code" _ cs' <- cs+        ]  -- | Process an HTML webpage into a list of all contents in the given tag -- type