From 9d114b5d91bfd6f8650a9296c22970525cdf30a5 Mon Sep 17 00:00:00 2001
From: Tom Oram <me@tomoram.io>
Date: Tue, 2 Oct 2018 09:46:05 +0100
Subject: [PATCH] [#17] Allow underscores in integers (#97)

---
 CHANGELOG.md                   |  2 ++
 src/Toml/Parser.hs             | 15 +++++++++++++--
 test/Test/Toml/Parsing/Unit.hs | 19 ++++++++++---------
 3 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 74b4f8de..0591bdcc 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -7,6 +7,8 @@ The change log is available [on GitHub][2].
 0.5.0
 =====
 
+* [#97](https://github.com/kowainik/tomland/pull/97)
+  Allow underscores in integers*.
 * [#96](https://github.com/kowainik/tomland/issues/96):
   Migrate to megaparsec 7.0
 * [#81](https://github.com/kowainik/tomland/issues/81):
diff --git a/src/Toml/Parser.hs b/src/Toml/Parser.hs
index 84053ad5..acc98916 100644
--- a/src/Toml/Parser.hs
+++ b/src/Toml/Parser.hs
@@ -20,13 +20,14 @@ import Control.Applicative (Alternative (..))
 import Control.Applicative.Combinators (between, count, manyTill, optional, sepEndBy, skipMany)
 import Control.Monad (void)
 import Data.Char (chr, isControl)
+import Data.Either (fromRight)
 import Data.Fixed (Pico)
 import Data.Semigroup ((<>))
 import Data.Text (Text)
 import Data.Time (LocalTime (..), ZonedTime (..), fromGregorianValid, makeTimeOfDayValid,
                   minutesToTimeZone)
 import Data.Void (Void)
-import Text.Megaparsec (Parsec, anySingle, errorBundlePretty, satisfy, try)
+import Text.Megaparsec (Parsec, anySingle, errorBundlePretty, match, satisfy, try)
 import Text.Megaparsec.Char (alphaNumChar, char, digitChar, eol, hexDigitChar, space, space1,
                              string, tab)
 
@@ -36,6 +37,7 @@ import Toml.Type (AnyValue, DateTime (..), TOML (..), UValue (..), typeCheck)
 import qualified Control.Applicative.Combinators.NonEmpty as NC
 import qualified Data.HashMap.Lazy as HashMap
 import qualified Data.Text as Text
+import qualified Data.Text.Read as TR
 import qualified Text.Megaparsec as Mega (parse)
 import qualified Text.Megaparsec.Char.Lexer as L
 
@@ -159,10 +161,19 @@ tableNameP = lexeme $ between (char '[') (char ']') keyP
 
 -- Values
 
+decimalP :: Parser Integer
+decimalP = mkInteger <$> decimalStringP
+  where
+    decimalStringP   = fst <$> match (some digitChar >> many _digitsP)
+    _digitsP         = try (char '_') >> some digitChar
+    mkInteger        = textToInt . stripUnderscores
+    textToInt        = fst . fromRight (error "Underscore parser has a bug") . TR.decimal
+    stripUnderscores = Text.filter (/= '_')
+
 integerP :: Parser Integer
 integerP = lexeme $ binary <|> octal <|> hexadecimal <|> decimal
   where
-    decimal      = L.signed sc L.decimal
+    decimal      = L.signed sc decimalP
     binary       = try (char '0' >> char 'b') >> L.binary
     octal        = try (char '0' >> char 'o') >> L.octal
     hexadecimal  = try (char '0' >> char 'x') >> L.hexadecimal
diff --git a/test/Test/Toml/Parsing/Unit.hs b/test/Test/Toml/Parsing/Unit.hs
index 6e756caf..ccbe663d 100644
--- a/test/Test/Toml/Parsing/Unit.hs
+++ b/test/Test/Toml/Parsing/Unit.hs
@@ -38,6 +38,7 @@ spec_Parser = do
         dateTimeFailOn  = failOn dateTimeP
         doubleFailOn    = failOn doubleP
         keyValFailOn    = failOn keyValP
+        integerFailOn   = failOn integerP
         textFailOn      = failOn textP
 
         doubleSatisfies = parseXSatisfies doubleP
@@ -161,15 +162,15 @@ spec_Parser = do
                 $ do
                       parseInteger "-9223372036854775808" (-9223372036854775808)
                       parseInteger "9223372036854775807"  9223372036854775807
-          --xit "can parse numbers with underscores between digits" $ do
-          --  parseInt "1_000" 1000
-          --  parseInt "5_349_221" 5349221
-          --  parseInt "1_2_3_4_5" 12345
-          --  parseInt "1_2_3_" 1
-          --  parseInt "13_" 13
-          --  intFailOn "_123_"
-          --  intFailOn "_13"
-          --  intFailOn "_"
+            it "can parse numbers with underscores between digits" $ do
+               parseInteger "1_000" 1000
+               parseInteger "5_349_221" 5349221
+               parseInteger "1_2_3_4_5" 12345
+               integerFailOn "1_2_3_"
+               integerFailOn "13_"
+               integerFailOn "_123_"
+               integerFailOn "_13"
+               integerFailOn "_"
           --xit "does not parse numbers with leading zeros" $ do
           --  parseInt "0123" 0
           --  parseInt "-023" 0