advent-of-code-api 0.2.1.0 → 0.2.2.0
raw patch · 3 files changed
+49/−36 lines, 3 filesdep +megaparsecdep −attoparsecPVP ok
version bump matches the API change (PVP)
Dependencies added: megaparsec
Dependencies removed: attoparsec
API changes (from Hackage documentation)
Files
- CHANGELOG.md +9/−0
- advent-of-code-api.cabal +3/−3
- src/Advent/API.hs +37/−33
CHANGELOG.md view
@@ -1,6 +1,15 @@ Changelog ========= +Version 0.2.2.0+---------------++*November 9, 2019*++<https://github.com/mstksg/advent-of-code-api/releases/tag/v0.2.2.0>++* Rewrote submission response parser using megaparsec for better errors+ Version 0.2.1.0 ---------------
advent-of-code-api.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f51e9b48698efac660670dda90b5dde485ef32d93c840c461ae834599d86bc30+-- hash: 7b89429fd3572b2daa643989846c5ea1edc56e85c3dcb14faae56bc4b97d3b42 name: advent-of-code-api-version: 0.2.1.0+version: 0.2.2.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@@ -51,7 +51,6 @@ ghc-options: -Wall -Wcompat -Werror=incomplete-patterns build-depends: aeson- , attoparsec , base >=4.9 && <5 , bytestring , containers@@ -63,6 +62,7 @@ , http-client , http-client-tls , http-media+ , megaparsec >=7 , mtl , servant , servant-client
src/Advent/API.hs view
@@ -54,6 +54,7 @@ , RawText ) where +-- import qualified Data.Attoparsec.Text as P import Control.Applicative import Control.Monad import Data.Aeson@@ -62,28 +63,31 @@ import Data.Finite import Data.Foldable import Data.Functor.Classes-import Data.Map (Map)+import Data.Map (Map) import Data.Maybe import Data.Proxy-import Data.Text (Text)+import Data.Text (Text) import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Typeable+import Data.Void import GHC.Generics import Servant.API import Servant.Client-import Text.HTML.TagSoup.Tree (TagTree(..))+import Text.HTML.TagSoup.Tree (TagTree(..)) import Text.Printf-import Text.Read (readMaybe)-import qualified Data.Attoparsec.Text as P-import qualified Data.ByteString.Lazy as BSL-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 qualified Web.FormUrlEncoded as WF+import Text.Read (readMaybe)+import qualified Data.ByteString.Lazy as BSL+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 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 #if !MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>))@@ -323,43 +327,43 @@ -- | Parse 'Text' into a 'SubmitRes'. parseSubmitRes :: Text -> SubmitRes-parseSubmitRes = either SubUnknown id- . P.parseOnly choices+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 [ parseCorrect P.<?> "Correct"- , parseIncorrect P.<?> "Incorrect"- , parseWait P.<?> "Wait"- , parseInvalid P.<?> "Invalid"- , fail "No option recognized"+ 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.anyChar (P.asciiCI "that's the right answer") P.<?> "Right answer"- r <- optional . (P.<?> "Rank") $ do- P.manyTill P.anyChar (P.asciiCI "rank")+ _ <- P.manyTill P.anySingle (P.string' "that's the right answer") P.<?> "Right answer"+ r <- optional . (P.<?> "Rank") . P.try $ do+ P.manyTill P.anySingle (P.string' "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+ _ <- P.manyTill P.anySingle (P.string' "that's not the right answer") P.<?> "Not the right answer"+ hint <- optional . (P.<?> "Hint") . P.try $ do+ P.manyTill P.anySingle "your answer is" *> P.space1+ P.takeWhile1P (Just "dot") (/= '.')+ P.manyTill P.anySingle (P.string' "wait") *> P.space1+ waitAmt <- (1 <$ P.string' "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.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.decimal <* P.char 'm' <* P.skipSpace+ 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.anyChar (P.asciiCI "solving the right level")+ parseInvalid = SubInvalid <$ P.manyTill P.anySingle (P.string' "solving the right level") -- | Pretty-print a 'SubmitRes' showSubmitRes :: SubmitRes -> String