Merge pull request #22 from garyb/hugeint

Use HugeInt for Integer

Author: garyb

bower.json

@@ -23,7 +23,9 @@
     "purescript-newtype": "^2.0.0",
     "purescript-parsing": "^4.1.0",
     "purescript-precise": "^2.0.0",
-    "purescript-profunctor-lenses": "^3.2.0",
-    "purescript-strongcheck": "^3.1.0"
+    "purescript-profunctor-lenses": "^3.2.0"
+  },
+  "devDependencies": {
+    "purescript-quickcheck": "^4.4.0"
   }
 }

src/Data/Json/Extended.purs

@@ -5,6 +5,7 @@ module Data.Json.Extended
   , boolean
   , integer
   , decimal
+  , number
   , string
   , map
   , map'
@@ -24,6 +25,7 @@ module Data.Json.Extended
   , _Boolean
   , _Integer
   , _Decimal
+  , _Number
   , _Array
   , _Map
   , _Map'
@@ -32,26 +34,25 @@ module Data.Json.Extended
 import Prelude hiding (map)
 
 import Control.Lazy as Lazy
-
 import Data.Argonaut as JS
 import Data.Bitraversable (bitraverse)
 import Data.Either as E
 import Data.Functor as F
 import Data.Functor.Mu as Mu
+import Data.HugeInt as HI
 import Data.HugeNum as HN
 import Data.Json.Extended.Signature as Sig
+import Data.Json.Extended.Signature hiding (getType) as Exports
 import Data.Json.Extended.Type (EJsonType)
 import Data.Lens (Prism', preview, prism')
 import Data.Map as Map
 import Data.Maybe as M
 import Data.StrMap as SM
 import Data.Traversable (for)
 import Data.Tuple as T
-import Data.Json.Extended.Signature hiding (getType) as Exports
-
 import Matryoshka (class Corecursive, class Recursive, anaM, cata, embed, project)
-
-import Test.StrongCheck.Gen as Gen
+import Control.Monad.Gen (class MonadGen)
+import Control.Monad.Rec.Class (class MonadRec)
 import Text.Parsing.Parser as P
 
 type EJson = Mu.Mu Sig.EJsonF
@@ -62,7 +63,13 @@ decodeEJson = anaM Sig.decodeJsonEJsonF
 encodeEJson ∷ ∀ t. Recursive t Sig.EJsonF ⇒ t → JS.Json
 encodeEJson = cata Sig.encodeJsonEJsonF
 
-arbitraryEJsonOfSize ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Gen.Size → Gen.Gen t
+arbitraryEJsonOfSize
+  ∷ ∀ m t
+  . MonadGen m
+  ⇒ MonadRec m
+  ⇒ Corecursive t Sig.EJsonF
+  ⇒ Int
+  → m t
 arbitraryEJsonOfSize = anaM Sig.arbitraryEJsonF
 
 renderEJson ∷ ∀ t. Recursive t Sig.EJsonF ⇒ t → String
@@ -78,12 +85,15 @@ null = embed Sig.Null
 boolean ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Boolean → t
 boolean = embed <<< Sig.Boolean
 
-integer ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Int → t
+integer ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ HI.HugeInt → t
 integer = embed <<< Sig.Integer
 
 decimal ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ HN.HugeNum → t
 decimal = embed <<< Sig.Decimal
 
+number ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ E.Either HI.HugeInt HN.HugeNum → t
+number = embed <<< E.either Sig.Integer Sig.Decimal
+
 string ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ String → t
 string = embed <<< Sig.String
 
@@ -116,7 +126,7 @@ _Boolean = prism' boolean $ project >>> case _ of
   Sig.Boolean b → M.Just b
   _ → M.Nothing
 
-_Integer ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Recursive t Sig.EJsonF ⇒ Prism' t Int
+_Integer ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Recursive t Sig.EJsonF ⇒ Prism' t HI.HugeInt
 _Integer = prism' integer $ project >>> case _ of
   Sig.Integer i → M.Just i
   _ → M.Nothing
@@ -126,6 +136,12 @@ _Decimal = prism' decimal $ project >>> case _ of
   Sig.Decimal d → M.Just d
   _ → M.Nothing
 
+_Number ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Recursive t Sig.EJsonF ⇒ Prism' t (E.Either HI.HugeInt HN.HugeNum)
+_Number = prism' number $ project >>> case _ of
+  Sig.Integer i → M.Just (E.Left i)
+  Sig.Decimal d → M.Just (E.Right d)
+  _ → M.Nothing
+
 _Array ∷ ∀ t. Corecursive t Sig.EJsonF ⇒ Recursive t Sig.EJsonF ⇒ Prism' t (Array t)
 _Array = prism' array $ project >>> case _ of
   Sig.Array xs → M.Just xs

src/Data/Json/Extended/Signature/Core.purs

@@ -10,6 +10,7 @@ import Data.Bifunctor as BF
 import Data.Eq (class Eq1)
 import Data.Foldable as F
 import Data.HugeNum as HN
+import Data.HugeInt as HI
 import Data.Json.Extended.Type as JT
 import Data.List as L
 import Data.Map as M
@@ -25,7 +26,7 @@ data EJsonF a
   = Null
   | String String
   | Boolean Boolean
-  | Integer Int
+  | Integer HI.HugeInt
   | Decimal HN.HugeNum
   | Array (Array a)
   | Map (EJsonMap a)

src/Data/Json/Extended/Signature/Gen.purs

@@ -4,27 +4,29 @@ module Data.Json.Extended.Signature.Gen
 
 import Prelude
 
+import Control.Monad.Gen (class MonadGen)
+import Control.Monad.Gen as Gen
+import Control.Monad.Rec.Class (class MonadRec)
 import Data.Array as A
+import Data.HugeInt as HI
 import Data.HugeNum as HN
 import Data.Json.Extended.Signature.Core (EJsonF(..), EJsonMap(..))
+import Data.NonEmpty ((:|))
+import Data.String.Gen as GenS
 import Data.Tuple as T
-
 import Matryoshka (CoalgebraM)
 
-import Test.StrongCheck.Arbitrary as SC
-import Test.StrongCheck.Gen as Gen
-
-arbitraryEJsonF ∷ CoalgebraM Gen.Gen EJsonF Int
+arbitraryEJsonF ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ CoalgebraM m EJsonF Int
 arbitraryEJsonF 0 =
-  Gen.oneOf (pure Null)
-    [ map Boolean SC.arbitrary
-    , map Integer SC.arbitrary
-    , map Decimal $ map HN.fromNumber SC.arbitrary
-    , map String SC.arbitrary
+  Gen.oneOf $ pure Null :|
+    [ Boolean <$> Gen.chooseBool
+    , Integer <<< HI.fromInt <$> Gen.chooseInt (-1000000) 1000000
+    , Decimal <<< HN.fromNumber <$> Gen.chooseFloat (-1000000.0) 1000000.0
+    , String <$> GenS.genUnicodeString
     ]
 arbitraryEJsonF n = do
   len ← Gen.chooseInt 0 $ n - 1
-  Gen.oneOf (arbitraryEJsonF 0)
+  Gen.oneOf $ arbitraryEJsonF 0 :|
     [ pure $ Array $ A.replicate len $ n - 1
     , pure $ Map $ EJsonMap $ A.replicate len $ T.Tuple (n - 1) (n - 1)
     ]

src/Data/Json/Extended/Signature/Json.purs

@@ -3,26 +3,25 @@ module Data.Json.Extended.Signature.Json where
 import Prelude
 
 import Control.Alt ((<|>))
-
 import Data.Argonaut.Core as JS
 import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.?))
 import Data.Argonaut.Encode (encodeJson)
 import Data.Bifunctor (lmap)
 import Data.Either as E
+import Data.HugeInt as HI
 import Data.HugeNum as HN
 import Data.Int as Int
 import Data.Json.Extended.Signature.Core (EJsonF(..), EJsonMap(..))
 import Data.Maybe as M
 import Data.StrMap as SM
 import Data.Traversable as TR
-
 import Matryoshka (Algebra, CoalgebraM)
 
 encodeJsonEJsonF ∷ Algebra EJsonF JS.Json
 encodeJsonEJsonF = case _ of
   Null → JS.jsonNull
   Boolean b → encodeJson b
-  Integer i → encodeJson i
+  Integer i → encodeJson $ HN.toNumber $ HI.toHugeNum i -- TODO: bug in HI.toInt
   Decimal a → encodeJson $ HN.toNumber a
   String str → encodeJson str
   Array xs → encodeJson xs
@@ -40,7 +39,7 @@ decodeJsonEJsonF =
   where
   decodeNumber ∷ Number → EJsonF JS.Json
   decodeNumber a = case Int.fromNumber a of
-    M.Just i → Integer i
+    M.Just i → Integer $ HI.fromInt i
     M.Nothing → Decimal $ HN.fromNumber a
 
   decodeArray ∷ JS.JArray → E.Either String (EJsonF JS.Json)

src/Data/Json/Extended/Signature/Parse.purs

@@ -4,6 +4,7 @@ module Data.Json.Extended.Signature.Parse
   , parseBooleanLiteral
   , parseDecimalLiteral
   , parseIntLiteral
+  , parseHugeIntLiteral
   , parseStringLiteral
   , parseArrayLiteral
   , parseMapLiteral
@@ -16,6 +17,7 @@ import Control.Alt ((<|>))
 import Data.Array as A
 import Data.Foldable as F
 import Data.HugeNum as HN
+import Data.HugeInt as HI
 import Data.Int as Int
 import Data.Json.Extended.Signature.Core (EJsonF(..), EJsonMap(..))
 import Data.List as L
@@ -104,13 +106,20 @@ parse1000
   hundreds x y z = x * 100 + y * 10 + z
   tens x y = x * 10 + y
 
+-- | This is used for parsing both `Int` and `HugeInt` values so has some extra
+-- | arguments. The `n` value should be 10 in the appropriate type, used to
+-- | move the place of each digit that is parsed. The `Int -> n` function
+-- | should convert a digit to the appropriate type. The `Int` provided will
+-- | always be in the range 0 to 9 inclusive.
 parseNat
-  ∷ ∀ m
+  ∷ ∀ m n
   . Monad m
-  ⇒ P.ParserT String m Int
-parseNat =
-  A.some parseDigit
-    <#> F.foldl (\a i → a * 10 + i) 0
+  ⇒ Semiring n
+  ⇒ n
+  → (Int → n)
+  → P.ParserT String m n
+parseNat ten digit =
+  F.foldl (\a i → a * ten + digit i) zero <$> A.some parseDigit
 
 parseNegative
   ∷ ∀ m a
@@ -158,7 +167,7 @@ parsePositiveScientific
   ⇒ P.ParserT String m HN.HugeNum
 parsePositiveScientific = do
   let ten = HN.fromNumber 10.0
-  lhs ← PC.try $ fromInt <$> parseNat <* PS.string "."
+  lhs ← PC.try $ parseNat ten fromInt <* PS.string "."
   rhs ← A.many parseDigit <#> F.foldr (\d f → divNum (f + fromInt d) ten) zero
   exp ← parseExponent
   pure $ (lhs + rhs) * HN.pow ten exp
@@ -171,7 +180,6 @@ parsePositiveScientific = do
     HN.fromNumber $
     HN.toNumber a / HN.toNumber b
 
-
 parseHugeNum
   ∷ ∀ m
   . Monad m
@@ -202,8 +210,11 @@ parseBooleanLiteral =
 parseDecimalLiteral ∷ ∀ m. Monad m ⇒ P.ParserT String m HN.HugeNum
 parseDecimalLiteral = parseHugeNum <|> parseScientific
 
+parseHugeIntLiteral ∷ ∀ m. Monad m ⇒ P.ParserT String m HI.HugeInt
+parseHugeIntLiteral = parseSigned (parseNat (HI.fromInt 10) HI.fromInt)
+
 parseIntLiteral ∷ ∀ m. Monad m ⇒ P.ParserT String m Int
-parseIntLiteral = parseSigned parseNat
+parseIntLiteral = parseSigned (parseNat 10 id)
 
 parseStringLiteral ∷ ∀ m. Monad m ⇒ P.ParserT String m String
 parseStringLiteral = quoted stringInner
@@ -226,11 +237,11 @@ parseEJsonF
   ⇒ P.ParserT String m a
   → P.ParserT String m (EJsonF a)
 parseEJsonF rec =
-  PC.choice $
+  PC.choice
     [ Null <$ parseNull
     , Boolean <$> parseBooleanLiteral
     , Decimal <$> PC.try parseDecimalLiteral
-    , Integer <$> parseIntLiteral
+    , Integer <$> parseHugeIntLiteral
     , String <$> parseStringLiteral
     , Array <$> parseArrayLiteral rec
     , Map <$> parseMapLiteral rec

src/Data/Json/Extended/Signature/Render.purs

@@ -6,21 +6,24 @@ import Prelude
 
 import Data.Either (fromRight)
 import Data.Foldable as F
+import Data.HugeInt as HI
 import Data.HugeNum as HN
 import Data.Json.Extended.Signature.Core (EJsonF(..), EJsonMap(..))
+import Data.Maybe (fromMaybe)
+import Data.String as Str
 import Data.String.Regex as RX
 import Data.String.Regex.Flags as RXF
 import Data.Tuple as T
-
 import Matryoshka (Algebra)
-
 import Partial.Unsafe (unsafePartial)
 
 renderEJsonF ∷ Algebra EJsonF String
 renderEJsonF = case _ of
   Null → "null"
   Boolean b → if b then "true" else "false"
-  Integer i → show i
+  Integer i →
+    let s = HN.toString (HI.toHugeNum i)
+    in fromMaybe s $ Str.stripSuffix (Str.Pattern ".0") s
   Decimal a → HN.toString a
   String str → stringEJson str
   Array ds → squares $ commaSep ds