diff --git a/bower.json b/bower.json index 1011e99..66eb5e4 100644 --- a/bower.json +++ b/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" } } diff --git a/src/Data/Json/Extended.purs b/src/Data/Json/Extended.purs index 3397344..8bdb82a 100644 --- a/src/Data/Json/Extended.purs +++ b/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,14 +34,15 @@ 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 @@ -47,11 +50,9 @@ 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 diff --git a/src/Data/Json/Extended/Signature/Core.purs b/src/Data/Json/Extended/Signature/Core.purs index d93ac6a..2edc596 100644 --- a/src/Data/Json/Extended/Signature/Core.purs +++ b/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) diff --git a/src/Data/Json/Extended/Signature/Gen.purs b/src/Data/Json/Extended/Signature/Gen.purs index 244cb4c..7761fd0 100644 --- a/src/Data/Json/Extended/Signature/Gen.purs +++ b/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) ] diff --git a/src/Data/Json/Extended/Signature/Json.purs b/src/Data/Json/Extended/Signature/Json.purs index c10e9a0..109a319 100644 --- a/src/Data/Json/Extended/Signature/Json.purs +++ b/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) diff --git a/src/Data/Json/Extended/Signature/Parse.purs b/src/Data/Json/Extended/Signature/Parse.purs index e992097..eefebed 100644 --- a/src/Data/Json/Extended/Signature/Parse.purs +++ b/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 diff --git a/src/Data/Json/Extended/Signature/Render.purs b/src/Data/Json/Extended/Signature/Render.purs index f8bfa98..2df7236 100644 --- a/src/Data/Json/Extended/Signature/Render.purs +++ b/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 diff --git a/test/Main.purs b/test/Main.purs index 230e31d..a1a4407 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -3,22 +3,19 @@ module Test.Main where import Prelude import Control.Monad.Eff (Eff) +import Control.Monad.Eff.Console (CONSOLE) import Control.Monad.Eff.Exception (EXCEPTION) import Control.Monad.Eff.Random (RANDOM) -import Control.Monad.Eff.Console (CONSOLE) - import Data.Either as E -import Data.Maybe (Maybe(..)) -import Data.StrMap as SM -import Data.Tuple (Tuple(..)) import Data.Json.Extended (EJson, arbitraryEJsonOfSize, renderEJson, parseEJson, decodeEJson, encodeEJson) import Data.Json.Extended as EJ import Data.Json.Extended.Cursor as EJC - -import Test.StrongCheck (()) -import Test.StrongCheck as SC -import Test.StrongCheck.Arbitrary as SCA - +import Data.Maybe (Maybe(..)) +import Data.StrMap as SM +import Data.Tuple (Tuple(..)) +import Test.QuickCheck (()) +import Test.QuickCheck as QC +import Test.QuickCheck.Arbitrary as QCA import Text.Parsing.Parser as P type TestEffects = @@ -29,25 +26,25 @@ type TestEffects = newtype ArbEJson = ArbEJson EJson -instance arbitraryArbEJson ∷ SCA.Arbitrary ArbEJson where +instance arbitraryArbEJson ∷ QCA.Arbitrary ArbEJson where arbitrary = map ArbEJson $ arbitraryEJsonOfSize 3 testJsonSerialization ∷ Eff TestEffects Unit testJsonSerialization = - SC.quickCheck' 1000 \(ArbEJson x) → case decodeEJson (encodeEJson x) of + QC.quickCheck' 1000 \(ArbEJson x) → case decodeEJson (encodeEJson x) of E.Right y → x == y "Mismatch:\n" <> renderEJson x <> "\n" <> renderEJson y E.Left err → - SC.Failed $ "Parse error: " <> err + QC.Failed $ "Parse error: " <> err testRenderParse ∷ Eff TestEffects Unit testRenderParse = - SC.quickCheck' 1000 \(ArbEJson x) → case P.runParser (renderEJson x) parseEJson of + QC.quickCheck' 1000 \(ArbEJson x) → case P.runParser (renderEJson x) parseEJson of E.Right y → x == y "Mismatch:\n" <> renderEJson x <> "\n" <> renderEJson y E.Left err → - SC.Failed $ "Parse error: " <> show err <> " when parsing:\n\n " <> renderEJson x <> "\n\n" + QC.Failed $ "Parse error: " <> show err <> " when parsing:\n\n " <> renderEJson x <> "\n\n" testCursorExamples ∷ Eff TestEffects Unit testCursorExamples = do @@ -104,16 +101,16 @@ testCursorExamples = do → Maybe (Tuple EJC.Cursor EJC.Cursor) → Eff TestEffects Unit assertMbTplEq x y = - SC.assert - $ SC.assertEq + QC.quickCheck' 1 $ + QC.assertEquals (map (\(Tuple a b) → "Tuple " <> EJC.renderEJsonCursor a <> " " <> EJC.renderEJsonCursor b) x) (map (\(Tuple a b) → "Tuple " <> EJC.renderEJsonCursor a <> " " <> EJC.renderEJsonCursor b) y) assertMbEq ∷ Maybe EJson → Maybe EJson → Eff TestEffects Unit - assertMbEq x y = SC.assert $ SC.assertEq (map renderEJson x) (map renderEJson y) + assertMbEq x y = QC.quickCheck' 1 $ QC.assertEquals (map renderEJson x) (map renderEJson y) assertEq ∷ EJson → EJson → Eff TestEffects Unit - assertEq x y = SC.assert $ x == y msg + assertEq x y = QC.quickCheck' 1 $ x == y msg where msg = renderEJson x <> " /= " <> renderEJson y