advent-of-code-api 0.2.3.0 → 0.2.4.0
raw patch · 5 files changed
+94/−41 lines, 5 filesdep +profunctorsPVP ok
version bump matches the API change (PVP)
Dependencies added: profunctors
API changes (from Hackage documentation)
+ Advent: fullDailyBoard :: DailyLeaderboard -> Bool
+ Advent.Types: _DayInt :: (Choice p, Applicative f) => p Day (f Day) -> p Integer (f Integer)
+ Advent.Types: fullDailyBoard :: DailyLeaderboard -> Bool
Files
- CHANGELOG.md +12/−0
- advent-of-code-api.cabal +3/−2
- src/Advent.hs +8/−13
- src/Advent/API.hs +15/−20
- src/Advent/Types.hs +56/−6
CHANGELOG.md view
@@ -1,6 +1,18 @@ Changelog ========= +Version 0.2.4.0+---------------++*November 21, 2019*++<https://github.com/mstksg/advent-of-code-api/releases/tag/v0.2.4.0>++* Fixed caching behavior and documentation to reflect that Day 25 actually+ does have 2 stars, like normal.+* Some extra smart constructors for moving between `Day` and `Integer`, in+ the form of a `Prism` and a pattern synonym.+ Version 0.2.3.0 ---------------
advent-of-code-api.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d17a4d7274081d52248b30e3b0ad9dec6be3dc449140e6d4cfd85f442966d604+-- hash: d214b34991e5cecf77b64cf62b556642dba8073ebe9565990fe8c3238b2eeeae name: advent-of-code-api-version: 0.2.3.0+version: 0.2.4.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@@ -65,6 +65,7 @@ , http-media , megaparsec >=7 , mtl+ , profunctors , servant , servant-client , servant-client-core
src/Advent.hs view
@@ -63,6 +63,8 @@ , aocDay -- ** Part , partChar, partInt+ -- ** Leaderboard+ , fullDailyBoard -- ** Throttler , setAoCThrottleLimit, getAoCThrottleLimit -- * Internal@@ -382,10 +384,10 @@ -> AoC a -> SaverLoader (Either AoCError a) saverLoader evt = \case- AoCPrompt d -> SL { _slSave = either (const Nothing) (Just . encodeMap)+ AoCPrompt{} -> SL { _slSave = either (const Nothing) (Just . encodeMap) , _slLoad = \str -> let mp = decodeMap str- hasAll = S.null (expectedParts d `S.difference` M.keysSet mp)+ hasAll = S.null (expectedParts `S.difference` M.keysSet mp) in Right mp <$ guard hasAll } AoCInput{} -> SL { _slSave = either (const Nothing) Just@@ -393,12 +395,11 @@ } AoCSubmit{} -> noCache AoCLeaderboard{} -> noCache- AoCDailyLeaderboard d -> SL+ AoCDailyLeaderboard{} -> SL { _slSave = either (const Nothing) (Just . TL.toStrict . TL.decodeUtf8 . A.encode) , _slLoad = \str -> do r <- A.decode . TL.encodeUtf8 . TL.fromStrict $ str- let l = M.size (dlbStar1 r) + M.size (dlbStar2 r)- guard $ l >= fullLength d+ guard $ fullDailyBoard r pure $ Right r } AoCGlobalLeaderboard{}@@ -408,14 +409,8 @@ , _slLoad = fmap Right . A.decode . TL.encodeUtf8 . TL.fromStrict } where- expectedParts :: Day -> Set Part- expectedParts d- | d == maxBound = S.singleton Part1- | otherwise = S.fromDistinctAscList [Part1 ..]- fullLength :: Day -> Int- fullLength d- | d == maxBound = 100- | otherwise = 200+ expectedParts :: Set Part+ expectedParts = S.fromDistinctAscList [Part1 ..] sep = ">>>>>>>>>" encodeMap mp = T.intercalate "\n" . concat $ [ maybeToList $ M.lookup Part1 mp
src/Advent/API.hs view
@@ -1,19 +1,14 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-} -- | -- Module : Advent.API@@ -93,21 +88,21 @@ instance MimeUnrender RawText Text where mimeUnrender _ = first show . T.decodeUtf8' . BSL.toStrict --- | Interpret repsonse as a list of HTML 'Text' found in the given type of+-- | Interpret repsonse as a list of HTML 'T.Text' found in the given type of -- tag -- -- @since 0.2.3.0 data HTMLTags (tag :: Symbol) --- | Interpret a response as a list of HTML 'Text' found in @<article>@ tags.+-- | Interpret a response as a list of HTML 'T.Text' found in @<article>@ tags. type Articles = HTMLTags "article" --- | Interpret a response as a list of HTML 'Text' found in @<div>@ tags.+-- | Interpret a response as a list of HTML 'T.Text' found in @<div>@ tags. -- -- @since 0.2.3.0 type Divs = HTMLTags "div" --- | Class for interpreting a list of 'Text' in tags to some desired+-- | Class for interpreting a list of 'T.Text' in tags to some desired -- output. -- -- @since 0.2.3.0
src/Advent/Types.hs view
@@ -2,15 +2,13 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-}@@ -45,8 +43,10 @@ , GlobalLeaderboardMember(..) -- * Util , mkDay, mkDay_, dayInt+ , _DayInt, pattern DayInt , partInt , partChar+ , fullDailyBoard -- * Internal , parseSubmitRes ) where@@ -61,6 +61,7 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import Data.Maybe+import Data.Profunctor import Data.Text (Text) import Data.Time.Clock import Data.Time.Clock.POSIX@@ -70,6 +71,7 @@ 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@@ -96,8 +98,6 @@ -- -- You can usually get 'Part1' (if it is already released) with a nonsense -- session key, but 'Part2' always requires a valid session key.------ Note also that Challenge #25 typically only has a single part. data Part = Part1 | Part2 deriving (Show, Read, Eq, Ord, Enum, Bounded, Typeable, Generic) @@ -159,10 +159,17 @@ deriving (Show, Eq, Ord, Typeable, Generic) -- | Ranking between 1 to 100, for daily and global leaderboards+--+-- Note that 'getRank' interanlly stores a number from 0 to 99, so be sure+-- to add or subtract accordingly if you want to display or parse it.+--+-- @since 0.2.3.0 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 , dlbmTime :: UTCTime@@ -174,6 +181,8 @@ deriving (Show, Eq, Ord, Typeable, Generic) -- | Daily leaderboard, containing Star 1 and Star 2 completions+--+-- @since 0.2.3.0 data DailyLeaderboard = DLB { dlbStar1 :: Map Rank DailyLeaderboardMember , dlbStar2 :: Map Rank DailyLeaderboardMember@@ -181,6 +190,8 @@ deriving (Show, Eq, Ord, Typeable, Generic) -- | Single global leaderboard position+--+-- @since 0.2.3.0 data GlobalLeaderboardMember = GLBM { glbmRank :: Rank , glbmScore :: Integer@@ -192,6 +203,11 @@ deriving (Show, Eq, Ord, Typeable, Generic) -- | Global leaderboard for the entire event+--+-- Under each 'Rank' is an 'Integer' for the score at that rank, as well as+-- 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) }@@ -304,7 +320,7 @@ parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' . drop 4 } --- | Parse 'Text' into a 'SubmitRes'.+-- | Parse 'T.Text' into a 'SubmitRes'. parseSubmitRes :: Text -> SubmitRes parseSubmitRes = either (SubUnknown . P.errorBundlePretty) id . P.runParser choices "Submission Response"@@ -384,9 +400,43 @@ where e = errorWithoutStackTrace "Advent.mkDay_: Date out of range (1 - 25)" +-- | This is a @Prism' 'Integer' 'Day'@ , to treat an 'Integer' as if it+-- were a 'Day'.+--+-- @since 0.2.4.0+_DayInt :: (Choice p, Applicative f) => p Day (f Day) -> p Integer (f Integer)+_DayInt = dimap a b . right'+ where+ a i = maybe (Left i) Right . mkDay $ i+ b = either pure (fmap dayInt)++-- | Pattern synonym allowing you to match on an 'Integer' as if it were+-- a 'Day':+--+-- @+-- case myInt of+-- DayInt d -> ...+-- _ -> ...+-- @+--+-- Will fail if the integer is out of bounds (outside of 1-25)+--+-- @since 0.2.4.0+pattern DayInt :: Day -> Integer+pattern DayInt d <- (mkDay->Just d)+ where+ DayInt d = dayInt d+ -- | A character associated with a given part. 'Part1' is associated with -- @\'a\'@, and 'Part2' is associated with @\'b\'@ partChar :: Part -> Char partChar Part1 = 'a' partChar Part2 = 'b' +-- | Check if a 'DailyLeaderboard' is filled up or not.+--+-- @since 0.2.4.0+fullDailyBoard+ :: DailyLeaderboard+ -> Bool+fullDailyBoard DLB{..} = (M.size dlbStar1 + M.size dlbStar2) >= 200