packages feed

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 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