advent-of-code-api 0.1.1.0 → 0.1.2.0

raw patch · 13 files changed

+174/−47 lines, 13 filesdep +HUnitdep +advent-of-code-apidep +attoparsecPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HUnit, advent-of-code-api, attoparsec

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• advent-of-code-api.cabal +30/−3
• src/Advent.hs +67/−44
• test-data/correct-rank.txt +3/−0
• test-data/correct.txt +3/−0
• test-data/incorrect-high.txt +4/−0
• test-data/incorrect-low.txt +4/−0
• test-data/incorrect-wait.txt +5/−0
• test-data/incorrect.txt +7/−0
• test-data/invalid.txt +2/−0
• test-data/wait.txt +3/−0
• test-data/wait2.txt +3/−0
• test/Spec.hs +32/−0

@@ -1,6 +1,17 @@ Changelog ========= +Version 0.1.2.0+---------------++*December 7, 2018*++<https://github.com/mstksg/advent-of-code-api/releases/tag/v0.1.2.0>++*   Fixed cache to store prompts at `.html` instead of `.yaml`+*   `SubIncorrect` and `SubWait` now include fields for wait times.+*   Re-implemented submission result parsers using *attoparsec*+ Version 0.1.1.0 --------------- 

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f03eec5006d16762ac8fed0ec107a02d10becc827816ae9aff936b1c94e41493+-- hash: 65e4e6828d9edc4bd8f8bb184773083c933cec327f7b7bcfaac1f90e763cf296  name:           advent-of-code-api-version:        0.1.1.0+version:        0.1.2.0 synopsis:       Advent of Code REST API bindings description:    Haskell bindings for Advent of Code REST API.  Please use responsibly!                 See README.md or "Advent" module for an introduction and tutorial.@@ -26,6 +26,15 @@ 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  source-repository head   type: git@@ -42,7 +51,8 @@       src   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns   build-depends:-      base >=4.9 && <5+      attoparsec+    , base >=4.9 && <5     , containers     , curl     , deepseq@@ -54,4 +64,21 @@     , text     , time     , uri-encode+  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+  build-depends:+      HUnit+    , advent-of-code-api+    , base >=4.9 && <5+    , directory+    , filepath+    , text   default-language: Haskell2010

@@ -71,31 +71,33 @@  import           Advent.Cache import           Advent.Throttle+import           Control.Applicative import           Control.Exception import           Control.Monad.Except import           Data.Char import           Data.Finite+import           Data.Foldable import           Data.Kind-import           Data.Map              (Map)+import           Data.Map             (Map) import           Data.Maybe import           Data.Semigroup-import           Data.Set              (Set)-import           Data.Text             (Text)+import           Data.Set             (Set)+import           Data.Text            (Text) import           Data.Time import           Data.Typeable-import           GHC.Generics          (Generic)+import           GHC.Generics         (Generic) import           Network.Curl import           System.Directory import           System.FilePath import           Text.Printf-import           Text.Read             (readMaybe)-import qualified Data.Map              as M-import qualified Data.Set              as S-import qualified Data.Text             as T-import qualified Data.Text.Lazy        as TL-import qualified Network.URI.Encode    as URI-import qualified System.IO.Unsafe      as Unsafe-import qualified Text.Taggy            as H+import qualified Data.Attoparsec.Text as P+import qualified Data.Map             as M+import qualified Data.Set             as S+import qualified Data.Text            as T+import qualified Data.Text.Lazy       as TL+import qualified Network.URI.Encode   as URI+import qualified System.IO.Unsafe     as Unsafe+import qualified Text.Taggy           as H  initialThrottleLimit :: Int initialThrottleLimit = 100@@ -117,21 +119,21 @@     -- | Correct submission, including global rank (if reported, which     -- usually happens if rank is under 1000)     = SubCorrect (Maybe Integer)-    -- | Incorrect submission.  The 'Maybe' contains possible hints given-    -- by the server (usually "too low" or "too high").  Check response-    -- text for hints that the parser didn't catch, and also for the wait-    -- time required before the next submission.-    | SubIncorrect (Maybe String)+    -- | 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-    -- recently submitted.  Check response text for wait time.-    | SubWait+    -- 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     -- 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.-    | SubUnknown-  deriving (Show, Eq, Ord, Typeable, Generic)+    -- | Could not parse server response.  Contains parse error.+    | SubUnknown String+  deriving (Show, Read, Eq, Ord, Typeable, Generic)  -- | A given part of a problem.  All Advent of Code challenges are -- two-parts.@@ -281,7 +283,7 @@     -> AoC a     -> Maybe FilePath apiCache sess = \case-    AoCPrompt d -> Just $ printf "prompt/%02d.yaml"        (dayInt d)+    AoCPrompt d -> Just $ printf "prompt/%02d.html"        (dayInt d)     AoCInput  d -> Just $ printf "input/%s%02d.txt" keyDir (dayInt d)     AoCSubmit{} -> Nothing   where@@ -345,41 +347,62 @@             . H.parseDOM True             . TL.pack   where-    isArticle (H.NodeElement (H.Element{..}))+    isArticle (H.NodeElement H.Element{..})         = eltChildren <$ guard (eltName == "article")     isArticle _         = Nothing  -- | Parse 'Text' into a 'SubmitRes'. parseSubmitRes :: Text -> SubmitRes-parseSubmitRes t-    | "the right answer!"       `T.isInfixOf` t = SubCorrect $ findRank t-    | "too high"                `T.isInfixOf` t = SubIncorrect $ Just "too high"-    | "too low"                 `T.isInfixOf` t = SubIncorrect $ Just "too low"-    | "not the right answer"    `T.isInfixOf` t = SubIncorrect Nothing-    | "an answer too recently"  `T.isInfixOf` t = SubWait-    | "solving the right level" `T.isInfixOf` t = SubInvalid-    | otherwise                                 = SubUnknown+parseSubmitRes = either SubUnknown id+               . P.parseOnly choices+               . mconcat+               . mapMaybe deTag+               . H.taggyWith True+               . TL.fromStrict   where-    findRank = go . T.words . T.map onlyAlphaNum . T.toLower-      where-        go ("rank":n:_) = readMaybe $ T.unpack n-        go (_     :ws ) = go ws-        go []           = Nothing-        onlyAlphaNum c-          | isAlphaNum c = c-          | otherwise    = ' '+    deTag (H.TagText t) = Just t+    deTag _             = Nothing+    choices             = asum [ parseCorrect   P.<?> "Correct"+                               , parseIncorrect P.<?> "Incorrect"+                               , parseWait      P.<?> "Wait"+                               , parseInvalid   P.<?> "Invalid"+                               ]+    parseCorrect = do+      _ <- P.manyTill P.anyChar (P.asciiCI "that's the right answer") P.<?> "Right answer"+      r <- optional . (P.<?> "Rank") $ do+        P.manyTill P.anyChar (P.asciiCI "rank")+          *> P.skipMany (P.satisfy (not . isDigit))+        P.decimal+      pure $ SubCorrect r+    parseIncorrect = do+      _ <- P.manyTill P.anyChar (P.asciiCI "that's not the right answer") P.<?> "Not the right answer"+      hint <- optional . (P.<?> "Hint") $ do+        P.manyTill P.anyChar "your answer is" *> P.skipSpace+        P.takeWhile1 (/= '.')+      P.manyTill P.anyChar (P.asciiCI "wait") *> P.skipSpace+      waitAmt <- (1 <$ P.asciiCI "one") <|> P.decimal+      pure $ SubIncorrect (waitAmt * 60) (T.unpack <$> hint)+    parseWait = do+      _ <- P.manyTill P.anyChar (P.asciiCI "an answer too recently") P.<?> "An answer too recently"+      P.skipMany (P.satisfy (not . isDigit))+      m <- optional . (P.<?> "Delay minutes") $+              P.decimal <* P.char 'm' <* P.skipSpace+      s <- P.decimal <* P.char 's' P.<?> "Delay seconds"+      pure . SubWait $ maybe 0 (* 60) m + s+    parseInvalid = SubInvalid <$ P.manyTill P.anyChar (P.asciiCI "solving the right level")  -- | Pretty-print a 'SubmitRes' showSubmitRes :: SubmitRes -> String showSubmitRes = \case     SubCorrect Nothing    -> "Correct"     SubCorrect (Just r)   -> printf "Correct (Rank %d)" r-    SubIncorrect Nothing  -> "Incorrect"-    SubIncorrect (Just h) -> printf "Incorrect (%s)" h-    SubWait               -> "Wait"+    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            -> "Unknown"+    SubUnknown r          -> printf "Unknown (%s)" r  saverLoader :: AoC a -> SaverLoader (Either AoCError a) saverLoader = \case

@@ -0,0 +1,3 @@+SubCorrect (Just 259)+That's the right answer! You are one gold star closer to fixing the time+stream. You got rank 259 on this star's leaderboard.

@@ -0,0 +1,3 @@+SubCorrect Nothing+That's the right answer! You are one gold star closer to fixing the time+stream.

@@ -0,0 +1,4 @@+SubIncorrect 60 (Just "too high")+That's not the right answer; your answer is too high. If you're stuck, there+are some general tips on the about page, or you can ask for hints on the+subreddit. Please wait one minute before trying again. (You guessed 218.)

@@ -0,0 +1,4 @@+SubIncorrect 60 (Just "too low")+That's not the right answer; your answer is too low. If you're stuck, there+are some general tips on the about page, or you can ask for hints on the+subreddit. Please wait one minute before trying again. (You guessed 218.)

@@ -0,0 +1,5 @@+SubIncorrect 300 Nothing+That's not the right answer. If you're stuck, there are some general+tips on the about page, or you can ask for hints on the subreddit.+Because you have guessed incorrectly 4 times on this puzzle, please wait+5 minutes before trying again. (You guessed BAFNRWXHEKSQLUYGMIO.)

@@ -0,0 +1,7 @@+SubIncorrect 60 Nothing+<p>That&#39;s not the right answer.  If you&#39;re stuck, there are some+general tips on the <a href="/2016/about">about page</a>, or you can ask for+hints on the <a href="https://www.reddit.com/r/adventofcode/"+target="_blank">subreddit</a>.  Please wait one minute before trying again.+(You guessed <span style="white-space:nowrap;"><code>hello</code>.)</span><a+href="/2016/day/2">[Return to Day 2]</a></p>

@@ -0,0 +1,2 @@+SubInvalid+<p>You don&#39;t seem to be solving the right level.  Did you already complete it? <a href="/2016/day/1">[Return to Day 1]</a></p>

@@ -0,0 +1,3 @@+SubWait 136+You gave an answer too recently; you have to wait after submitting an answer+before trying again. You have 2m 16s left to wait.

@@ -0,0 +1,3 @@+SubWait 2+You gave an answer too recently; you have to wait after submitting an answer+before trying again. You have 2s left to wait.

@@ -0,0 +1,32 @@+{-# LANGUAGE ViewPatterns #-}++import           Advent+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++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++    r <- maybe (fail "No parse expected result") pure $+            readMaybe (T.unpack x)++    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