advent-of-code-api 0.2.11.0 → 0.2.12.0

raw patch · 9 files changed

+1171/−990 lines, 9 filessetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +16/−0
• Setup.hs +1/−0
• advent-of-code-api.cabal +56/−51
• src/Advent.hs +401/−374
• src/Advent/API.hs +263/−218
• src/Advent/Cache.hs +36/−37
• src/Advent/Throttle.hs +48/−43
• src/Advent/Types.hs +326/−245
• test/Spec.hs +24/−22

@@ -1,6 +1,22 @@ Changelog ========= +Version 0.2.12.0+----------------++*September 28, 2026*++<https://github.com/mstksg/advent-of-code-api/releases/tag/v0.2.12.0>++*   Add `lbNumDays` and `lbDay1Ts` to `Leaderboard`, parsed from the `num_days`+    and `day1_ts` fields of the private leaderboard JSON.+*   Add `lbmStarIndex` to `LeaderboardMember`, parsed from the `star_index`+    field alongside each completion's `get_star_ts`.+*   The `session` cookie is now an explicit `Header "Cookie"` in+    `AdventAPI` via servant, scoped only to the endpoints that actually need it+    (optional for `day` prompt, required for `input`/`answer`/private+    leaderboard). Adds `SessionKey`, re-exported from `Advent`.+ Version 0.2.11.0 ---------------- 

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -1,57 +1,59 @@-cabal-version: 1.12+cabal-version:      1.12  -- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack -name:           advent-of-code-api-version:        0.2.11.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-                responsibly! See README.md or "Advent" module for an introduction and-                tutorial.-category:       Web-homepage:       https://github.com/mstksg/advent-of-code-api#readme-bug-reports:    https://github.com/mstksg/advent-of-code-api/issues-author:         Justin Le-maintainer:     justin@jle.im-copyright:      (c) Justin Le 2018-license:        BSD3-license-file:   LICENSE-build-type:     Simple-tested-with:-    GHC >= 8.0+name:               advent-of-code-api+version:            0.2.12.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+  responsibly! See README.md or "Advent" module for an introduction and+  tutorial.++category:           Web+homepage:           https://github.com/mstksg/advent-of-code-api#readme+bug-reports:        https://github.com/mstksg/advent-of-code-api/issues+author:             Justin Le+maintainer:         justin@jle.im+copyright:          (c) Justin Le 2018+license:            BSD3+license-file:       LICENSE+build-type:         Simple+tested-with:        GHC >=8.0 extra-source-files:-    README.md-    CHANGELOG.md-    test-data/correct-rank.txt-    test-data/correct.txt-    test-data/incorrect-high.txt-    test-data/incorrect-low.txt-    test-data/incorrect-wait.txt-    test-data/incorrect.txt-    test-data/invalid.txt-    test-data/wait.txt-    test-data/wait2.txt+  CHANGELOG.md+  README.md+  test-data/correct-rank.txt+  test-data/correct.txt+  test-data/incorrect-high.txt+  test-data/incorrect-low.txt+  test-data/incorrect-wait.txt+  test-data/incorrect.txt+  test-data/invalid.txt+  test-data/wait.txt+  test-data/wait2.txt  source-repository head-  type: git+  type:     git   location: https://github.com/mstksg/advent-of-code-api  library   exposed-modules:-      Advent-      Advent.API-      Advent.Types+    Advent+    Advent.API+    Advent.Types+   other-modules:-      Advent.Throttle-      Advent.Cache-  hs-source-dirs:-      src-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns+    Advent.Cache+    Advent.Throttle++  hs-source-dirs:   src+  ghc-options:      -Wall -Wcompat -Werror=incomplete-patterns   build-depends:       aeson-    , base >=4.9 && <5+    , base                 >=4.9 && <5     , bytestring     , containers     , deepseq@@ -62,7 +64,7 @@     , http-client     , http-client-tls     , http-media-    , megaparsec >=7+    , megaparsec           >=7     , mtl     , profunctors     , servant@@ -72,22 +74,25 @@     , tagsoup     , text     , time-    , time-compat >=1.9+    , time-compat          >=1.9+   default-language: Haskell2010  test-suite advent-of-code-api-test-  type: exitcode-stdio-1.0-  main-is: Spec.hs-  other-modules:-      Paths_advent_of_code_api-  hs-source-dirs:-      test-  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -threaded -rtsopts -with-rtsopts=-N+  type:             exitcode-stdio-1.0+  main-is:          Spec.hs+  other-modules:    Paths_advent_of_code_api+  hs-source-dirs:   test+  ghc-options:+    -Wall -Wcompat -Werror=incomplete-patterns -threaded -rtsopts+    -with-rtsopts=-N+   build-depends:-      HUnit-    , advent-of-code-api-    , base >=4.9 && <5+      advent-of-code-api+    , base                >=4.9 && <5     , directory     , filepath+    , HUnit     , text+   default-language: Haskell2010

@@ -1,18 +1,17 @@-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DataKinds          #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE GADTs              #-}-{-# LANGUAGE KindSignatures     #-}-{-# LANGUAGE LambdaCase         #-}-{-# LANGUAGE OverloadedStrings  #-}-{-# LANGUAGE PatternSynonyms    #-}-{-# LANGUAGE PolyKinds          #-}-{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TupleSections      #-}-{-# LANGUAGE TypeApplications   #-}-{-# LANGUAGE ViewPatterns       #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}  -- | -- Module      : Advent@@ -45,77 +44,88 @@ -- Please use responsibly.  All actions are by default rate limited to one -- per three seconds, but this can be adjusted to a hard-limited cap of one -- per second.- module Advent (   -- * API-    AoC(..)-  , Part(..)-  , Day(..)-  , NextDayTime(..)-  , DayStats(..)-  , Stats-  , AoCOpts(..)-  , AoCUserAgent(..)-  , SubmitRes(..), showSubmitRes-  , statsForDayPart-  , inferSubmitRes-  , inferSubmitRes_-  , runAoC-  , runAoC_-  , defaultAoCOpts-  , AoCError(..)+  AoC (..),+  Part (..),+  Day (..),+  NextDayTime (..),+  DayStats (..),+  Stats,+  AoCOpts (..),+  AoCUserAgent (..),+  SessionKey (..),+  SubmitRes (..),+  showSubmitRes,+  statsForDayPart,+  inferSubmitRes,+  inferSubmitRes_,+  runAoC,+  runAoC_,+  defaultAoCOpts,+  AoCError (..),+   -- ** Calendar-  , challengeReleaseTime-  , timeToRelease-  , challengeReleased+  challengeReleaseTime,+  timeToRelease,+  challengeReleased,+   -- * Utility+   -- ** Day-  , mkDay, mkDay_, dayInt, pattern DayInt, _DayInt-  , aocDay-  , aocServerTime+  mkDay,+  mkDay_,+  dayInt,+  pattern DayInt,+  _DayInt,+  aocDay,+  aocServerTime,+   -- ** Part-  , partChar, partInt+  partChar,+  partInt,+   -- ** Leaderboard-  , fullDailyBoard+  fullDailyBoard,+   -- ** Throttler-  , setAoCThrottleLimit, getAoCThrottleLimit+  setAoCThrottleLimit,+  getAoCThrottleLimit,+   -- * Internal-  , aocReq-  , aocBase-  ) where+  aocReq,+  aocBase,+) where -import           Advent.API-import           Advent.Cache-import           Advent.Throttle-import           Advent.Types-import           Control.Concurrent.STM-import           Control.Exception-import           Control.Monad-import           Control.Monad.Except-import           Data.Kind-import           Data.Map                (Map)-import           Data.Maybe-import           Data.Set                (Set)-import           Data.Text               (Text)-import           Data.Time hiding        (Day)-import           Data.Typeable-import           GHC.Generics            (Generic)-import           Network.HTTP.Client-import           Network.HTTP.Client.TLS-import           Servant.API-import           Servant.Client-import           System.Directory-import           System.FilePath-import           Text.Printf-import qualified Data.Aeson              as A-import qualified Data.Map                as M-import qualified Data.Set                as S-import qualified Data.Text               as T-import qualified Data.Text.Encoding      as T-import qualified Data.Text.Lazy          as TL+import Advent.API+import Advent.Cache+import Advent.Throttle+import Advent.Types+import Control.Exception+import Control.Monad+import Control.Monad.Except+import qualified Data.Aeson as A+import Data.Either (fromRight)+import Data.Kind+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL-import qualified Servant.Client          as Servant-import qualified System.IO.Unsafe        as Unsafe+import Data.Time hiding (Day)+import Data.Typeable+import GHC.Generics (Generic)+import Network.HTTP.Client.TLS+import Servant.API+import Servant.Client+import System.Directory+import System.FilePath+import qualified System.IO.Unsafe as Unsafe+import Text.Printf  #if MIN_VERSION_mtl(2,3,0) import           Control.Monad.IO.Class (liftIO)@@ -152,138 +162,143 @@ -- up to and including Christmas Day (December 25th).  You can convert an -- integer day (1 - 25) into a 'Day' using 'mkDay' or 'mkDay_'. data AoC :: Type -> Type where-    -- | Fetch prompts for a given day.  Returns a 'Map' of 'Part's and-    -- their associated promps, as HTML.-    ---    -- _Cacheing rules_: Is cached on a per-day basis.  An empty session-    -- key is given, it will be happy with only having Part 1 cached.  If-    -- a non-empty session key is given, it will trigger a cache-    -- invalidation on every request until both Part 1 and Part 2 are-    -- received.-    AoCPrompt-        :: Day-        -> AoC (Map Part Text)--    -- | Fetch input, as plaintext.  Returned verbatim.  Be aware that-    -- input might contain trailing newlines.-    ---    -- /Cacheing rules/: Is cached forever, per day per session key.-    AoCInput :: Day -> AoC Text--    -- | Submit a plaintext answer (the 'String') to a given day and part.-    -- Receive a server reponse (as HTML) and a response code 'SubmitRes'.-    ---    -- __WARNING__: Answers are not length-limited.  Answers are stripped-    -- of leading and trailing whitespace and run through 'URI.encode'-    -- before submitting.-    ---    -- /Cacheing rules/: Is never cached.-    AoCSubmit-        :: Day-        -> Part-        -> String-        -> AoC (Text, SubmitRes)--    -- | Fetch the leaderboard for a given leaderboard public code (owner-    -- member ID).  Requires session key.-    ---    -- The public code can be found in the URL of the leaderboard:-    ---    -- > https://adventofcode.com/2019/leaderboard/private/view/12345-    ---    -- (the @12345@ above)-    ---    -- __NOTE__: This is the most expensive and taxing possible API call,-    -- and makes up the majority of bandwidth to the Advent of Code-    -- servers.  As a courtesy to all who are participating in Advent of-    -- Code, please use this super respectfully, especially in December: if-    -- you set up automation for this, please do not use it more than once-    -- per day.-    ---    -- /Cacheing rules/: Is never cached, so please use responsibly (see-    -- note above).-    ---    -- @since 0.2.0.0-    AoCLeaderboard-        :: Integer-        -> AoC Leaderboard--    -- | Fetch the daily leaderboard for a given day.  Does not require-    -- a session key.-    ---    -- Leaderboard API calls tend to be expensive, so please be respectful-    -- when using this.  If you automate this, please do not fetch any more-    -- often than necessary.-    ---    -- /Cacheing rules/: Will be cached if a full leaderboard is observed.-    ---    -- @since 0.2.3.0-    AoCDailyLeaderboard-        :: Day-        -> AoC DailyLeaderboard--    -- | Fetch the global leaderboard.  Does not require-    -- a session key.-    ---    -- Leaderboard API calls tend to be expensive, so please be respectful-    -- when using this.  If you automate this, please do not fetch any more-    -- often than necessary.-    ---    -- /Cacheing rules/: Will not cache if an event is ongoing, but will be-    -- cached if received after the event is over.-    ---    -- @since 0.2.3.0-    AoCGlobalLeaderboard-        :: AoC GlobalLeaderboard--    -- | From the calendar, fetch the next release's day and the-    -- number of seconds util its release, if there is any at all.-    ---    -- This does an actual request to the AoC servers, and is only accurate-    -- to the second; to infer this information (to the millisecond level)-    -- from the system clock, you should probably use 'timeToRelease' and-    -- 'aocServerTime' instead, which requires no network requests.-    ---    -- @since 0.2.8.0-    AoCNextDayTime-        :: AoC NextDayTime--    -- | Fetch the per-day completion stats for the current year.  Does not-    -- require a session key.-    ---    -- /Cacheing rules/: Not cached.-    ---    -- @since 0.2.11.0-    AoCStats-        :: AoC Stats+  -- | Fetch prompts for a given day.  Returns a 'Map' of 'Part's and+  -- their associated promps, as HTML.+  --+  -- _Cacheing rules_: Is cached on a per-day basis.  An empty session+  -- key is given, it will be happy with only having Part 1 cached.  If+  -- a non-empty session key is given, it will trigger a cache+  -- invalidation on every request until both Part 1 and Part 2 are+  -- received.+  AoCPrompt ::+    Day ->+    AoC (Map Part Text)+  -- | Fetch input, as plaintext.  Returned verbatim.  Be aware that+  -- input might contain trailing newlines.+  --+  -- /Cacheing rules/: Is cached forever, per day per session key.+  AoCInput :: Day -> AoC Text+  -- | Submit a plaintext answer (the 'String') to a given day and part.+  -- Receive a server reponse (as HTML) and a response code 'SubmitRes'.+  --+  -- __WARNING__: Answers are not length-limited.  Answers are stripped+  -- of leading and trailing whitespace and run through 'URI.encode'+  -- before submitting.+  --+  -- /Cacheing rules/: Is never cached.+  AoCSubmit ::+    Day ->+    Part ->+    String ->+    AoC (Text, SubmitRes)+  -- | Fetch the leaderboard for a given leaderboard public code (owner+  -- member ID).  Requires session key.+  --+  -- The public code can be found in the URL of the leaderboard:+  --+  -- > https://adventofcode.com/2019/leaderboard/private/view/12345+  --+  -- (the @12345@ above)+  --+  -- __NOTE__: This is the most expensive and taxing possible API call,+  -- and makes up the majority of bandwidth to the Advent of Code+  -- servers.  As a courtesy to all who are participating in Advent of+  -- Code, please use this super respectfully, especially in December: if+  -- you set up automation for this, please do not use it more than once+  -- per day.+  --+  -- /Cacheing rules/: Is never cached, so please use responsibly (see+  -- note above).+  --+  -- @since 0.2.0.0+  AoCLeaderboard ::+    Integer ->+    AoC Leaderboard+  -- | Fetch the daily leaderboard for a given day.  Does not require+  -- a session key.+  --+  -- Leaderboard API calls tend to be expensive, so please be respectful+  -- when using this.  If you automate this, please do not fetch any more+  -- often than necessary.+  --+  -- /Cacheing rules/: Will be cached if a full leaderboard is observed.+  --+  -- @since 0.2.3.0+  AoCDailyLeaderboard ::+    Day ->+    AoC DailyLeaderboard+  -- | Fetch the global leaderboard.  Does not require+  -- a session key.+  --+  -- Leaderboard API calls tend to be expensive, so please be respectful+  -- when using this.  If you automate this, please do not fetch any more+  -- often than necessary.+  --+  -- /Cacheing rules/: Will not cache if an event is ongoing, but will be+  -- cached if received after the event is over.+  --+  -- @since 0.2.3.0+  AoCGlobalLeaderboard ::+    AoC GlobalLeaderboard+  -- | From the calendar, fetch the next release's day and the+  -- number of seconds util its release, if there is any at all.+  --+  -- This does an actual request to the AoC servers, and is only accurate+  -- to the second; to infer this information (to the millisecond level)+  -- from the system clock, you should probably use 'timeToRelease' and+  -- 'aocServerTime' instead, which requires no network requests.+  --+  -- @since 0.2.8.0+  AoCNextDayTime ::+    AoC NextDayTime+  -- | Fetch the per-day completion stats for the current year.  Does not+  -- require a session key.+  --+  -- /Cacheing rules/: Not cached.+  --+  -- @since 0.2.11.0+  AoCStats ::+    AoC Stats  deriving instance Show (AoC a) deriving instance Typeable (AoC a)  -- | Get the day associated with a given API command, if there is one. aocDay :: AoC a -> Maybe Day-aocDay (AoCPrompt d     ) = Just d-aocDay (AoCInput  d     ) = Just d-aocDay (AoCSubmit d _ _ ) = Just d+aocDay (AoCPrompt d) = Just d+aocDay (AoCInput d) = Just d+aocDay (AoCSubmit d _ _) = Just d aocDay (AoCLeaderboard _) = Nothing aocDay (AoCDailyLeaderboard d) = Just d aocDay AoCGlobalLeaderboard = Nothing-aocDay AoCNextDayTime       = Nothing-aocDay AoCStats             = Nothing+aocDay AoCNextDayTime = Nothing+aocDay AoCStats = Nothing  -- | A possible (syncronous, logical, pure) error returnable from 'runAoC'. -- Does not cover any asynchronous or IO errors.+#if MIN_VERSION_servant_client_core(0,16,0) data AoCError     -- | An error in the http request itself     --     -- Note that if you are building this with servant-client-core <= 0.16,     -- this will contain @ServantError@ instead of @ClientError@, which was     -- the previous name of ths type.-#if MIN_VERSION_servant_client_core(0,16,0)     = AoCClientError ClientError+    -- | Tried to interact with a challenge that has not yet been+    -- released.  Contains the amount of time until release.+    | AoCReleaseError NominalDiffTime+    -- | The throttler limit is full.  Either make less requests, or adjust+    -- it with 'setAoCThrottleLimit'.+    | AoCThrottleError+  deriving (Show, Typeable, Generic) #else+data AoCError+    -- | An error in the http request itself+    --+    -- Note that if you are building this with servant-client-core <= 0.16,+    -- this will contain @ServantError@ instead of @ClientError@, which was+    -- the previous name of ths type.     = AoCClientError ServantError-#endif     -- | Tried to interact with a challenge that has not yet been     -- released.  Contains the amount of time until release.     | AoCReleaseError NominalDiffTime@@ -291,6 +306,7 @@     -- it with 'setAoCThrottleLimit'.     | AoCThrottleError   deriving (Show, Typeable, Generic)+#endif instance Exception AoCError  -- | Setings for running an API request.@@ -305,27 +321,27 @@ -- Throttling is hard-limited to a minimum of 1 second between calls. -- Please be respectful and do not try to bypass this. data AoCOpts = AoCOpts-    { -- | Session key-      _aSessionKey :: String-      -- | Year of challenge-    , _aYear       :: Integer-      -- | Structured user agent to use.  See-      -- <https://www.reddit.com/r/adventofcode/comments/z9dhtd/please_include_your_contact_info_in_the_useragent/>-    , _aUserAgent  :: AoCUserAgent-      -- | Cache directory.  If 'Nothing' is given, one will be allocated-      -- using 'getTemporaryDirectory'.-    , _aCache      :: Maybe FilePath-      -- | Fetch results even if cached.  Still subject to throttling.-      -- Default is False.-    , _aForce      :: Bool-      -- | Throttle delay, in milliseconds.  Minimum is 1000000.  Default-      -- is 3000000 (3 seconds).-    , _aThrottle   :: Int-      -- | Attempt to infer submission rank by fetching stats after a-      -- correct submission that doesn't include rank information.-      -- Default is False.-    , _aInferRankOnSubmission :: Bool-    }+  { _aSessionKey :: String+  -- ^ Session key+  , _aYear :: Integer+  -- ^ Year of challenge+  , _aUserAgent :: AoCUserAgent+  -- ^ Structured user agent to use.  See+  -- <https://www.reddit.com/r/adventofcode/comments/z9dhtd/please_include_your_contact_info_in_the_useragent/>+  , _aCache :: Maybe FilePath+  -- ^ Cache directory.  If 'Nothing' is given, one will be allocated+  -- using 'getTemporaryDirectory'.+  , _aForce :: Bool+  -- ^ Fetch results even if cached.  Still subject to throttling.+  -- Default is False.+  , _aThrottle :: Int+  -- ^ Throttle delay, in milliseconds.  Minimum is 1000000.  Default+  -- is 3000000 (3 seconds).+  , _aInferRankOnSubmission :: Bool+  -- ^ Attempt to infer submission rank by fetching stats after a+  -- correct submission that doesn't include rank information.+  -- Default is False.+  }   deriving (Show, Typeable, Generic)  -- | Sensible defaults for 'AoCOpts' for a given user agent, year and session@@ -333,18 +349,19 @@ -- -- Use system temporary directory as cache, and throttle requests to one -- request per three seconds.-defaultAoCOpts-    :: AoCUserAgent-    -> Integer-    -> String-    -> AoCOpts-defaultAoCOpts aua y s = AoCOpts+defaultAoCOpts ::+  AoCUserAgent ->+  Integer ->+  String ->+  AoCOpts+defaultAoCOpts aua y s =+  AoCOpts     { _aSessionKey = s-    , _aYear       = y-    , _aUserAgent  = aua-    , _aCache      = Nothing-    , _aForce      = False-    , _aThrottle   = 3000000+    , _aYear = y+    , _aUserAgent = aua+    , _aCache = Nothing+    , _aForce = False+    , _aThrottle = 3000000     , _aInferRankOnSubmission = False     } @@ -353,43 +370,52 @@ aocBase = BaseUrl Https "adventofcode.com" 443 ""  -- | 'ClientM' request for a given 'AoC' API call.-aocReq :: Maybe AoCUserAgent -> Integer -> AoC a -> ClientM a-aocReq aua yr = \case-    AoCPrompt i       -> let r :<|> _        = adventAPIPuzzleClient aua yr i in r-    AoCInput  i       -> let _ :<|> r :<|> _ = adventAPIPuzzleClient aua yr i in r-    AoCSubmit i p ans -> let _ :<|> _ :<|> r = adventAPIPuzzleClient aua yr i-                         in  r (SubmitInfo p ans) <&> \(x :<|> y) -> (x, y)-    AoCLeaderboard c  -> let _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> r = adventAPIClient aua yr-                         in  r (PublicCode c)-    AoCDailyLeaderboard d -> let _ :<|> _ :<|> _ :<|> _ :<|> r :<|> _ = adventAPIClient aua yr-                             in  r d-    AoCGlobalLeaderboard  -> let _ :<|> _ :<|> _ :<|> r :<|> _ :<|> _ = adventAPIClient aua yr-                             in  r-    AoCNextDayTime        -> let r :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ = adventAPIClient aua yr-                             in  r-    AoCStats              -> let _ :<|> r :<|> _ :<|> _ :<|> _ :<|> _ = adventAPIClient aua yr-                             in  r-+aocReq :: Maybe AoCUserAgent -> Maybe SessionKey -> Integer -> AoC a -> ClientM a+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)+  AoCSubmit i p ans ->+    let _ :<|> _ :<|> r = adventAPIPuzzleClient aua yr i+     in r (reqSess sess) (SubmitInfo p ans) <&> \(x :<|> y) -> (x, y)+  AoCLeaderboard c ->+    let _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> r = adventAPIClient aua yr+     in r (reqSess sess) (PublicCode c)+  AoCDailyLeaderboard d ->+    let _ :<|> _ :<|> _ :<|> _ :<|> r :<|> _ = adventAPIClient aua yr+     in r d+  AoCGlobalLeaderboard ->+    let _ :<|> _ :<|> _ :<|> r :<|> _ :<|> _ = adventAPIClient aua yr+     in r+  AoCNextDayTime ->+    let r :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ = adventAPIClient aua yr+     in r+  AoCStats ->+    let _ :<|> r :<|> _ :<|> _ :<|> _ :<|> _ = adventAPIClient aua yr+     in r+  where+    reqSess = fromMaybe dummyToken  -- | Cache file for a given 'AoC' command-apiCache-    :: Maybe String           -- ^ session key-    -> Integer                -- ^ year-    -> AoC a-    -> Maybe FilePath+apiCache ::+  -- | session key+  Maybe String ->+  -- | year+  Integer ->+  AoC a ->+  Maybe FilePath 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)-    AoCSubmit{}      -> Nothing-    AoCLeaderboard{} -> Nothing-    AoCDailyLeaderboard d  -> Just $ printf "daily/%04d/%02d.json" yr (dayInt d)-    AoCGlobalLeaderboard{} -> Just $ printf "global/%04d.json" yr-    AoCNextDayTime         -> Nothing-    AoCStats               -> Nothing+  AoCPrompt d -> Just $ printf "prompt/%04d/%02d.html" yr (dayInt d)+  AoCInput d -> Just $ printf "input/%s%04d/%02d.txt" keyDir yr (dayInt d)+  AoCSubmit{} -> Nothing+  AoCLeaderboard{} -> Nothing+  AoCDailyLeaderboard d -> Just $ printf "daily/%04d/%02d.json" yr (dayInt d)+  AoCGlobalLeaderboard{} -> Just $ printf "global/%04d.json" yr+  AoCNextDayTime -> Nothing+  AoCStats -> Nothing   where     keyDir = case sess of       Nothing -> ""-      Just s  -> strip s ++ "/"+      Just s -> strip s ++ "/"  -- | Run an 'AoC' command with a given 'AoCOpts' to produce the result -- or a list of (lines of) errors.@@ -399,42 +425,49 @@ -- before submitting. runAoC :: AoCOpts -> AoC a -> IO (Either AoCError a) runAoC opts@AoCOpts{..} a = do-    (keyMayb, cacheDir) <- case _aCache of-      Just c  -> pure (Nothing, c)-      Nothing -> (Just _aSessionKey,) . (</> "advent-of-code-api") <$> getTemporaryDirectory+  (keyMayb, cacheDir) <- case _aCache of+    Just c -> pure (Nothing, c)+    Nothing -> (Just _aSessionKey,) . (</> "advent-of-code-api") <$> getTemporaryDirectory -    (yy,mm,dd) <- toGregorian-                . localDay-                . utcToLocalTime (read "EST")-              <$> getCurrentTime-    let eventOver = yy > _aYear-                 || (mm == 12 && dd > 25)-        cacher = case apiCache keyMayb _aYear a of-          Nothing -> id-          Just fp -> cacheing (cacheDir </> fp) $-                       if _aForce-                         then noCache-                         else saverLoader-                                (not (null _aSessionKey))-                                (not eventOver)-                                a+  (yy, mm, dd) <-+    toGregorian+      . localDay+      . utcToLocalTime (read "EST")+      <$> getCurrentTime+  let eventOver =+        yy > _aYear+          || (mm == 12 && dd > 25)+      cacher = case apiCache keyMayb _aYear a of+        Nothing -> id+        Just fp ->+          cacheing (cacheDir </> fp) $+            if _aForce+              then noCache+              else+                saverLoader+                  (not (null _aSessionKey))+                  (not eventOver)+                  a -    cacher . runExceptT $ do-      forM_ (aocDay a) $ \d -> do-        rel <- liftIO $ timeToRelease _aYear d-        when (rel > 0) $-          throwError $ AoCReleaseError rel+  cacher . runExceptT $ do+    forM_ (aocDay a) $ \d -> do+      rel <- liftIO $ timeToRelease _aYear d+      when (rel > 0) $+        throwError $+          AoCReleaseError rel -      mtr <- liftIO-           . throttling aocThrottler (max 1000000 _aThrottle)-           $ runClientM (aocReq (Just _aUserAgent) _aYear a) =<< aocClientEnv _aSessionKey-      mcr <- maybe (throwError AoCThrottleError) pure mtr-      res <- either (throwError . AoCClientError) pure mcr-      case (a, _aInferRankOnSubmission, res) of-        (AoCSubmit d p _, True, (txt, sr)) -> do-          sr' <- liftIO $ inferSubmitRes_ opts d p sr-          pure (txt, sr')-        _ -> pure res+    let sess = SessionKey (T.pack _aSessionKey)+    mtr <-+      liftIO+        . throttling aocThrottler (max 1000000 _aThrottle)+        $ runClientM (aocReq (Just _aUserAgent) (Just sess) _aYear a) =<< aocClientEnv+    mcr <- maybe (throwError AoCThrottleError) pure mtr+    res <- either (throwError . AoCClientError) pure mcr+    case (a, _aInferRankOnSubmission, res) of+      (AoCSubmit d p _, True, (txt, sr)) -> do+        sr' <- liftIO $ inferSubmitRes_ opts d p sr+        pure (txt, sr')+      _ -> pure res  -- | A version of 'runAoC' that throws an IO exception (of type 'AoCError') -- upon failure, instead of an 'Either'.@@ -448,7 +481,7 @@ -- @since 0.2.11.0 statsForDayPart :: Day -> Part -> Stats -> Integer statsForDayPart d Part1 = maybe 0 dsSilver . M.lookup d-statsForDayPart d Part2 = maybe 0 dsGold   . M.lookup d+statsForDayPart d Part2 = maybe 0 dsGold . M.lookup d  -- | If an Advent of Code submission returns 'SubCorrect' without an attached -- rank, attempt to infer the rank from 'AoCStats', assuming that it was just@@ -458,122 +491,116 @@ -- unchanged. -- -- @since 0.2.11.0-inferSubmitRes-    :: AoCOpts-    -> Day-    -> Part-    -> SubmitRes-    -> IO (Either AoCError SubmitRes)+inferSubmitRes ::+  AoCOpts ->+  Day ->+  Part ->+  SubmitRes ->+  IO (Either AoCError SubmitRes) inferSubmitRes opts d p sr = case sr of-    SubCorrect Nothing -> do-        stats <- runAoC opts AoCStats-        pure $ stats >>= \st ->-          case M.lookup d st of-            Just _  -> Right . SubCorrect . Just $ statsForDayPart d p st-            Nothing -> Right $ SubCorrect Nothing-    _ -> pure $ Right sr+  SubCorrect Nothing -> do+    stats <- runAoC opts AoCStats+    pure $+      stats >>= \st ->+        case M.lookup d st of+          Just _ -> Right . SubCorrect . Just $ statsForDayPart d p st+          Nothing -> Right $ SubCorrect Nothing+  _ -> pure $ Right sr  -- | Variant of 'inferSubmitRes' that returns the original response if stats -- lookup fails. -- -- @since 0.2.11.0-inferSubmitRes_-    :: AoCOpts-    -> Day-    -> Part-    -> SubmitRes-    -> IO SubmitRes-inferSubmitRes_ opts d p sr = either (const sr) id <$> inferSubmitRes opts d p sr--aocClientEnv :: String -> IO ClientEnv-aocClientEnv s = do-    t <- getCurrentTime-    v <- atomically . newTVar $ createCookieJar [c t]-    mgr <- newTlsManager-    pure $ (mkClientEnv mgr aocBase)-        { Servant.cookieJar = Just v }-  where-    c t = Cookie-      { cookie_name             = "session"-      , cookie_value            = T.encodeUtf8 . T.pack $ s-      , cookie_expiry_time      = addUTCTime oneYear t-      , cookie_domain           = "adventofcode.com"-      , cookie_path             = "/"-      , cookie_creation_time    = t-      , cookie_last_access_time = t-      , cookie_persistent       = True-      , cookie_host_only        = True-      , cookie_secure_only      = True-      , cookie_http_only        = True-      }-    oneYear = 60 * 60 * 24 * 356.25+inferSubmitRes_ ::+  AoCOpts ->+  Day ->+  Part ->+  SubmitRes ->+  IO SubmitRes+inferSubmitRes_ opts d p sr = fromRight sr <$> inferSubmitRes opts d p sr +aocClientEnv :: IO ClientEnv+aocClientEnv = (`mkClientEnv` aocBase) <$> newTlsManager -saverLoader-    :: Bool             -- ^ is there a non-empty session token?-    -> Bool             -- ^ is the event ongoing (True) or over (False)?-    -> AoC a-    -> SaverLoader (Either AoCError a)+saverLoader ::+  -- | is there a non-empty session token?+  Bool ->+  -- | is the event ongoing (True) or over (False)?+  Bool ->+  AoC a ->+  SaverLoader (Either AoCError a) saverLoader validToken evt = \case-    AoCPrompt{} -> 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-                      }-    AoCInput{}  -> SL { _slSave = either (const Nothing) Just-                      , _slLoad = Just . Right-                      }-    AoCSubmit{} -> noCache-    AoCLeaderboard{} -> noCache-    AoCDailyLeaderboard{} -> SL-        { _slSave = either (const Nothing) (Just . TL.toStrict . TL.decodeUtf8 . A.encode)-        , _slLoad = \str -> do-            r <- A.decode . TL.encodeUtf8 . TL.fromStrict $ str-            guard $ fullDailyBoard r-            pure $ Right r-        }-    AoCGlobalLeaderboard{} -> SL-        { _slSave = either-                        (const Nothing)-                        (Just . TL.toStrict . TL.decodeUtf8 . A.encode @(Bool, GlobalLeaderboard) . (evt,))-        , _slLoad = \str -> do-            (evt', lb) <- A.decode @(Bool, GlobalLeaderboard) . TL.encodeUtf8 . TL.fromStrict $ str-            guard $ not evt'        -- only load cache if evt' is false: it was saved in a non-evt time-            pure $ Right lb-        }-    AoCNextDayTime{} -> noCache-    AoCStats{} -> noCache+  AoCPrompt{} ->+    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+      }+  AoCInput{} ->+    SL+      { _slSave = either (const Nothing) Just+      , _slLoad = Just . Right+      }+  AoCSubmit{} -> noCache+  AoCLeaderboard{} -> noCache+  AoCDailyLeaderboard{} ->+    SL+      { _slSave = either (const Nothing) (Just . TL.toStrict . TL.decodeUtf8 . A.encode)+      , _slLoad = \str -> do+          r <- A.decode . TL.encodeUtf8 . TL.fromStrict $ str+          guard $ fullDailyBoard r+          pure $ Right r+      }+  AoCGlobalLeaderboard{} ->+    SL+      { _slSave =+          either+            (const Nothing)+            (Just . TL.toStrict . TL.decodeUtf8 . A.encode @(Bool, GlobalLeaderboard) . (evt,))+      , _slLoad = \str -> do+          (evt', lb) <- A.decode @(Bool, GlobalLeaderboard) . TL.encodeUtf8 . TL.fromStrict $ str+          guard $ not evt' -- only load cache if evt' is false: it was saved in a non-evt time+          pure $ Right lb+      }+  AoCNextDayTime{} -> noCache+  AoCStats{} -> noCache   where     expectedParts :: Set Part     expectedParts       | validToken = S.fromDistinctAscList [Part1 ..]-      | otherwise  = S.singleton Part1+      | otherwise = S.singleton Part1     sep = ">>>>>>>>>"-    encodeMap mp = T.intercalate "\n" . concat $-                            [ maybeToList $ M.lookup Part1 mp-                            , [sep]-                            , maybeToList $ M.lookup Part2 mp-                            ]+    encodeMap mp =+      T.intercalate "\n" . concat $+        [ maybeToList $ M.lookup Part1 mp+        , [sep]+        , maybeToList $ M.lookup Part2 mp+        ]     decodeMap xs = mkMap Part1 part1 <> mkMap Part2 part2       where         (part1, drop 1 -> part2) = span (/= sep) (T.lines xs)-        mkMap p (T.intercalate "\n"->ln)+        mkMap p (T.intercalate "\n" -> ln)           | T.null (T.strip ln) = M.empty-          | otherwise           = M.singleton p ln+          | otherwise = M.singleton p ln  -- | Get time until release of a given challenge.-timeToRelease-    :: Integer              -- ^ year-    -> Day                  -- ^ day-    -> IO NominalDiffTime+timeToRelease ::+  -- | year+  Integer ->+  -- | day+  Day ->+  IO NominalDiffTime timeToRelease y d = (zonedTimeToUTC (challengeReleaseTime y d) `diffUTCTime`) <$> getCurrentTime  -- | Check if a challenge has been released yet.-challengeReleased-    :: Integer              -- ^ year-    -> Day                  -- ^ day-    -> IO Bool+challengeReleased ::+  -- | year+  Integer ->+  -- | day+  Day ->+  IO Bool challengeReleased y = fmap (<= 0) . timeToRelease y  -- | Utility to get the current time on AoC servers.  Basically just gets the current

@@ -1,16 +1,16 @@-{-# LANGUAGE CPP                   #-}-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE LambdaCase            #-}+{-# 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          #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}  -- | -- Module      : Advent.API@@ -30,54 +30,56 @@ -- manual requestes.  See notes in "Advent". -- -- @since 0.2.0.0---- module Advent.API (   -- * Servant API-    AdventAPI-  , AoCUserAgent(..)-  , adventAPI-  , adventAPIClient-  , adventAPIPuzzleClient+  AdventAPI,+  AoCUserAgent (..),+  SessionKey (..),+  dummyToken,+  adventAPI,+  adventAPIClient,+  adventAPIPuzzleClient,+   -- * Types-  , HTMLTags-  , FromTags(..)-  , Articles-  , Divs-  , Scripts-  , RawText+  HTMLTags,+  FromTags (..),+  Articles,+  Divs,+  Scripts,+  RawText,+   -- * Internal-  , processHTML-  ) where+  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 Advent.Types+import Control.Applicative+import Control.Monad+import Control.Monad.State+import Data.Bifunctor+import qualified Data.ByteString.Lazy as BSL+import Data.Char+import Data.Finite+import Data.Foldable+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe+import Data.Ord+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Time hiding (Day)+import GHC.TypeLits+import qualified Network.HTTP.Media as M+import Servant.API+import Servant.Client+import qualified Text.HTML.TagSoup as H+import Text.HTML.TagSoup.Tree (TagTree (..)) import qualified Text.HTML.TagSoup.Tree as H+import Text.Read (readMaybe)  #if !MIN_VERSION_base(4,11,0) import           Data.Semigroup ((<>))@@ -91,10 +93,10 @@ data RawText  instance Accept RawText where-    contentType _ = "text" M.// "plain"+  contentType _ = "text" M.// "plain"  instance MimeUnrender RawText Text where-    mimeUnrender _ = first show . T.decodeUtf8' . BSL.toStrict+  mimeUnrender _ = first show . T.decodeUtf8' . BSL.toStrict  -- | Interpret repsonse as a list of HTML 'T.Text' found in the given type of -- tag@@ -108,7 +110,7 @@ -- | Interpret a response as a list of HTML 'T.Text' found in @<div>@ tags. -- -- @since 0.2.3.0-type Divs     = HTMLTags "div"+type Divs = HTMLTags "div"  -- | Interpret a response as a list of HTML 'T.Text' found in @<script>@ tags. type Scripts = HTMLTags "script"@@ -121,179 +123,215 @@ -- -- @since 0.2.3.0 class FromTags tag a where-    fromTags :: p tag -> [Text] -> Maybe a+  fromTags :: p tag -> [Text] -> Maybe a  instance Accept (HTMLTags cls) where-    contentType _ = "text" M.// "html"+  contentType _ = "text" M.// "html"  instance (FromTags tag a, KnownSymbol tag) => MimeUnrender (HTMLTags tag) a where-    mimeUnrender _ str = do-      x <- first show . T.decodeUtf8' . BSL.toStrict $ str-      maybe (Left "No parse") pure-         . fromTags (Proxy @tag)-         . processHTML (symbolVal (Proxy @tag))-         $ x+  mimeUnrender _ str = do+    x <- first show . T.decodeUtf8' . BSL.toStrict $ str+    maybe (Left "No parse") pure+      . fromTags (Proxy @tag)+      . processHTML (symbolVal (Proxy @tag))+      $ x  instance FromTags cls [Text] where-    fromTags _ = Just+  fromTags _ = Just  instance FromTags cls Text where-    fromTags _ = Just . T.unlines+  fromTags _ = Just . T.unlines  instance (Ord a, Enum a, Bounded a) => FromTags cls (Map a Text) where-    fromTags _ = Just . M.fromList . zip [minBound ..]+  fromTags _ = Just . M.fromList . zip [minBound ..]  instance (FromTags cls a, FromTags cls b) => FromTags cls (a :<|> b) where-    fromTags p xs = (:<|>) <$> fromTags p xs <*> fromTags p xs+  fromTags p xs = (:<|>) <$> fromTags p xs <*> fromTags p xs  instance FromTags "article" SubmitRes where-    fromTags _ = Just . parseSubmitRes . fold  . listToMaybe+  fromTags _ = Just . parseSubmitRes . fold . listToMaybe  instance FromTags "div" DailyLeaderboard where-    fromTags _ = Just . assembleDLB . mapMaybe parseMember-      where-        parseMember :: Text -> Maybe DailyLeaderboardMember-        parseMember contents = do-            dlbmRank <- fmap Rank . packFinite . subtract 1-                    =<< readMaybe . filter isDigit . T.unpack . fst-                    =<< findTag uni "span" (Just "leaderboard-position")-            dlbmDecTime <- fmap mkDiff-                         . parseTimeM True defaultTimeLocale "%b %d  %H:%M:%S"-                         . T.unpack . fst-                       =<< findTag uni "span" (Just "leaderboard-time")-            dlbmUser <- eitherUser tr-            pure DLBM{..}-          where-            dlbmLink      = lookup "href" . snd =<< findTag uni "a" Nothing-            dlbmSupporter = "AoC++" `T.isInfixOf` contents-            dlbmImage     = lookup "src" . snd =<< findTag uni "img" Nothing-            tr  = H.parseTree contents-            uni = H.universeTree tr-        assembleDLB = flipper . snd . foldl' (uncurry go) (Nothing, DLB M.empty M.empty)-          where-            flipper dlb@(DLB a b)-              | M.null a  = DLB b a-              | otherwise = dlb-            go counter dlb m@DLBM{..} = case counter of-                Nothing      -> dlb2-                Just Nothing -> dlb1-                Just (Just i)-                  | dlbmRank <= i -> dlb1-                  | otherwise     -> dlb2-              where-                dlb1 = (Just Nothing        , dlb { dlbStar1 = M.insert dlbmRank m (dlbStar1 dlb) })-                dlb2 = (Just (Just dlbmRank), dlb { dlbStar2 = M.insert dlbmRank m (dlbStar2 dlb) })-        mkDiff t = t `diffLocalTime` decemberFirst-        decemberFirst = LocalTime (fromGregorian 1970 12 1) midnight+  fromTags _ = Just . assembleDLB . mapMaybe parseMember+    where+      parseMember :: Text -> Maybe DailyLeaderboardMember+      parseMember contents = do+        dlbmRank <-+          fmap Rank . packFinite . subtract 1+            =<< readMaybe . filter isDigit . T.unpack . fst+            =<< findTag uni "span" (Just "leaderboard-position")+        dlbmDecTime <-+          fmap mkDiff+            . parseTimeM True defaultTimeLocale "%b %d  %H:%M:%S"+            . T.unpack+            . fst+            =<< findTag uni "span" (Just "leaderboard-time")+        dlbmUser <- eitherUser tr+        pure DLBM{..}+        where+          dlbmLink = lookup "href" . snd =<< findTag uni "a" Nothing+          dlbmSupporter = "AoC++" `T.isInfixOf` contents+          dlbmImage = lookup "src" . snd =<< findTag uni "img" Nothing+          tr = H.parseTree contents+          uni = H.universeTree tr+      assembleDLB = flipper . snd . foldl' (uncurry go) (Nothing, DLB M.empty M.empty)+        where+          flipper dlb@(DLB a b)+            | M.null a = DLB b a+            | otherwise = dlb+          go counter dlb m@DLBM{..} = case counter of+            Nothing -> dlb2+            Just Nothing -> dlb1+            Just (Just i)+              | dlbmRank <= i -> dlb1+              | otherwise -> dlb2+            where+              dlb1 = (Just Nothing, dlb{dlbStar1 = M.insert dlbmRank m (dlbStar1 dlb)})+              dlb2 = (Just (Just dlbmRank), dlb{dlbStar2 = M.insert dlbmRank m (dlbStar2 dlb)})+      mkDiff t = t `diffLocalTime` decemberFirst+      decemberFirst = LocalTime (fromGregorian 1970 12 1) midnight  instance FromTags "div" GlobalLeaderboard where-    fromTags _ = Just . GLB . reScore . M.fromListWith (<>)-               . map (\x -> (Down (glbmScore x), x :| []))-               . mapMaybe parseMember-      where-        parseMember :: Text -> Maybe GlobalLeaderboardMember-        parseMember contents = do-            glbmScore <- readMaybe . filter isDigit . T.unpack . fst-                     =<< findTag uni "span" (Just "leaderboard-totalscore")-            glbmUser <- eitherUser tr-            pure GLBM{..}-          where-            glbmRank      = Rank 0-            glbmLink      = lookup "href" . snd =<< findTag uni "a" Nothing-            glbmSupporter = "AoC++" `T.isInfixOf` contents-            glbmImage     = lookup "src" . snd =<< findTag uni "img" Nothing-            tr  = H.parseTree contents-            uni = H.universeTree tr-        reScore = fmap (\xs -> (glbmScore (NE.head xs), xs))-                . M.fromList-                . flip evalState 0-                . traverse go-                . toList-          where-            go xs = do-              currScore <- get-              xs' <- forM xs $ \x -> x { glbmRank = Rank currScore } <$ modify succ-              pure (Rank currScore, xs')+  fromTags _ =+    Just+      . GLB+      . reScore+      . M.fromListWith (<>)+      . map (\x -> (Down (glbmScore x), x :| []))+      . mapMaybe parseMember+    where+      parseMember :: Text -> Maybe GlobalLeaderboardMember+      parseMember contents = do+        glbmScore <-+          readMaybe . filter isDigit . T.unpack . fst+            =<< findTag uni "span" (Just "leaderboard-totalscore")+        glbmUser <- eitherUser tr+        pure GLBM{..}+        where+          glbmRank = Rank 0+          glbmLink = lookup "href" . snd =<< findTag uni "a" Nothing+          glbmSupporter = "AoC++" `T.isInfixOf` contents+          glbmImage = lookup "src" . snd =<< findTag uni "img" Nothing+          tr = H.parseTree contents+          uni = H.universeTree tr+      reScore =+        fmap (\xs -> (glbmScore (NE.head xs), xs))+          . M.fromList+          . flip evalState 0+          . traverse go+          . toList+        where+          go xs = do+            currScore <- get+            xs' <- forM xs $ \x -> x{glbmRank = Rank currScore} <$ modify succ+            pure (Rank currScore, xs')  instance FromTags "script" NextDayTime where-    fromTags _ = (<|> Just NoNextDayTime) . listToMaybe . mapMaybe findNDT-      where-        -- var server_eta = 25112;-        -- var key = "2020-15-"+server_eta;-        findNDT body = do-          eta    <- T.unpack <$> grabKey "server_eta" body-          yd     <- grabKey "key" body-          sec    <- readMaybe eta-          dayStr <- listToMaybe . drop 1 . T.splitOn "-" $ yd-          dy     <- mkDay =<< readMaybe (T.unpack dayStr)-          pure $ NextDayTime dy sec-        grabKey t str =-            fst . T.breakOn ";\n" <$> T.stripPrefix t' (snd (T.breakOn t' str))-          where-            t' = "var " <> t <> " = "+  fromTags _ = (<|> Just NoNextDayTime) . listToMaybe . mapMaybe findNDT+    where+      -- var server_eta = 25112;+      -- var key = "2020-15-"+server_eta;+      findNDT body = do+        eta <- T.unpack <$> grabKey "server_eta" body+        yd <- grabKey "key" body+        sec <- readMaybe eta+        dayStr <- listToMaybe . drop 1 . T.splitOn "-" $ yd+        dy <- mkDay =<< readMaybe (T.unpack dayStr)+        pure $ NextDayTime dy sec+      grabKey t str =+        fst . T.breakOn ";\n" <$> T.stripPrefix t' (snd (T.breakOn t' str))+        where+          t' = "var " <> t <> " = "  instance FromTags "pre" Stats where-    fromTags _ = listToMaybe . mapMaybe parseStats+  fromTags _ = listToMaybe . mapMaybe parseStats  -- | 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-    { _auaRepo :: Text      -- ^ repository where your code is hosted-    , _auaEmail :: Text     -- ^ email address or contact-    }+  { _auaRepo :: Text+  -- ^ repository where your code is hosted+  , _auaEmail :: Text+  -- ^ email address or contact+  }   deriving (Show)  instance ToHttpApiData AoCUserAgent where   toQueryParam AoCUserAgent{..} = _auaRepo <> " " <> _auaEmail --- | REST API of Advent of Code.+-- | An AoC @session@ cookie value. See README and docs for how to get this. ----- Note that most of these requests assume a "session=" cookie.+-- @since 0.2.12.0+newtype SessionKey = SessionKey {getSessionKey :: Text}+  deriving (Show, Eq, Ord)++instance ToHttpApiData SessionKey where+  toQueryParam (SessionKey s) = "session=" <> s++-- | Placeholder used when a 'Required' 'SessionKey' is needed but none was+-- given.+dummyToken :: SessionKey+dummyToken = SessionKey T.empty++-- | REST API of Advent of Code. type AdventAPI =-      Header "User-Agent" AoCUserAgent-   :> Capture "year" Integer-   :> (Get '[Scripts] NextDayTime-  :<|> "stats" :> Get '[Pres] Stats-  :<|> "day" :> Capture "day" Day-             :> (Get '[Articles] (Map Part Text)-            :<|> "input" :> Get '[RawText] Text-            :<|> "answer"-                     :> ReqBody '[FormUrlEncoded] SubmitInfo-                     :> Post    '[Articles] (Text :<|> SubmitRes)+  Header "User-Agent" AoCUserAgent+    :> Capture "year" Integer+    :> ( Get '[Scripts] NextDayTime+           :<|> "stats" :> Get '[Pres] Stats+           :<|> "day"+             :> Capture "day" Day+             :> ( Header "Cookie" SessionKey+                    :> Get '[Articles] (Map Part Text)+                    :<|> "input"+                      :> Header' '[Required, Strict] "Cookie" SessionKey+                      :> Get '[RawText] Text+                    :<|> "answer"+                      :> Header' '[Required, Strict] "Cookie" SessionKey+                      :> 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-       ))-      )-+           :<|> ( "leaderboard"+                    :> ( Get '[Divs] GlobalLeaderboard+                           :<|> "day" :> Capture "day" Day :> Get '[Divs] DailyLeaderboard+                           :<|> "private"+                             :> "view"+                             :> Header' '[Required, Strict] "Cookie" SessionKey+                             :> Capture "code" PublicCode+                             :> Get '[JSON] Leaderboard+                       )+                )+       )  -- | 'Proxy' used for /servant/ functions. adventAPI :: Proxy AdventAPI adventAPI = Proxy  -- | 'ClientM' requests based on 'AdventAPI', generated by servant.-adventAPIClient-    :: Maybe AoCUserAgent-    -> Integer-    -> ClientM NextDayTime-  :<|> ClientM Stats-  :<|> (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+    :<|> ClientM Stats+    :<|> ( Day ->+           (Maybe SessionKey -> ClientM (Map Part Text))+             :<|> (SessionKey -> ClientM Text)+             :<|> (SessionKey -> SubmitInfo -> ClientM (Text :<|> SubmitRes))+         )+    :<|> ClientM GlobalLeaderboard+    :<|> (Day -> ClientM DailyLeaderboard)+    :<|> (SessionKey -> PublicCode -> ClientM Leaderboard) adventAPIClient = client 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 ->+  (Maybe SessionKey -> ClientM (Map Part Text))+    :<|> (SessionKey -> ClientM Text)+    :<|> (SessionKey -> SubmitInfo -> ClientM (Text :<|> SubmitRes)) adventAPIPuzzleClient aua y = pis   where     _ :<|> _ :<|> pis :<|> _ = adventAPIClient aua y@@ -302,15 +340,15 @@ parseStats = fmap M.fromList . traverse parseStatLine . filter asBranch . H.parseTree   where     asBranch TagBranch{} = True-    asBranch _           = False+    asBranch _ = False  parseStatLine :: TagTree Text -> Maybe (Day, DayStats) parseStatLine (TagBranch _ _ cs) = do-    dayTxt <- listToMaybe [t | TagLeaf (H.TagText t) <- cs, not (T.null (T.strip t))]-    dy     <- mkDay =<< readMaybe (T.unpack (T.strip dayTxt))-    gold   <- findNum "stats-both" cs-    silver <- findNum "stats-firstonly" cs-    pure (dy, DayStats gold silver)+  dayTxt <- listToMaybe [t | TagLeaf (H.TagText t) <- cs, not (T.null (T.strip t))]+  dy <- mkDay =<< readMaybe (T.unpack (T.strip dayTxt))+  gold <- findNum "stats-both" cs+  silver <- findNum "stats-firstonly" cs+  pure (dy, DayStats gold silver)   where     findNum cls = listToMaybe . mapMaybe (go cls)     go cls (TagBranch "span" attr inner) = do@@ -323,11 +361,11 @@ innerText = T.concat . mapMaybe go . H.universeTree   where     go (TagLeaf (H.TagText t)) = Just t-    go _                       = Nothing+    go _ = Nothing  userNameNaked :: [TagTree Text] -> Maybe Text userNameNaked = (listToMaybe .) . mapMaybe $ \x -> do-  TagLeaf (H.TagText (T.strip->u)) <- Just x+  TagLeaf (H.TagText (T.strip -> u)) <- Just x   guard . not $ T.null u   pure u findTag :: [TagTree Text] -> Text -> Maybe Text -> Maybe (Text, [H.Attribute Text])@@ -337,31 +375,37 @@   forM_ cls $ \c -> guard $ ("class", c) `elem` attr   pure (H.renderTree cld, attr) eitherUser :: [TagTree Text] -> Maybe (Either Integer Text)-eitherUser tr = asum [-      Right <$> userNameNaked tr-    , fmap Right $ userNameNaked . H.parseTree . fst-               =<< findTag uni "a" Nothing-    , fmap Left  $ readMaybe . filter isDigit . T.unpack . fst-               =<< findTag uni "span" (Just "leaderboard-anon")+eitherUser tr =+  asum+    [ Right <$> userNameNaked tr+    , fmap Right $+        userNameNaked . H.parseTree . fst+          =<< findTag uni "a" Nothing+    , fmap Left $+        readMaybe . filter isDigit . T.unpack . fst+          =<< findTag uni "span" (Just "leaderboard-anon")     ]   where     uni = H.universeTree tr  -- | Process an HTML webpage into a list of all contents in the given tag -- type-processHTML-    :: String       -- ^ tag type-    -> Text         -- ^ html-    -> [Text]-processHTML tag = mapMaybe getTag-               . H.universeTree-               . H.tagTree-               . cleanTags-               . H.parseTags+processHTML ::+  -- | tag type+  String ->+  -- | html+  Text ->+  [Text]+processHTML tag =+  mapMaybe getTag+    . H.universeTree+    . H.tagTree+    . cleanTags+    . H.parseTags   where     getTag :: TagTree Text -> Maybe Text     getTag (TagBranch n _ ts) = H.renderTree ts <$ guard (n == T.pack tag)-    getTag _                  = Nothing+    getTag _ = Nothing  -- | Some days, including: --@@ -373,14 +417,15 @@ -- 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 ::+  [H.Tag str] ->+  [H.Tag str] cleanTags = flip evalState [] . mapM go   where     go t = case t of-      H.TagOpen n _ -> t <$ modify (n:)-      H.TagClose _  -> get >>= \case-        []   -> pure t-        m:ms -> H.TagClose m <$ put ms-      _             -> pure t+      H.TagOpen n _ -> t <$ modify (n :)+      H.TagClose _ ->+        get >>= \case+          [] -> pure t+          m : ms -> H.TagClose m <$ put ms+      _ -> pure t

@@ -1,5 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE RecordWildCards           #-}+{-# LANGUAGE RecordWildCards #-}  -- | -- Module      : Advent.Throttle@@ -11,50 +11,49 @@ -- Portability : non-portable -- -- (Internal) Implement cacheing of API requests.- module Advent.Cache (-    cacheing-  , SaverLoader(..)-  , noCache-  ) where+  cacheing,+  SaverLoader (..),+  noCache,+) where -import           Control.DeepSeq-import           Control.Exception-import           Control.Monad-import           Control.Monad.IO.Class-import           Data.Text              (Text)-import           System.Directory-import           System.FilePath-import           System.IO.Error-import qualified Data.Text.IO           as T+import Control.DeepSeq+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.Text (Text)+import qualified Data.Text.IO as T+import System.Directory+import System.FilePath+import System.IO.Error -data SaverLoader a =-     SL { _slSave :: a -> Maybe Text-        , _slLoad :: Text -> Maybe a-        }+data SaverLoader a+  = SL+  { _slSave :: a -> Maybe Text+  , _slLoad :: Text -> Maybe a+  }  noCache :: SaverLoader a noCache = SL (const Nothing) (const Nothing) -cacheing-    :: MonadIO m-    => FilePath-    -> SaverLoader a-    -> m a-    -> m a+cacheing ::+  MonadIO m =>+  FilePath ->+  SaverLoader a ->+  m a ->+  m a cacheing fp SL{..} act = do-    old <- liftIO $ do-      createDirectoryIfMissing True (takeDirectory fp)-      (_slLoad =<<) <$> readFileMaybe fp-    case old of-      Nothing -> do-        r <- act-        liftIO . mapM_ (T.writeFile fp) $ _slSave r-        pure r-      Just o  -> pure o+  old <- liftIO $ do+    createDirectoryIfMissing True (takeDirectory fp)+    (_slLoad =<<) <$> readFileMaybe fp+  case old of+    Nothing -> do+      r <- act+      liftIO . mapM_ (T.writeFile fp) $ _slSave r+      pure r+    Just o -> pure o  readFileMaybe :: FilePath -> IO (Maybe Text) readFileMaybe =-     (traverse (evaluate . force) . either (const Nothing) Just =<<)-   . tryJust (guard . isDoesNotExistError)-   . T.readFile+  (traverse (evaluate . force) . either (const Nothing) Just)+    <=< (tryJust (guard . isDoesNotExistError) . T.readFile)

@@ -1,6 +1,6 @@-{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections   #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module      : Advent.Throttle@@ -12,34 +12,34 @@ -- Portability : non-portable -- -- (Internal) Implement throttling of API requests.- module Advent.Throttle (-    Throttler-  , newThrottler-  , throttling-  , setLimit-  , getLimit-  ) where+  Throttler,+  newThrottler,+  throttling,+  setLimit,+  getLimit,+) where -import           Control.Concurrent-import           Control.Exception-import           Data.IORef+import Control.Concurrent+import Control.Exception+import Data.IORef -data Throttler = Throt { _throtSem     :: QSem-                       , _throtWaiting :: IORef Int-                       , _throtLim     :: IORef Int-                       }+data Throttler = Throt+  { _throtSem :: QSem+  , _throtWaiting :: IORef Int+  , _throtLim :: IORef Int+  }  acquireThrottler :: Throttler -> IO Bool acquireThrottler Throt{..} = do-    currWait <- readIORef _throtWaiting-    throtLim <- readIORef _throtLim-    if currWait >= throtLim-      then pure False-      else do-        atomicModifyIORef' _throtWaiting ((,()) . (+1))-        waitQSem _throtSem `finally` atomicModifyIORef' _throtWaiting ((,()) . subtract 1)-        pure True+  currWait <- readIORef _throtWaiting+  throtLim <- readIORef _throtLim+  if currWait >= throtLim+    then pure False+    else do+      atomicModifyIORef' _throtWaiting ((,()) . (+ 1))+      waitQSem _throtSem `finally` atomicModifyIORef' _throtWaiting ((,()) . subtract 1)+      pure True  releaseThrottler :: Throttler -> IO () releaseThrottler Throt{..} = signalQSem _throtSem@@ -55,30 +55,35 @@ -- | Create a new 'Throttler' with a given maximum capacity. newThrottler :: Int -> IO Throttler newThrottler n = do-    s <- newQSem 1-    w <- newIORef 0-    l <- newIORef n-    pure Throt-      { _throtSem     = s+  s <- newQSem 1+  w <- newIORef 0+  l <- newIORef n+  pure+    Throt+      { _throtSem = s       , _throtWaiting = w-      , _throtLim     = l+      , _throtLim = l       }  -- | Perform an IO action with the given 'Throttler' and delay.  The IO -- action will "wait in line" and be performed when the line is clear.  The -- IO action will delay the next incoming IO action by the delay amount -- given.-throttling-    :: Throttler-    -> Int                  -- ^ delay (in milliseconds)-    -> IO a-    -> IO (Maybe a)-throttling throt delay act = bracketOnError (acquireThrottler throt)-                                            (const (releaseThrottler throt)) $ \case+throttling ::+  Throttler ->+  -- | delay (in milliseconds)+  Int ->+  IO a ->+  IO (Maybe a)+throttling throt delay act = bracketOnError+  (acquireThrottler throt)+  (const (releaseThrottler throt))+  $ \case     False -> pure Nothing-    True  -> Just <$> do-      res <- act-      _ <- forkIO $ do-        threadDelay delay-        releaseThrottler throt-      pure res+    True ->+      Just <$> do+        res <- act+        _ <- forkIO $ do+          threadDelay delay+          releaseThrottler throt+        pure res

@@ -1,18 +1,17 @@-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DataKinds                  #-}-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase                 #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE PatternSynonyms            #-}-{-# LANGUAGE PolyKinds                  #-}-{-# LANGUAGE RecordWildCards            #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-# LANGUAGE TypeOperators              #-}-{-# LANGUAGE ViewPatterns               #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}  -- | -- Module      : Advent.Types@@ -26,66 +25,69 @@ -- Data types used for the underlying API. -- -- @since 0.2.3.0---- module Advent.Types (   -- * Types-    Day(..)-  , Part(..)-  , SubmitInfo(..)-  , SubmitRes(..), showSubmitRes-  , PublicCode(..)-  , Leaderboard(..)-  , LeaderboardMember(..)-  , Rank(..)-  , DailyLeaderboard(..)-  , DailyLeaderboardMember(..)-  , GlobalLeaderboard(..)-  , GlobalLeaderboardMember(..)-  , NextDayTime(..)-  , DayStats(..)-  , Stats+  Day (..),+  Part (..),+  SubmitInfo (..),+  SubmitRes (..),+  showSubmitRes,+  PublicCode (..),+  Leaderboard (..),+  LeaderboardMember (..),+  Rank (..),+  DailyLeaderboard (..),+  DailyLeaderboardMember (..),+  GlobalLeaderboard (..),+  GlobalLeaderboardMember (..),+  NextDayTime (..),+  DayStats (..),+  Stats,+   -- * Util-  , mkDay, mkDay_, dayInt-  , _DayInt, pattern DayInt-  , partInt-  , partChar-  , fullDailyBoard-  , dlbmCompleteTime-  , dlbmTime-  , challengeReleaseTime+  mkDay,+  mkDay_,+  dayInt,+  _DayInt,+  pattern DayInt,+  partInt,+  partChar,+  fullDailyBoard,+  dlbmCompleteTime,+  dlbmTime,+  challengeReleaseTime,+   -- * Internal-  , parseSubmitRes-  ) where+  parseSubmitRes,+) where -import           Control.Applicative-import           Data.Aeson-import           Data.Aeson.Types-import           Data.Bifunctor-import           Data.Char-import           Data.Finite-import           Data.Functor.Classes-import           Data.List.NonEmpty         (NonEmpty(..))-import           Data.Map                   (Map)-import           Data.Maybe-import           Data.Profunctor-import           Data.Text                  (Text)-import           Data.Time hiding           (Day)-import           Data.Time.Clock.POSIX-import           Data.Typeable-import           Data.Void-import           GHC.Generics-import           Servant.API-import           Text.Printf-import           Text.Read                  (readMaybe)-import qualified Data.Map                   as M-import qualified Data.Text                  as T-import qualified Text.HTML.TagSoup          as H-import qualified Text.Megaparsec            as P-import qualified Text.Megaparsec.Char       as P+import Control.Applicative+import Data.Aeson+import Data.Aeson.Types+import Data.Bifunctor+import Data.Char+import Data.Finite+import Data.Functor.Classes+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe+import Data.Profunctor+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time hiding (Day)+import Data.Time.Clock.POSIX+import Data.Typeable+import Data.Void+import GHC.Generics+import Servant.API+import qualified Text.HTML.TagSoup as H+import qualified Text.Megaparsec as P+import qualified Text.Megaparsec.Char as P import qualified Text.Megaparsec.Char.Lexer as P-import qualified Web.FormUrlEncoded         as WF-+import Text.Printf+import Text.Read (readMaybe)+import qualified Web.FormUrlEncoded as WF  #if !MIN_VERSION_base(4,16,0) import           Data.Foldable              (asum)@@ -103,11 +105,11 @@ -- -- Represented by a 'Finite' ranging from 0 to 24 inclusive; you should -- probably make one using the smart constructor 'mkDay'.-newtype Day = Day { dayFinite :: Finite 25 }+newtype Day = Day {dayFinite :: Finite 25}   deriving (Eq, Ord, Enum, Bounded, Typeable, Generic)  instance Show Day where-    showsPrec = showsUnaryWith (\d -> showsPrec d . dayInt) "mkDay"+  showsPrec = showsUnaryWith (\d -> showsPrec d . dayInt) "mkDay"  -- | A given part of a problem.  All Advent of Code challenges are -- two-parts.@@ -119,30 +121,30 @@  -- | Info required to submit an answer for a part. data SubmitInfo = SubmitInfo-    { siLevel  :: Part-    , siAnswer :: String-    }+  { siLevel :: Part+  , siAnswer :: String+  }   deriving (Show, Read, Eq, Ord, Typeable, Generic)  -- | The result of a submission. data SubmitRes-    -- | Correct submission, including global rank (if reported, which+  = -- | Correct submission, including global rank (if reported, which     -- usually happens if rank is under 1000)-    = SubCorrect (Maybe Integer)-    -- | Incorrect submission.  Contains the number of /seconds/ you must+    SubCorrect (Maybe Integer)+  | -- | Incorrect submission.  Contains the number of /seconds/ you must     -- wait before trying again.  The 'Maybe' contains possible hints given     -- by the server (usually "too low" or "too high").-    | SubIncorrect Int (Maybe String)-    -- | Submission was rejected because an incorrect submission was+    SubIncorrect Int (Maybe String)+  | -- | Submission was rejected because an incorrect submission was     -- recently submitted.  Contains the number of /seconds/ you must wait     -- before trying again.-    | SubWait Int-    -- | Submission was rejected because it was sent to an invalid question+    SubWait Int+  | -- | Submission was rejected because it was sent to an invalid question     -- or part.  Usually happens if you submit to a part you have already     -- answered or have not yet unlocked.-    | SubInvalid-    -- | Could not parse server response.  Contains parse error.-    | SubUnknown String+    SubInvalid+  | -- | Could not parse server response.  Contains parse error.+    SubUnknown String   deriving (Show, Read, Eq, Ord, Typeable, Generic)  -- | Member ID of public leaderboard (the first part of the registration@@ -151,27 +153,50 @@ -- > https://adventofcode.com/2019/leaderboard/private/view/12345 -- -- (the @12345@ above)-newtype PublicCode = PublicCode { getPublicCode :: Integer }+newtype PublicCode = PublicCode {getPublicCode :: Integer}   deriving (Show, Read, Eq, Ord, Typeable, Generic)  -- | Leaderboard type, representing private leaderboard information. data Leaderboard = LB-    { lbEvent   :: Integer                        -- ^ The year of the event-    , lbOwnerId :: Integer                        -- ^ The Member ID of the owner, or the public code-    , lbMembers :: Map Integer LeaderboardMember  -- ^ A map from member IDs to their leaderboard info-    }+  { lbEvent :: Integer+  -- ^ The year of the event+  , lbOwnerId :: Integer+  -- ^ The Member ID of the owner, or the public code+  , lbMembers :: Map Integer LeaderboardMember+  -- ^ A map from member IDs to their leaderboard info+  , lbNumDays :: Int+  -- ^ The number of days in this event: 25 for+  --   years before 2025, 12 from 2025 onward.+  --+  --   @since 0.2.12.0+  , lbDay1Ts :: UTCTime+  -- ^ Release time of day 1 for this event.+  --+  --   @since 0.2.12.0+  }   deriving (Show, Eq, Ord, Typeable, Generic)  -- | Leaderboard position for a given member. data LeaderboardMember = LBM-    { lbmGlobalScore :: Maybe Integer               -- ^ Global leaderboard score-    , lbmName        :: Maybe Text                  -- ^ Username, if user specifies one-    , lbmLocalScore  :: Integer                     -- ^ Score for this leaderboard-    , lbmId          :: Integer                     -- ^ Member ID-    , lbmLastStarTS  :: Maybe UTCTime               -- ^ Time of last puzzle solved, if any-    , lbmStars       :: Int                         -- ^ Number of stars (puzzle parts) solved-    , lbmCompletion  :: Map Day (Map Part UTCTime)  -- ^ Completion times of each day and puzzle part-    }+  { lbmGlobalScore :: Maybe Integer+  -- ^ Global leaderboard score+  , lbmName :: Maybe Text+  -- ^ Username, if user specifies one+  , lbmLocalScore :: Integer+  -- ^ Score for this leaderboard+  , lbmId :: Integer+  -- ^ Member ID+  , lbmLastStarTS :: Maybe UTCTime+  -- ^ Time of last puzzle solved, if any+  , lbmStars :: Int+  -- ^ Number of stars (puzzle parts) solved+  , lbmCompletion :: Map Day (Map Part UTCTime)+  -- ^ Completion times of each day and puzzle part+  , lbmStarIndex :: Map Day (Map Part Int)+  -- ^ Board-wide chronological sequence number of+  --   each completion, in the same shape as+  --   'lbmCompletion'.+  }   deriving (Show, Eq, Ord, Typeable, Generic)  -- | Ranking between 1 to 100, for daily and global leaderboards@@ -180,25 +205,25 @@ -- to add or subtract accordingly if you want to display or parse it. -- -- @since 0.2.3.0-newtype Rank = Rank { getRank :: Finite 100 }+newtype Rank = Rank {getRank :: Finite 100}   deriving (Show, Eq, Ord, Typeable, Generic)  -- | Single daily leaderboard position -- -- @since 0.2.3.0 data DailyLeaderboardMember = DLBM-    { dlbmRank      :: Rank-    -- | Time from midnight EST of December 1st for that event.  Use-    -- 'dlbmCompleteTime' to convert to an actual time for event-    -- completion, and 'dlbmTime' to get the time it took to solve.-    ---    -- @since 0.2.7.0-    , dlbmDecTime   :: NominalDiffTime      -- ^ time from midnight EST.-    , dlbmUser      :: Either Integer Text-    , dlbmLink      :: Maybe Text-    , dlbmImage     :: Maybe Text-    , dlbmSupporter :: Bool-    }+  { dlbmRank :: Rank+  , dlbmDecTime :: NominalDiffTime+  -- ^ Time from midnight EST of December 1st for that event.  Use+  -- 'dlbmCompleteTime' to convert to an actual time for event+  -- completion, and 'dlbmTime' to get the time it took to solve.+  --+  -- @since 0.2.7.0+  , dlbmUser :: Either Integer Text+  , dlbmLink :: Maybe Text+  , dlbmImage :: Maybe Text+  , dlbmSupporter :: Bool+  }   deriving (Show, Eq, Ord, Typeable, Generic)  -- | Turn a 'dlbmDecTime' field into a 'ZonedTime' for the actual@@ -206,7 +231,8 @@ -- -- @since 0.2.7.0 dlbmCompleteTime :: Integer -> Day -> NominalDiffTime -> ZonedTime-dlbmCompleteTime y d t = r+dlbmCompleteTime y d t =+  r     { zonedTimeToLocalTime = dlbmTime d t `addLocalTime` zonedTimeToLocalTime r     }   where@@ -217,15 +243,16 @@ -- -- @since 0.2.7.0 dlbmTime :: Day -> NominalDiffTime -> NominalDiffTime-dlbmTime d = uncurry daysAndTimeOfDayToTime-           . first (subtract (dayInt d - 1))-           . timeToDaysAndTimeOfDay+dlbmTime d =+  uncurry daysAndTimeOfDayToTime+    . first (subtract (dayInt d - 1))+    . timeToDaysAndTimeOfDay  -- | Daily leaderboard, containing Star 1 and Star 2 completions -- -- @since 0.2.3.0-data DailyLeaderboard = DLB {-    dlbStar1 :: Map Rank DailyLeaderboardMember+data DailyLeaderboard = DLB+  { dlbStar1 :: Map Rank DailyLeaderboardMember   , dlbStar2 :: Map Rank DailyLeaderboardMember   }   deriving (Show, Eq, Ord, Typeable, Generic)@@ -234,13 +261,13 @@ -- -- @since 0.2.3.0 data GlobalLeaderboardMember = GLBM-    { glbmRank      :: Rank-    , glbmScore     :: Integer-    , glbmUser      :: Either Integer Text-    , glbmLink      :: Maybe Text-    , glbmImage     :: Maybe Text-    , glbmSupporter :: Bool-    }+  { glbmRank :: Rank+  , glbmScore :: Integer+  , glbmUser :: Either Integer Text+  , glbmLink :: Maybe Text+  , glbmImage :: Maybe Text+  , glbmSupporter :: Bool+  }   deriving (Show, Eq, Ord, Typeable, Generic)  -- | Global leaderboard for the entire event@@ -249,8 +276,8 @@ -- a non-empty list of all members who achieved that rank and score. -- -- @since 0.2.3.0-newtype GlobalLeaderboard = GLB {-    glbMap :: Map Rank (Integer, NonEmpty GlobalLeaderboardMember)+newtype GlobalLeaderboard = GLB+  { glbMap :: Map Rank (Integer, NonEmpty GlobalLeaderboardMember)   }   deriving (Show, Eq, Ord, Typeable, Generic) @@ -258,17 +285,20 @@ -- seconds until the challenge is released. -- -- @since 0.2.8.0-data NextDayTime = NextDayTime Day Int-                 | NoNextDayTime+data NextDayTime+  = NextDayTime Day Int+  | NoNextDayTime   deriving (Show, Eq, Ord, Typeable, Generic)  -- | Stats for a single day on the event stats page. -- -- @since 0.2.11.0 data DayStats = DayStats-    { dsGold   :: Integer   -- ^ Users who completed both parts-    , dsSilver :: Integer   -- ^ Users who only completed the first part-    }+  { dsGold :: Integer+  -- ^ Users who completed both parts+  , dsSilver :: Integer+  -- ^ Users who only completed the first part+  }   deriving (Show, Read, Eq, Ord, Typeable, Generic)  -- | Stats for all days on the event stats page.@@ -277,145 +307,191 @@ type Stats = Map Day DayStats  instance ToHttpApiData Part where-    toUrlPiece = T.pack . show . partInt-    toQueryParam = toUrlPiece+  toUrlPiece = T.pack . show . partInt+  toQueryParam = toUrlPiece  instance ToHttpApiData Day where-    toUrlPiece = T.pack . show . dayInt-    toQueryParam = toUrlPiece+  toUrlPiece = T.pack . show . dayInt+  toQueryParam = toUrlPiece  instance ToHttpApiData PublicCode where-    toUrlPiece   = (<> ".json") . T.pack . show . getPublicCode-    toQueryParam = toUrlPiece+  toUrlPiece = (<> ".json") . T.pack . show . getPublicCode+  toQueryParam = toUrlPiece  instance WF.ToForm SubmitInfo where-    toForm = WF.genericToForm WF.FormOptions-      { WF.fieldLabelModifier = camelTo2 '-' . drop 2 }+  toForm =+    WF.genericToForm+      WF.FormOptions+        { WF.fieldLabelModifier = camelTo2 '-' . drop 2+        }  instance FromJSON Leaderboard where-    parseJSON = withObject "Leaderboard" $ \o ->-        LB <$> (strInt =<< (o .: "event"))-           <*> o .: "owner_id"-           <*> o .: "members"-      where-        strInt t = case readMaybe t of-          Nothing -> fail "bad int"-          Just i  -> pure i+  parseJSON = withObject "Leaderboard" $ \o ->+    LB+      <$> (strInt =<< (o .: "event"))+      <*> o .: "owner_id"+      <*> o .: "members"+      <*> o .: "num_days"+      <*> ( (fromEpochText =<< (o .: "day1_ts"))+              <|> (fromEpochNumber <$> (o .: "day1_ts"))+          )+    where+      strInt t = case readMaybe t of+        Nothing -> fail "bad int"+        Just i -> pure i  instance FromJSON LeaderboardMember where-    parseJSON = withObject "LeaderboardMember" $ \o ->-        LBM <$> optional (o .: "global_score")-            <*> optional (o .: "name")-            <*> o .: "local_score"-            <*> o .: "id"-            <*> optional (-                    (fromEpochText   =<< (o .: "last_star_ts"))-                <|> (fromEpochNumber <$> (o .: "last_star_ts"))-                )-            <*> o .: "stars"-            <*> (do cdl <- o .: "completion_day_level"-                    (traverse . traverse) (\c ->-                          (fromEpochText   =<< (c .: "get_star_ts"))-                      <|> (fromEpochNumber <$> (c .: "get_star_ts"))-                      ) cdl-                )-      where-        fromEpochText t = case readMaybe t of-          Nothing -> fail "bad stamp"-          Just i  -> pure . posixSecondsToUTCTime $ fromInteger i-        fromEpochNumber = posixSecondsToUTCTime+  parseJSON = withObject "LeaderboardMember" $ \o -> do+    cdl <- o .: "completion_day_level"+    LBM+      <$> optional (o .: "global_score")+      <*> optional (o .: "name")+      <*> o .: "local_score"+      <*> o .: "id"+      <*> optional+        ( (fromEpochText =<< (o .: "last_star_ts"))+            <|> (fromEpochNumber <$> (o .: "last_star_ts"))+        )+      <*> o .: "stars"+      <*> (traverse . traverse)+        ( \c ->+            (fromEpochText =<< (c .: "get_star_ts"))+              <|> (fromEpochNumber <$> (c .: "get_star_ts"))+        )+        cdl+      <*> (traverse . traverse) (.: "star_index") cdl +fromEpochText :: String -> Parser UTCTime+fromEpochText t = case readMaybe t of+  Nothing -> fail "bad stamp"+  Just i -> pure . posixSecondsToUTCTime $ fromInteger i++fromEpochNumber :: NominalDiffTime -> UTCTime+fromEpochNumber = posixSecondsToUTCTime+ -- | @since 0.2.4.2 instance ToJSONKey Day where-    toJSONKey = toJSONKeyText $ T.pack . show . dayInt+  toJSONKey = toJSONKeyText $ T.pack . show . dayInt+ instance FromJSONKey Day where-    fromJSONKey = FromJSONKeyTextParser (parseJSON . String)+  fromJSONKey = FromJSONKeyTextParser (parseJSON . String)+ -- | @since 0.2.4.2 instance ToJSONKey Part where-    toJSONKey = toJSONKeyText $ \case-      Part1 -> "1"-      Part2 -> "2"+  toJSONKey = toJSONKeyText $ \case+    Part1 -> "1"+    Part2 -> "2"+ instance FromJSONKey Part where-    fromJSONKey = FromJSONKeyTextParser (parseJSON . String)+  fromJSONKey = FromJSONKeyTextParser (parseJSON . String)  -- | @since 0.2.4.2 instance ToJSON Part where-    toJSON = String . (\case Part1 -> "1"; Part2 -> "2")+  toJSON = String . (\case Part1 -> "1"; Part2 -> "2")+ instance FromJSON Part where-    parseJSON = withText "Part" $ \case-      "1" -> pure Part1-      "2" -> pure Part2-      _   -> fail "Bad part"+  parseJSON = withText "Part" $ \case+    "1" -> pure Part1+    "2" -> pure Part2+    _ -> fail "Bad part"  -- | @since 0.2.4.2 instance ToJSON Day where-    toJSON = String . T.pack . show . dayInt+  toJSON = String . T.pack . show . dayInt+ instance FromJSON Day where-    parseJSON = withText "Day" $ \t ->-      case readMaybe (T.unpack t) of-        Nothing -> fail "No read day"-        Just i  -> case mkDay i of-          Nothing -> fail "Day out of range"-          Just d  -> pure d+  parseJSON = withText "Day" $ \t ->+    case readMaybe (T.unpack t) of+      Nothing -> fail "No read day"+      Just i -> case mkDay i of+        Nothing -> fail "Day out of range"+        Just d -> pure d  instance ToJSONKey Rank where-    toJSONKey = toJSONKeyText $ T.pack . show . (+ 1) . getFinite . getRank+  toJSONKey = toJSONKeyText $ T.pack . show . (+ 1) . getFinite . getRank instance FromJSONKey Rank where-    fromJSONKey = FromJSONKeyTextParser (parseJSON . String)+  fromJSONKey = FromJSONKeyTextParser (parseJSON . String)  instance ToJSON Rank where-    toJSON = String . T.pack . show . (+ 1) . getFinite . getRank+  toJSON = String . T.pack . show . (+ 1) . getFinite . getRank instance FromJSON Rank where-    parseJSON = withText "Rank" $ \t ->-      case readMaybe (T.unpack t) of-        Nothing -> fail "No read rank"-        Just i  -> case packFinite (i - 1) of-          Nothing -> fail "Rank out of range"-          Just d  -> pure $ Rank d+  parseJSON = withText "Rank" $ \t ->+    case readMaybe (T.unpack t) of+      Nothing -> fail "No read rank"+      Just i -> case packFinite (i - 1) of+        Nothing -> fail "Rank out of range"+        Just d -> pure $ Rank d  instance ToJSON DailyLeaderboard where-    toJSON = genericToJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 3 }+  toJSON =+    genericToJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 3+        } instance FromJSON DailyLeaderboard where-    parseJSON = genericParseJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 3 }+  parseJSON =+    genericParseJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 3+        }  instance ToJSON GlobalLeaderboard where-    toJSON = genericToJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 3 }+  toJSON =+    genericToJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 3+        } instance FromJSON GlobalLeaderboard where-    parseJSON = genericParseJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 3 }+  parseJSON =+    genericParseJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 3+        }  instance ToJSON DailyLeaderboardMember where-    toJSON = genericToJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 4 }+  toJSON =+    genericToJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 4+        } instance FromJSON DailyLeaderboardMember where-    parseJSON = genericParseJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 4 }+  parseJSON =+    genericParseJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 4+        }  instance ToJSON GlobalLeaderboardMember where-    toJSON = genericToJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 4 }+  toJSON =+    genericToJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 4+        } instance FromJSON GlobalLeaderboardMember where-    parseJSON = genericParseJSON defaultOptions-        { fieldLabelModifier = camelTo2 '-' . drop 4 }+  parseJSON =+    genericParseJSON+      defaultOptions+        { fieldLabelModifier = camelTo2 '-' . drop 4+        }  -- | Parse 'T.Text' into a 'SubmitRes'. parseSubmitRes :: Text -> SubmitRes-parseSubmitRes = either (SubUnknown . P.errorBundlePretty) id-               . P.runParser choices "Submission Response"-               . mconcat-               . mapMaybe deTag-               . H.parseTags+parseSubmitRes =+  either (SubUnknown . P.errorBundlePretty) id+    . P.runParser choices "Submission Response"+    . mconcat+    . mapMaybe deTag+    . H.parseTags   where     deTag (H.TagText t) = Just t-    deTag _             = Nothing-    choices             = asum [ P.try parseCorrect   P.<?> "Correct"-                               , P.try parseIncorrect P.<?> "Incorrect"-                               , P.try parseWait      P.<?> "Wait"-                               ,       parseInvalid   P.<?> "Invalid"-                               ]+    deTag _ = Nothing+    choices =+      asum+        [ P.try parseCorrect P.<?> "Correct"+        , P.try parseIncorrect P.<?> "Incorrect"+        , P.try parseWait P.<?> "Wait"+        , parseInvalid P.<?> "Invalid"+        ]     parseCorrect :: P.Parsec Void Text SubmitRes     parseCorrect = do       _ <- P.manyTill P.anySingle (P.string' "that's the right answer") P.<?> "Right answer"@@ -435,8 +511,9 @@     parseWait = do       _ <- P.manyTill P.anySingle (P.string' "an answer too recently") P.<?> "An answer too recently"       P.skipMany (P.satisfy (not . isDigit))-      m <- optional . (P.<?> "Delay minutes") . P.try $-              P.decimal <* P.char 'm' <* P.space1+      m <-+        optional . (P.<?> "Delay minutes") . P.try $+          P.decimal <* P.char 'm' <* P.space1       s <- P.decimal <* P.char 's' P.<?> "Delay seconds"       pure . SubWait $ maybe 0 (* 60) m + s     parseInvalid = SubInvalid <$ P.manyTill P.anySingle (P.string' "solving the right level")@@ -444,14 +521,15 @@ -- | Pretty-print a 'SubmitRes' showSubmitRes :: SubmitRes -> String showSubmitRes = \case-    SubCorrect Nothing    -> "Correct"-    SubCorrect (Just r)   -> printf "Correct (Rank %d)" r-    SubIncorrect i Nothing  -> printf "Incorrect (%d minute wait)" (i `div` 60)-    SubIncorrect i (Just h) -> printf "Incorrect (%s) (%d minute wait)" h (i `div` 60)-    SubWait i             -> let (m,s) = i `divMod` 60-                             in   printf "Wait (%d min %d sec wait)"  m s-    SubInvalid            -> "Invalid"-    SubUnknown r          -> printf "Unknown (%s)" r+  SubCorrect Nothing -> "Correct"+  SubCorrect (Just r) -> printf "Correct (Rank %d)" r+  SubIncorrect i Nothing -> printf "Incorrect (%d minute wait)" (i `div` 60)+  SubIncorrect i (Just h) -> printf "Incorrect (%s) (%d minute wait)" h (i `div` 60)+  SubWait i ->+    let (m, s) = i `divMod` 60+     in printf "Wait (%d min %d sec wait)" m s+  SubInvalid -> "Invalid"+  SubUnknown r -> printf "Unknown (%s)" r  -- | Convert a @'Finite' 25@ day into a day integer (1 - 25).  Inverse of -- 'mkDay'.@@ -489,7 +567,7 @@ _DayInt = dimap a b . right'   where     a i = maybe (Left i) Right . mkDay $ i-    b   = either pure (fmap dayInt)+    b = either pure (fmap dayInt)  -- | Pattern synonym allowing you to match on an 'Integer' as if it were -- a 'Day':@@ -504,7 +582,7 @@ -- -- @since 0.2.4.0 pattern DayInt :: Day -> Integer-pattern DayInt d <- (mkDay->Just d)+pattern DayInt d <- (mkDay -> Just d)   where     DayInt d = dayInt d @@ -517,24 +595,27 @@ -- | Check if a 'DailyLeaderboard' is filled up or not. -- -- @since 0.2.4.0-fullDailyBoard-    :: DailyLeaderboard-    -> Bool+fullDailyBoard ::+  DailyLeaderboard ->+  Bool fullDailyBoard DLB{..} = (M.size dlbStar1 + M.size dlbStar2) >= 200  -- | Prompt release time. -- -- Changed from 'UTCTime' to 'ZonedTime' in v0.2.7.0.  To use as -- a 'UTCTime', use 'zonedTimeToUTC'.-challengeReleaseTime-    :: Integer              -- ^ year-    -> Day                  -- ^ day-    -> ZonedTime-challengeReleaseTime y d = ZonedTime-    { zonedTimeToLocalTime = LocalTime-        { localDay       = fromGregorian y 12 (fromIntegral (dayInt d))-        , localTimeOfDay = midnight-        }+challengeReleaseTime ::+  -- | year+  Integer ->+  -- | day+  Day ->+  ZonedTime+challengeReleaseTime y d =+  ZonedTime+    { zonedTimeToLocalTime =+        LocalTime+          { localDay = fromGregorian y 12 (fromIntegral (dayInt d))+          , localTimeOfDay = midnight+          }     , zonedTimeZone = read "EST"     }-

@@ -1,32 +1,34 @@ {-# LANGUAGE ViewPatterns #-} -import           Advent.Types-import           Control.Monad-import           Data.List-import           System.Directory-import           System.Exit-import           System.FilePath-import           Test.HUnit-import           Text.Read        (readMaybe)-import qualified Data.Text        as T-import qualified Data.Text.IO     as T+import Advent.Types+import Control.Monad+import Data.List+import qualified Data.Text as T+import qualified Data.Text.IO as T+import System.Directory+import System.Exit+import System.FilePath+import Test.HUnit+import Text.Read (readMaybe)  fileTest :: FilePath -> IO Test fileTest fp = do-    ls <- T.lines <$> T.readFile ("test-data" </> fp)-    (T.strip->x, T.unlines->xs) <- maybe (fail "Empty test file") pure $-                                      uncons ls+  ls <- T.lines <$> T.readFile ("test-data" </> fp)+  (T.strip -> x, T.unlines -> xs) <-+    maybe (fail "Empty test file") pure $+      uncons ls -    r <- maybe (fail "No parse expected result") pure $-            readMaybe (T.unpack x)+  r <-+    maybe (fail "No parse expected result") pure $+      readMaybe (T.unpack x) -    pure . TestLabel fp $ r ~=? parseSubmitRes xs+  pure . TestLabel fp $ r ~=? parseSubmitRes xs  main :: IO () main = do-    tests <- fmap TestList-           . mapM fileTest-         =<< listDirectory "test-data"-    c <- runTestTT tests-    unless (failures c == 0) $-      exitFailure+  tests <-+    fmap TestList+      . mapM fileTest+      =<< listDirectory "test-data"+  c <- runTestTT tests+  unless (failures c == 0) exitFailure