diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,26 @@ Changelog ========= +Version 0.2.7.0 +--------------- + +*December 4, 2019* + + + +* Throughout the library, change from `UTCTime` to `ZonedTime`, except for + situations where the official site uses actual UTCTime. The main change is + in `challengeReleaseTime`. +* `challengeReleaseTime` moved to *Advent.Types* but re-exported from + *Advent*. +* `dlbmTime` changed from `UTCTime` to `NominalDiffTime` `dlbmDecTime`, which + is time from December 1st. This is because we don't have information about + the year from the HTML returned alone. This fixes a bug where the time + would always be in 1970. +* To convert `dlbmDecTime` back into a useful time,added `dlbmCompleteTime` + to get the actual time of completion (as a `ZonedTime`), and `dlbmTime` to + get the `NominalDiffTime` representing how long the challenge took. + Version 0.2.6.0 --------------- diff --git a/advent-of-code-api.cabal b/advent-of-code-api.cabal --- a/advent-of-code-api.cabal +++ b/advent-of-code-api.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 29142f7dd051872d37ae0e834ec0dd60a68dc650d60dfa4d913add426cceb3c3 +-- hash: 9603fe2e4c2300c11c4f62de11e190053b3d67925bc185d13a30248d5f13406d name: advent-of-code-api -version: 0.2.6.2 +version: 0.2.7.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 @@ -73,6 +73,7 @@ , tagsoup , text , time + , time-compat >=1.9 default-language: Haskell2010 test-suite advent-of-code-api-test diff --git a/src/Advent.hs b/src/Advent.hs --- a/src/Advent.hs +++ b/src/Advent.hs @@ -463,7 +463,7 @@ :: Integer -- ^ year -> Day -- ^ day -> IO NominalDiffTime -timeToRelease y d = (challengeReleaseTime y d `diffUTCTime`) <$> getCurrentTime +timeToRelease y d = (zonedTimeToUTC (challengeReleaseTime y d) `diffUTCTime`) <$> getCurrentTime -- | Check if a challenge has been released yet. challengeReleased @@ -471,14 +471,6 @@ -> Day -- ^ day -> IO Bool challengeReleased y = fmap (<= 0) . timeToRelease y - --- | Prompt release time -challengeReleaseTime - :: Integer -- ^ year - -> Day -- ^ day - -> UTCTime -challengeReleaseTime y d = UTCTime (fromGregorian y 12 (fromIntegral (dayInt d))) - (5 * 60 * 60) -- | Utility to get the current time on AoC servers. Basically just gets the current -- time in Eastern Standard Time. This is only as accurate as your diff --git a/src/Advent/API.hs b/src/Advent/API.hs --- a/src/Advent/API.hs +++ b/src/Advent/API.hs @@ -54,32 +54,35 @@ import Data.Char import Data.Finite import Data.Foldable -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Map (Map) +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.Format -import Data.Time.LocalTime +import Data.Text (Text) +import Data.Time hiding (Day) import GHC.TypeLits import Servant.API import Servant.Client -import Text.HTML.TagSoup.Tree (TagTree(..)) -import Text.Read (readMaybe) -import qualified Data.ByteString.Lazy as BSL -import qualified Data.List.NonEmpty as NE -import qualified Data.Map as M -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Network.HTTP.Media as M -import qualified Text.HTML.TagSoup as H -import qualified Text.HTML.TagSoup.Tree as H +import Text.HTML.TagSoup.Tree (TagTree(..)) +import Text.Read (readMaybe) +import qualified Data.ByteString.Lazy as BSL +import qualified Data.List.NonEmpty as NE +import qualified Data.Map as M +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Network.HTTP.Media as M +import qualified Text.HTML.TagSoup as H +import qualified Text.HTML.TagSoup.Tree as H #if !MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>)) #endif +#if !MIN_VERSION_time(1,9,0) +import Data.Time.LocalTime.Compat +#endif + -- | Raw "text/plain" MIME type data RawText @@ -144,10 +147,10 @@ dlbmRank <- fmap Rank . packFinite . subtract 1 =<< readMaybe . filter isDigit . T.unpack . fst =<< findTag uni "span" (Just "leaderboard-position") - dlbmTime <- fmap (localTimeToUTC (read "EST")) - . parseTimeM True defaultTimeLocale "%b %d %H:%M:%S" - . T.unpack . fst - =<< findTag uni "span" (Just "leaderboard-time") + 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 @@ -170,6 +173,8 @@ 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 (<>) diff --git a/src/Advent/Types.hs b/src/Advent/Types.hs --- a/src/Advent/Types.hs +++ b/src/Advent/Types.hs @@ -47,6 +47,9 @@ , partInt , partChar , fullDailyBoard + , dlbmCompleteTime + , dlbmTime + , challengeReleaseTime -- * Internal , parseSubmitRes ) where @@ -54,6 +57,7 @@ import Control.Applicative import Data.Aeson import Data.Aeson.Types +import Data.Bifunctor import Data.Char import Data.Finite import Data.Foldable @@ -63,7 +67,7 @@ import Data.Maybe import Data.Profunctor import Data.Text (Text) -import Data.Time.Clock +import Data.Time hiding (Day) import Data.Time.Clock.POSIX import Data.Typeable import Data.Void @@ -83,6 +87,10 @@ import Data.Semigroup ((<>)) #endif +#if !MIN_VERSION_time(1,9,0) +import Data.Time.LocalTime.Compat +#endif + -- | Describes the day: a number between 1 and 25 inclusive. -- -- Represented by a 'Finite' ranging from 0 to 24 inclusive; you should @@ -172,7 +180,12 @@ -- @since 0.2.3.0 data DailyLeaderboardMember = DLBM { dlbmRank :: Rank - , dlbmTime :: UTCTime + -- | 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 @@ -180,6 +193,26 @@ } deriving (Show, Eq, Ord, Typeable, Generic) +-- | Turn a 'dlbmDecTime' field into a 'ZonedTime' for the actual +-- completion of the puzzle, based on the year and day of event. +-- +-- @since 0.2.7.0 +dlbmCompleteTime :: Integer -> Day -> NominalDiffTime -> ZonedTime +dlbmCompleteTime y d t = r + { zonedTimeToLocalTime = dlbmTime d t `addLocalTime` zonedTimeToLocalTime r + } + where + r = challengeReleaseTime y d + +-- | Turn a 'dlbmDecTime' field into a 'NominalDiffTime' representing the +-- actual amount of time taken to complete the puzzle. +-- +-- @since 0.2.7.0 +dlbmTime :: Day -> NominalDiffTime -> NominalDiffTime +dlbmTime d = uncurry daysAndTimeOfDayToTime + . first (subtract (dayInt d - 1)) + . timeToDaysAndTimeOfDay + -- | Daily leaderboard, containing Star 1 and Star 2 completions -- -- @since 0.2.3.0 @@ -455,3 +488,20 @@ :: 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 + } + , zonedTimeZone = read "EST" + } +