feat: add aeson parser transformer

Author: drlkf

megaparsec-utils.cabal

@@ -26,10 +26,12 @@ library
       src
   ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
-      base >=4.7 && <5
+      aeson
+    , base >=4.7 && <5
     , extra
     , megaparsec
     , parser-combinators
+    , text
     , time
     , uuid
   default-language: Haskell2010
@@ -46,12 +48,14 @@ test-suite megaparsec-utils-test
   ghc-options: -Wall -Werror -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       QuickCheck
+    , aeson
     , base >=4.7 && <5
     , extra
     , hspec
     , megaparsec
     , megaparsec-utils
     , parser-combinators
+    , text
     , time
     , uuid
   default-language: Haskell2010

package.yaml

@@ -13,9 +13,11 @@ description: Utilities for the Megaparsec library.
 
 dependencies:
   - base >= 4.7 && < 5
+  - aeson
   - extra
   - megaparsec
   - parser-combinators
+  - text
   - time
   - uuid
 

src/Text/Megaparsec/Utils.hs

@@ -7,6 +7,7 @@ module Text.Megaparsec.Utils
   , numParser
   , occurrence
   , occurrences
+  , parsecToJSONParser
   , parsecToReadsPrec
   , posDecNumParser
   , posNumParser
@@ -17,14 +18,17 @@ import           Control.Applicative             (many, some, (<|>))
 import           Control.Applicative.Combinators (choice)
 import           Control.Monad                   (replicateM, void)
 import           Control.Monad.Combinators       (optional)
+import           Data.Aeson.Types                (Parser, Value, withText)
 import           Data.Functor                    (($>))
 import           Data.List                       (intercalate, sortOn)
 import           Data.List.NonEmpty              (NonEmpty ((:|)))
 import           Data.Maybe                      (fromJust)
+import qualified Data.Text                       as T (unpack)
 import           Data.UUID                       (UUID)
 import qualified Data.UUID                       as U (fromString)
 import           Data.Void                       (Void)
-import           Text.Megaparsec                 (Parsec, anySingle, runParser,
+import           Text.Megaparsec                 (Parsec, anySingle,
+                                                  errorBundlePretty, runParser,
                                                   try)
 import           Text.Megaparsec.Char            (char, digitChar, hexDigitChar,
                                                   string')
@@ -76,6 +80,15 @@ posNumParser = read <$> some digitChar
 numParser :: Parsec Void String Int
 numParser = (char '-' >> negate <$> posNumParser) <|> posNumParser
 
+-- | Convert a 'Parsec' parser into a 'Parser' suited for 'FromJSON' instances.
+parsecToJSONParser
+  :: String
+  -> Parsec Void String a
+  -> Value
+  -> Parser a
+parsecToJSONParser n p =
+  withText n $ either (fail . errorBundlePretty) pure . runParser p n . T.unpack
+
 -- | Convert a 'Parsec' parser into a 'ReadS' parser. Useful for defining 'Read'
 -- instances with 'Megaparsec'.
 parsecToReadsPrec :: Parsec Void String a -> ReadS a