flexible-numeric-parsers (empty) → 0.1.0.0

raw patch · 7 files changed

+427/−0 lines, 7 filesdep +attoparsecdep +basedep +flexible-numeric-parsers

Dependencies added: attoparsec, base, flexible-numeric-parsers, hedgehog, parsers, scientific, tasty, tasty-hedgehog, tasty-hunit, text

Files

CHANGELOG.md +11/−0
LICENSE +21/−0
README.md +11/−0
flexible-numeric-parsers.cabal +66/−0
src/Numeric/Parse/Flexible.hs +157/−0
test/Generators.hs +35/−0
test/Spec.hs +126/−0

+ CHANGELOG.md view

@@ -0,0 +1,11 @@+# Changelog++`flexible-numeric-parsers` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++## 0.0.0.0++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/patrickt/flexible-numeric-parsers/releases

+ LICENSE view

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2020 Patrick Thomson++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.md view

@@ -0,0 +1,11 @@+# flexible-numeric-parsers++[![GitHub CI](https://github.com/patrickt/flexible-numeric-parsers/workflows/CI/badge.svg)](https://github.com/patrickt/flexible-numeric-parsers/actions)+[![Hackage](https://img.shields.io/hackage/v/flexible-numeric-parsers.svg?logo=haskell)](https://hackage.haskell.org/package/flexible-numeric-parsers)+[![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)++Flexible numeric parsers for real-world programming languages. These parsers accept values such as `100_000_000`, `0B1_1`, and `0xa_bcd_ef0`.++This code was extracted from the [Semantic](http://github.com/github/semantic/) project.++Currently missing support for complex numbers, suffixes indicating signedness/size (`U` and `L` and friends), and hexadecimal floats. If you need the former, file an issue; if you need the latter, then I sure want to know what your use case is.

+ flexible-numeric-parsers.cabal view

@@ -0,0 +1,66 @@+cabal-version:       2.4+name:                flexible-numeric-parsers+version:             0.1.0.0+synopsis:            Flexible numeric parsers for real-world programming languages.+description:         This package provides parsers for integer, natural, and arbitrary-precision decimal+                     numbers that are compatible with the syntaxes of a wide variety of programming languages.+homepage:            https://github.com/patrickt/flexible-numeric-parsers+bug-reports:         https://github.com/patrickt/flexible-numeric-parsers/issues+license:             MIT+license-file:        LICENSE+author:              Patrick Thomson+maintainer:          Patrick Thomson <patrickt@github.com>+copyright:           2020 Patrick Thomson+category:            Parsing+build-type:          Simple+extra-doc-files:     README.md+                     CHANGELOG.md+tested-with:         GHC == 8.8.3++source-repository head+  type:                git+  location:            https://github.com/patrickt/flexible-numeric-parsers.git++common common-options+  build-depends:       base >= 4.12.0.0 && <5+                     , parsers ^>= 0.12.10+                     , scientific ^>= 0.3.6++  ghc-options:         -Wall+                       -Wcompat+                       -Widentities+                       -Wincomplete-uni-patterns+                       -Wincomplete-record-updates+  if impl(ghc >= 8.0)+    ghc-options:       -Wredundant-constraints+  if impl(ghc >= 8.2)+    ghc-options:       -fhide-source-paths+  if impl(ghc >= 8.4)+    ghc-options:       -Wmissing-export-lists+                       -Wpartial-fields+  if impl(ghc >= 8.8)+    ghc-options:       -Wmissing-deriving-strategies++  default-language:    Haskell2010++library+  import:              common-options+  hs-source-dirs:      src+  exposed-modules:     Numeric.Parse.Flexible++test-suite flexible-numeric-parsers-test+  import:              common-options+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Generators+  build-depends:       flexible-numeric-parsers+                     , hedgehog+                     , attoparsec+                     , text+                     , tasty+                     , tasty-hedgehog+                     , tasty-hunit+  ghc-options:         -threaded+                       -rtsopts+                       -with-rtsopts=-N

+ src/Numeric/Parse/Flexible.hs view

@@ -0,0 +1,157 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}++-- | Flexible numeric parsers for real-world programming languages.+-- These parsers aim to be a superset of the numeric syntaxes across+-- the most popular programming languages.+--+-- All parsers assume any trailing whitespace has already been+-- consumed, and places no requirement for an @endOfInput@ at the end+-- of a literal. Be sure to handle these in a calling context. These+-- parsers do not use 'Text.Parser.Token.TokenParsing', and therefore+-- may fail while consuming input, depending on if you use a parser+-- that automatically backtracks or not. Apply 'try' if needed.+module Numeric.Parse.Flexible+  ( integer,+    natural,+    decimal,+    hexadecimal,+    octal,+    binary,+    floating,+    signed,+    imaginary,+  )+where++import Control.Applicative+import Control.Monad hiding (fail)+import Data.Scientific hiding (scientific)+import Numeric+import Text.Parser.Char+import Text.Parser.Combinators+import Text.Read (readMaybe)+import Prelude hiding (exponent, fail, takeWhile)+import Data.Complex+import Numeric.Natural (Natural)++-- | Parse an integer in 'decimal', 'hexadecimal', 'octal', or 'binary', with optional leading sign.+--+-- Note that because the 'octal' parser takes primacy over 'decimal', numbers with a leading+-- @0@ will be parsed as octal. This is unfortunate, but matches the behavior+-- of C, Python, and Ruby.+integer :: (CharParsing m, Monad m) => m Integer+integer = signed (choice [try hexadecimal, try octal, try binary, decimal])++-- | Parse a natural number in 'decimal', 'hexadecimal', 'octal', or 'binary'. As with 'integer',+-- a leading @0@ is interpreted as octal. Leading signs are not accepted.+natural :: (CharParsing m, Monad m) => m Natural+natural = fromIntegral <$> choice [try hexadecimal, try octal, try binary, decimal]++-- | Parse an integer in base 10.+--+-- Accepts @0..9@ and underscore separators. No leading signs are accepted.+decimal :: (CharParsing m, Monad m) => m Integer+decimal = do+  contents <- withUnder digit+  attempt contents++-- | Parse a number in hexadecimal.+--+-- Requires a @0x@ or @0X@ prefix. No leading signs are accepted.+-- Accepts @A..F@, @a..f@, @0..9@ and underscore separators.+hexadecimal :: forall a m. (Eq a, Num a, CharParsing m, Monad m) => m a+hexadecimal = do+  void (string "0x" <|> string "0X")+  contents <- withUnder hexDigit+  let res = readHex contents+  case res of+    [] -> unexpected ("unparsable hex literal " <> contents)+    [(x, "")] -> pure x+    _ -> unexpected ("ambiguous hex literal " <> contents)++-- | Parse a number in octal.+--+-- Requires a @0@, @0o@ or @0O@ prefix. No leading signs are accepted.+-- Accepts @0..7@ and underscore separators.+octal :: forall a m. (Num a, CharParsing m, Monad m) => m a+octal = do+  void (char '0' *> optional (oneOf "oO"))+  digs <- withUnder octDigit+  fromIntegral <$> attempt @Integer ("0o" <> digs)++-- | Parse a number in binary.+--+-- Requires a @0b@ or @0B@ prefix. No leading signs are accepted.+-- Accepts @0@, @1@, and underscore separators.+binary :: forall a m. (Show a, Num a, CharParsing m, Monad m) => m a+binary = do+  void (char '0')+  void (optional (oneOf "bB"))+  digs <- withUnder (oneOf "01")+  let c2b c = case c of+        '0' -> 0+        '1' -> 1+        x -> error ("Invariant violated: both Attoparsec and readInt let a bad digit through: " <> [x])+  let res = readInt 2 (`elem` "01") c2b digs+  case res of+    [] -> unexpected ("No parse of binary literal: " <> digs)+    [(x, "")] -> pure x+    others -> unexpected ("Too many parses of binary literal: " <> show others)++-- | Parse an arbitrary-precision number with an optional decimal part.+--+-- Unlike 'scientificP' or Scientific's 'Read' instance, this handles:+--+--   * omitted whole parts, e.g. @.5@+--   * omitted decimal parts, e.g. @5.@+--   * exponential notation, e.g. @3.14e+1@+--   * numeric parts, in whole or decimal or exponent parts, with @_@ characters+--   * hexadecimal, octal, and binary integer literals, without a decimal part.+--+-- You may either omit the whole or the leading part, not both; this parser also rejects the empty string.+-- It does /not/ handle hexadecimal floating-point numbers.+floating :: (CharParsing m, Monad m) => m Scientific+floating = signed (choice [hexadecimal, octal, binary, dec])+  where+    -- Compared to the binary parser, this is positively breezy.+    dec = do+      -- Try getting the whole part of a floating literal.+      leadings <- stripUnder <$> many (digit <|> char '_')+      -- Try reading a dot.+      void (optional (char '.'))+      -- The trailing part...+      trailings <- stripUnder <$> many (digit <|> char '_')+      -- ...and the exponent.+      exponent <- stripUnder <$> many (oneOf "eE_0123456789+-")+      -- Ensure we don't read an empty string, or one consisting only of a dot and/or an exponent.+      when (null trailings && null leadings) (unexpected "Does not accept a single dot")+      -- Replace empty parts with a zero.+      let leads = if null leadings then "0" else leadings+      let trail = if null trailings then "0" else trailings+      attempt (leads <> "." <> trail <> exponent)++-- | Converts a numeric parser to one that accepts an optional leading sign.+signed :: forall a m . (CharParsing m, Num a) => m a -> m a+signed p =+  (negate <$> (char '-' *> p))+    <|> (char '+' *> p)+    <|> p++-- | Converts a numeric parser to one that accepts a trailing imaginary specifier+-- @i@ or @j@. This does not add facilities for two-valued literals, i.e. @1+4j@,+-- as those are generally best left to high-level expression facilities.+imaginary :: forall a m . (CharParsing m, Monad m, Num a) => m a -> m (Complex a)+imaginary num = do+  real <- num+  void (oneOf "ij")+  pure (0 :+ real)++stripUnder :: String -> String+stripUnder = Prelude.filter (/= '_')++attempt :: (Read a, CharParsing m) => String -> m a+attempt str = maybe (unexpected ("No parse: " <> str)) pure (readMaybe str)++withUnder :: CharParsing m => m Char -> m String+withUnder p = stripUnder <$> ((:) <$> p <*> many (p <|> char '_'))

+ test/Generators.hs view

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module Generators+  ( module Generators,+  )+where++import Data.Ratio ((%))+import Data.Scientific (Scientific)+import qualified Data.Scientific as Scientific+import Hedgehog+import qualified Hedgehog.Gen as Gen++integerScientific :: MonadGen m => Hedgehog.Range Integer -> m Scientific+integerScientific = fmap fromIntegral . Gen.integral++rationalScientific :: MonadGen m => Hedgehog.Range Integer -> Hedgehog.Range Integer -> m Scientific+rationalScientific nrange drange = do+  num <- Gen.integral nrange+  den <- Gen.integral drange+  let goodDen = if den == 0 then 1 else den+  let digitLimit = Just 25+  case Scientific.fromRationalRepetend digitLimit (num % goodDen) of+    Left (sci, _) -> pure sci+    Right (sci, _) -> pure sci++floatingScientific :: MonadGen m => Hedgehog.Range Double -> m Scientific+floatingScientific = fmap Scientific.fromFloatDigits . Gen.double++classifyScientific :: MonadTest m => Scientific -> m ()+classifyScientific sci = do+  classify "negative" $ sci < 0+  classify "small" $ (sci > 0 && sci <= 1)+  classify "medium" $ (sci > 1 && sci <= 10000)+  classify "large" $ sci > 10000

+ test/Spec.hs view

@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}++module Main+  ( main,+  )+where++import Data.Attoparsec.Text (parseOnly, endOfInput)+import Data.Either+import Data.Foldable (traverse_)+import Data.Scientific+import Data.Foldable (for_)+import Data.Text as Text+import qualified Generators as Gen+import Hedgehog+import qualified Hedgehog.Range as Range+import Numeric.Parse.Flexible as Flex+import qualified Test.Tasty as Tasty+import Test.Tasty.HUnit+import Test.Tasty.HUnit as HUnit+import Test.Tasty.Hedgehog++-- Integer stuff++type IFixture = (Text, Integer)++python :: [IFixture]+python =+  [ ("-1", (negate 1)),+    ("0xDEAD", 0xDEAD),+    ("0XDEAD", 0xDEAD),+    ("0o123", 83),+    ("0O123", 83),+    ("0b001", 1),+    ("0B001", 1),+    ("1_1", 11), -- underscore syntax is Python 3 only+    ("0B1_1", 3),+    ("0O1_1", 9)+  ]++ruby :: [IFixture]+ruby =+  [ ("0xa_bcd_ef0_123_456_789", 0xabcdef0123456789),+    ("01234567", 342391)+  ]++integerTestTree :: Tasty.TestTree+integerTestTree =+  let go = traverse_ (\(s, v) -> parseInteger s @?= Right v)+   in Tasty.testGroup+        "Numeric.Exts"+        [ testCase "handles Python integers" (go python),+          testCase "handles Ruby integers" (go ruby),+          testCase "doesn't accept floats" (isLeft (parseInteger "1.5") @? "Accepted floating-point"),+          testCase "doesn't accept empty string" (isLeft (parseInteger "") @? "Accepted integer")+        ]++parseInteger :: Text -> Either String Integer+parseInteger = parseOnly (Flex.integer <* endOfInput)++parseScientific :: Text -> Either String Scientific+parseScientific = parseOnly (Flex.floating <* endOfInput)++type SFixture = [(Text, Scientific)]++testSFixture :: [(Text, Scientific)] -> HUnit.Assertion+testSFixture vals = for_ vals $ \(input, expected) -> assertEqual (Text.unpack input) (parseScientific input) (Right expected)++pythonSyntax :: SFixture+pythonSyntax =+  [ ("-.6_6", -0.66),+    ("+.1_1", 0.11),+    ("123.4123", 123.4123),+    ("1_1.3_1", 11.31),+    ("1_1.", 11.0),+    ("99E+01", 99e1),+    ("3.e14", 3e14),+    (".3e1_4", 0.3e14),+    ("1_0", 10),+    (".3", 0.3),+    (".1", 0.1) -- omitting a leading 0 is deprecated in python 3, also note that the -l suffix is not valid in Python 3+  ]++rubySyntax :: SFixture+rubySyntax =+  [ ("1.234_5e1_0", 1.2345e10),+    ("1E30", 1e30),+    ("1.2", 1.2),+    ("1.0e+6", 1.0e6),+    ("1.0e-6", 1.0e-6)+  ]++jsSyntax :: SFixture+jsSyntax =+  [ ("101", 101),+    ("3.14", 3.14),+    ("3.14e+1", 3.14e1),+    ("0x1ABCDEFabcdef", 470375954370031),+    ("0o7632157312", 1047060170),+    ("0b1010101001", 681)+  ]++testTree :: Tasty.TestTree+testTree =+  Tasty.testGroup+    "Data.Scientific.Exts"+    [ testCase "Python float syntax" $ testSFixture pythonSyntax,+      testCase "Ruby float syntax" $ testSFixture rubySyntax,+      testCase "JavaScript float syntax" $ testSFixture jsSyntax,+      testCase "Pathological input" $ do+        isLeft (parseScientific ".") @? "Accepted period"+        isLeft (parseScientific "") @? "Accepted empty string",+      testProperty "Scientific roundtripping" . property $ do+        let nrange = Range.linear (negate 500000) 20000000+            drange = Range.exponential 1 100000000+        fromRat <- forAll (Gen.rationalScientific nrange drange)+        Gen.classifyScientific fromRat+        tripping fromRat (pack . show) parseScientific,+      testProperty "Double-based Scientific roundtripping" . property $ do+        fromDbl <- forAll (Gen.floatingScientific (Range.linearFrac (negate 1) 3))+        Gen.classifyScientific fromDbl+        tripping fromDbl (pack . show) parseScientific+    ]++main :: IO ()+main = Tasty.defaultMain (Tasty.testGroup "All tests" [testTree, integerTestTree])