argo 0.2021.10.19 → 0.2021.10.24

raw patch · 39 files changed

+1018/−771 lines, 39 filesdep +genvaliditydep +genvalidity-containersdep +genvalidity-textdep −arrayPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: genvalidity, genvalidity-containers, genvalidity-text, transformers

Dependencies removed: array

API changes (from Hackage documentation)

Files

• argo.cabal +25/−11
• source/benchmark/Main.hs +27/−16
• source/executable/Main.hs +2/−9
• source/library/Argo.hs +11/−6
• source/library/Argo/Class/FromValue.hs +25/−39
• source/library/Argo/Class/ToValue.hs +15/−31
• source/library/Argo/Decode.hs +4/−7
• source/library/Argo/Decoder.hs +8/−9
• source/library/Argo/Encode.hs +20/−5
• source/library/Argo/Encoder.hs +57/−0
• source/library/Argo/Json/Array.hs +35/−0
• source/library/Argo/Json/Boolean.hs +35/−0
• source/library/Argo/Json/Member.hs +36/−0
• source/library/Argo/Json/Name.hs +22/−0
• source/library/Argo/Json/Null.hs +24/−0
• source/library/Argo/Json/Number.hs +109/−0
• source/library/Argo/Json/Object.hs +42/−0
• source/library/Argo/Json/String.hs +143/−0
• source/library/Argo/Json/Value.hs +46/−0
• source/library/Argo/Literal.hs +1/−1
• source/library/Argo/Main.hs +81/−0
• source/library/Argo/Pattern.hs +26/−15
• source/library/Argo/QuasiQuoter.hs +11/−12
• source/library/Argo/Type.hs +0/−10
• source/library/Argo/Type/Array.hs +0/−42
• source/library/Argo/Type/Boolean.hs +0/−34
• source/library/Argo/Type/Null.hs +0/−25
• source/library/Argo/Type/Number.hs +0/−109
• source/library/Argo/Type/Object.hs +0/−44
• source/library/Argo/Type/Pair.hs +0/−33
• source/library/Argo/Type/String.hs +0/−145
• source/library/Argo/Type/Value.hs +0/−61
• source/library/Argo/Vendor/Builder.hs +20/−0
• source/library/Argo/Vendor/ByteString.hs +20/−0
• source/library/Argo/Vendor/DeepSeq.hs +6/−0
• source/library/Argo/Vendor/TemplateHaskell.hs +9/−0
• source/library/Argo/Vendor/Text.hs +20/−0
• source/library/Argo/Vendor/Transformers.hs +15/−0
• source/test-suite/Main.hs +123/−107

@@ -1,7 +1,7 @@ cabal-version: 2.2  name: argo-version: 0.2021.10.19+version: 0.2021.10.24  build-type: Simple category: JSON@@ -23,13 +23,13 @@  common library     build-depends:-        , array >= 0.5.4 && < 0.6         , base >= 4.14.0 && < 4.16         , bytestring >= 0.10.12 && < 0.11         , containers >= 0.6.4 && < 0.7         , deepseq >= 1.4.4 && < 1.5         , template-haskell >= 2.16.0 && < 2.18         , text >= 1.2.4 && < 1.3+        , transformers >= 0.5.6 && < 0.6     default-language: Haskell2010     ghc-options:         -Weverything@@ -58,6 +58,7 @@ library     import: library +    autogen-modules: Paths_argo     exposed-modules:         Argo         Argo.Class.FromValue@@ -65,20 +66,30 @@         Argo.Decode         Argo.Decoder         Argo.Encode+        Argo.Encoder+        Argo.Json.Array+        Argo.Json.Boolean+        Argo.Json.Member+        Argo.Json.Name+        Argo.Json.Null+        Argo.Json.Number+        Argo.Json.Object+        Argo.Json.String+        Argo.Json.Value         Argo.Literal+        Argo.Main         Argo.Pattern         Argo.QuasiQuoter         Argo.Result-        Argo.Type-        Argo.Type.Array-        Argo.Type.Boolean-        Argo.Type.Null-        Argo.Type.Number-        Argo.Type.Object-        Argo.Type.Pair-        Argo.Type.String-        Argo.Type.Value     hs-source-dirs: source/library+    other-modules:+        Argo.Vendor.ByteString+        Argo.Vendor.Builder+        Argo.Vendor.DeepSeq+        Argo.Vendor.TemplateHaskell+        Argo.Vendor.Text+        Argo.Vendor.Transformers+        Paths_argo  executable argo     import: executable@@ -90,6 +101,9 @@     import: executable      build-depends:+        , genvalidity >= 0.11.0 && < 0.12+        , genvalidity-containers >= 0.9.0 && < 0.10+        , genvalidity-text >= 0.7.0 && < 0.8         , tasty >= 1.4.2 && < 1.5         , tasty-hunit >= 0.10.0 && < 0.11         , tasty-quickcheck >= 0.10.1 && < 0.11

@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-}  import qualified Argo-import qualified Data.Array import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LazyByteString@@ -29,20 +28,20 @@             , Tasty.bench "10000 characters" . Tasty.nf encode . Argo.String . Text.pack $ replicate 10000 'a'             ]         , Tasty.bgroup "Array"-            [ Tasty.bench "empty" . Tasty.nf encode . Argo.Array $ array []-            , Tasty.bench "1 element" . Tasty.nf encode . Argo.Array . array $ replicate 1 Argo.Null-            , Tasty.bench "10 elements" . Tasty.nf encode . Argo.Array . array $ replicate 10 Argo.Null-            , Tasty.bench "100 elements" . Tasty.nf encode . Argo.Array . array $ replicate 100 Argo.Null-            , Tasty.bench "1000 elements" . Tasty.nf encode . Argo.Array . array $ replicate 1000 Argo.Null-            , Tasty.bench "10000 elements" . Tasty.nf encode . Argo.Array . array $ replicate 10000 Argo.Null+            [ Tasty.bench "empty" . Tasty.nf encode $ Argo.Array []+            , Tasty.bench "1 element" . Tasty.nf encode . Argo.Array $ replicate 1 Argo.Null+            , Tasty.bench "10 elements" . Tasty.nf encode . Argo.Array $ replicate 10 Argo.Null+            , Tasty.bench "100 elements" . Tasty.nf encode . Argo.Array $ replicate 100 Argo.Null+            , Tasty.bench "1000 elements" . Tasty.nf encode . Argo.Array $ replicate 1000 Argo.Null+            , Tasty.bench "10000 elements" . Tasty.nf encode . Argo.Array $ replicate 10000 Argo.Null             ]         , Tasty.bgroup "Object"-            [ Tasty.bench "empty" . Tasty.nf encode . Argo.Object $ array []-            , Tasty.bench "1 element" . Tasty.nf encode . Argo.Object . array . replicate 1 $ Argo.Pair "" Argo.Null-            , Tasty.bench "10 elements" . Tasty.nf encode . Argo.Object . array . replicate 10 $ Argo.Pair "" Argo.Null-            , Tasty.bench "100 elements" . Tasty.nf encode . Argo.Object . array . replicate 100 $ Argo.Pair "" Argo.Null-            , Tasty.bench "1000 elements" . Tasty.nf encode . Argo.Object . array . replicate 1000 $ Argo.Pair "" Argo.Null-            , Tasty.bench "10000 elements" . Tasty.nf encode . Argo.Object . array . replicate 10000 $ Argo.Pair "" Argo.Null+            [ Tasty.bench "empty" . Tasty.nf encode $ Argo.Object []+            , Tasty.bench "1 element" . Tasty.nf encode . Argo.Object . replicate 1 $ Argo.Member (Argo.Name "") Argo.Null+            , Tasty.bench "10 elements" . Tasty.nf encode . Argo.Object . replicate 10 $ Argo.Member (Argo.Name "") Argo.Null+            , Tasty.bench "100 elements" . Tasty.nf encode . Argo.Object . replicate 100 $ Argo.Member (Argo.Name "") Argo.Null+            , Tasty.bench "1000 elements" . Tasty.nf encode . Argo.Object . replicate 1000 $ Argo.Member (Argo.Name "") Argo.Null+            , Tasty.bench "10000 elements" . Tasty.nf encode . Argo.Object . replicate 10000 $ Argo.Member (Argo.Name "") Argo.Null             ]         ]     , Tasty.bgroup "decode" $ let decode = resultToMaybe . Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in@@ -64,18 +63,30 @@             , Tasty.bench "short escape" $ Tasty.nf decode "\"\\n\""             , Tasty.bench "long escape" $ Tasty.nf decode "\"\\u001f\""             , Tasty.bench "surrogate pair" $ Tasty.nf decode "\"\\ud834\\udd1e\""+            , Tasty.bench "1 character" . Tasty.nf decode $ "\"" <> ByteString.replicate 1 0x61 <> "\""+            , Tasty.bench "10 characters" . Tasty.nf decode $ "\"" <> ByteString.replicate 10 0x61 <> "\""+            , Tasty.bench "100 characters" . Tasty.nf decode $ "\"" <> ByteString.replicate 100 0x61 <> "\""+            , Tasty.bench "1000 characters" . Tasty.nf decode $ "\"" <> ByteString.replicate 1000 0x61 <> "\""+            , Tasty.bench "10000 characters" . Tasty.nf decode $ "\"" <> ByteString.replicate 10000 0x61 <> "\""             ]         , Tasty.bgroup "Array"             [ Tasty.bench "empty" $ Tasty.nf decode "[]"+            , Tasty.bench "1 element" $ Tasty.nf decode "[null]"+            , Tasty.bench "10 elements" . Tasty.nf decode $ "[null" <> ByteString.pack (take (5 * 9) $ cycle [0x2c, 0x6e, 0x75, 0x6c, 0x6c]) <> "]"+            , Tasty.bench "100 elements" . Tasty.nf decode $ "[null" <> ByteString.pack (take (5 * 99) $ cycle [0x2c, 0x6e, 0x75, 0x6c, 0x6c]) <> "]"+            , Tasty.bench "1000 elements" . Tasty.nf decode $ "[null" <> ByteString.pack (take (5 * 999) $ cycle [0x2c, 0x6e, 0x75, 0x6c, 0x6c]) <> "]"+            , Tasty.bench "10000 elements" . Tasty.nf decode $ "[null" <> ByteString.pack (take (5 * 9999) $ cycle [0x2c, 0x6e, 0x75, 0x6c, 0x6c]) <> "]"             ]         , Tasty.bgroup "Object"             [ Tasty.bench "empty" $ Tasty.nf decode "{}"+            , Tasty.bench "1 element" $ Tasty.nf decode "{\"\":null}"+            , Tasty.bench "10 elements" . Tasty.nf decode $ "{\"\":null" <> ByteString.pack (take (5 * 9) $ cycle [0x2c, 0x22, 0x22, 0x3a, 0x6e, 0x75, 0x6c, 0x6c]) <> "}"+            , Tasty.bench "100 elements" . Tasty.nf decode $ "{\"\":null" <> ByteString.pack (take (5 * 99) $ cycle [0x2c, 0x22, 0x22, 0x3a, 0x6e, 0x75, 0x6c, 0x6c]) <> "}"+            , Tasty.bench "1000 elements" . Tasty.nf decode $ "{\"\":null" <> ByteString.pack (take (5 * 999) $ cycle [0x2c, 0x22, 0x22, 0x3a, 0x6e, 0x75, 0x6c, 0x6c]) <> "}"+            , Tasty.bench "10000 elements" . Tasty.nf decode $ "{\"\":null" <> ByteString.pack (take (5 * 9999) $ cycle [0x2c, 0x22, 0x22, 0x3a, 0x6e, 0x75, 0x6c, 0x6c]) <> "}"             ]         ]     ]--array :: [a] -> Data.Array.Array Int a-array xs = Data.Array.listArray (0, length xs - 1) xs  resultToMaybe :: Argo.Result a -> Maybe a resultToMaybe r = case r of

@@ -1,11 +1,4 @@-import qualified Argo-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Builder as Builder-import qualified System.IO as IO+import qualified Argo.Main as Argo  main :: IO ()-main = do-    contents <- ByteString.getContents-    case Argo.decode contents of-        Argo.Failure e -> fail e-        Argo.Success value -> Builder.hPutBuilder IO.stdout $ Argo.encode (value :: Argo.Value)+main = Argo.main

@@ -9,10 +9,15 @@         , Pattern.Array         , Pattern.Object         )-    , Type.Array-    , Pair.Pair(Pattern.Pair)-    , Type.Object+    , Pattern.Array+    , Name.Name+    , pattern Pattern.Name+    , Pattern.Member+    , pattern Pattern.Member+    , Pattern.Object     , Encode.encode+    , Encode.encodeWith+    , Encoder.Indent(Spaces, Tab)     , Decode.decode     , FromValue.FromValue(fromValue)     , ToValue.ToValue(toValue)@@ -24,9 +29,9 @@ import qualified Argo.Class.ToValue as ToValue import qualified Argo.Decode as Decode import qualified Argo.Encode as Encode+import qualified Argo.Encoder as Encoder+import qualified Argo.Json.Name as Name+import qualified Argo.Json.Value as Value import qualified Argo.Pattern as Pattern import qualified Argo.QuasiQuoter as QuasiQuoter import qualified Argo.Result as Result-import qualified Argo.Type as Type-import qualified Argo.Type.Pair as Pair-import qualified Argo.Type.Value as Value

@@ -2,21 +2,15 @@  module Argo.Class.FromValue where +import qualified Argo.Json.Number as Number+import qualified Argo.Json.Value as Value+import qualified Argo.Pattern as Pattern import qualified Argo.Result as Result-import qualified Argo.Type.Array as Array-import qualified Argo.Type.Boolean as Boolean-import qualified Argo.Type.Number as Number-import qualified Argo.Type.Object as Object-import qualified Argo.Type.Pair as Pair-import qualified Argo.Type.String as String-import qualified Argo.Type.Value as Value-import qualified Data.Array+import qualified Argo.Vendor.Text as Text import qualified Data.Bits as Bits import qualified Data.Int as Int import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map-import qualified Data.Text as Text-import qualified Data.Text.Lazy as LazyText import qualified Data.Word as Word  class FromValue a where@@ -66,7 +60,7 @@ instance FromValue Integer where     fromValue = withNumber "Integer" $ \ x y ->         if y < 0-        then fail $ "expected integer but got " <> show (Number.number x y)+        then fail $ "expected integer but got " <> show (Pattern.Number x y)         else pure $ x * 10 ^ y  instance FromValue Float where@@ -83,70 +77,62 @@ instance FromValue Text.Text where     fromValue = withString "Text" pure -instance FromValue LazyText.Text where-    fromValue = fmap LazyText.fromStrict . fromValue+instance FromValue Text.LazyText where+    fromValue = fmap Text.fromStrict . fromValue  instance FromValue a => FromValue (Maybe a) where     fromValue x = case x of-        Value.Null _ -> pure Nothing+        Pattern.Null -> pure Nothing         _ -> Just <$> fromValue x  instance FromValue () where-    fromValue x = do-        [] <- fromValue x :: Result.Result [Value.Value]-        pure ()+    fromValue = withArray "()" $ \ xs -> case xs of+        [] -> pure ()+        _ -> fail $ "expected empty list but got " <> show xs  instance (FromValue a, FromValue b) => FromValue (a, b) where-    fromValue x = do-        [y, z] <- fromValue x-        (,) <$> fromValue y <*> fromValue z--instance FromValue a => FromValue (Data.Array.Array Int a) where-    fromValue = withArray "Array" $ traverse fromValue+    fromValue = withArray "(a, b)" $ \ xs -> case xs of+        [x, y] -> (,) <$> fromValue x <*> fromValue y+        _ -> fail $ "expected tuple but got " <> show xs  instance FromValue a => FromValue [a] where-    fromValue =-        let-            arrayToList :: Data.Array.Array Int b -> [b]-            arrayToList = Data.Array.elems-        in fmap arrayToList . fromValue+    fromValue = withArray "[a]" $ traverse fromValue -instance (FromValue a, Show a) => FromValue (NonEmpty.NonEmpty a) where+instance FromValue a => FromValue (NonEmpty.NonEmpty a) where     fromValue value = do         list <- fromValue value         case NonEmpty.nonEmpty list of-            Nothing -> fail $ "expected non-empty list but got " <> show list+            Nothing -> fail "unexpected empty list"             Just nonEmpty -> pure nonEmpty  instance FromValue a => FromValue (Map.Map Text.Text a) where     fromValue = withObject "Map"         $ fmap Map.fromList-        . traverse (\ (Pair.Pair (String.String k, v)) -> (,) k <$> fromValue v)-        . Data.Array.elems+        . traverse (\ (Pattern.Member (Pattern.Name k) v) -> (,) k <$> fromValue v)  withBoolean :: String -> (Bool -> Result.Result a) -> Value.Value -> Result.Result a withBoolean s f x = case x of-    Value.Boolean (Boolean.Boolean y) -> f y+    Pattern.Boolean y -> f y     _ -> fail $ "expected " <> s <> " but got " <> show x  withNumber :: String -> (Integer -> Integer -> Result.Result a) -> Value.Value -> Result.Result a withNumber s f x = case x of-    Value.Number (Number.Number y z) -> f y z+    Pattern.Number y z -> f y z     _ -> fail $ "expected " <> s <> " but got " <> show x  withString :: String -> (Text.Text -> Result.Result a) -> Value.Value -> Result.Result a withString s f x = case x of-    Value.String (String.String y) -> f y+    Pattern.String y -> f y     _ -> fail $ "expected " <> s <> " but got " <> show x -withArray :: String -> (Data.Array.Array Int Value.Value -> Result.Result a) -> Value.Value -> Result.Result a+withArray :: String -> (Pattern.Array -> Result.Result a) -> Value.Value -> Result.Result a withArray s f x = case x of-    Value.Array (Array.Array y) -> f y+    Pattern.Array y -> f y     _ -> fail $ "expected " <> s <> " but got " <> show x -withObject :: String -> (Data.Array.Array Int (Pair.Pair String.String Value.Value) -> Result.Result a) -> Value.Value -> Result.Result a+withObject :: String -> (Pattern.Object -> Result.Result a) -> Value.Value -> Result.Result a withObject s f x = case x of-    Value.Object (Object.Object y) -> f y+    Pattern.Object y -> f y     _ -> fail $ "expected " <> s <> " but got " <> show x  viaInteger :: (Integral a, Bits.Bits a) => Value.Value -> Result.Result a

@@ -2,21 +2,14 @@  module Argo.Class.ToValue where -import qualified Argo.Type.Array as Array-import qualified Argo.Type.Boolean as Boolean-import qualified Argo.Type.Null as Null-import qualified Argo.Type.Number as Number-import qualified Argo.Type.Object as Object-import qualified Argo.Type.Pair as Pair-import qualified Argo.Type.String as String-import qualified Argo.Type.Value as Value-import qualified Data.Array+import qualified Argo.Json.Number as Number+import qualified Argo.Json.Value as Value+import qualified Argo.Pattern as Pattern+import qualified Argo.Vendor.Text as Text import qualified Data.Int as Int import qualified Data.List as List import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map as Map-import qualified Data.Text as Text-import qualified Data.Text.Lazy as LazyText import qualified Data.Word as Word import qualified Numeric @@ -27,7 +20,7 @@     toValue = id  instance ToValue Bool where-    toValue = Value.Boolean . Boolean.Boolean+    toValue = Pattern.Boolean  instance ToValue Char where     toValue = toValue . Text.singleton@@ -63,7 +56,7 @@     toValue = toValue . toInteger  instance ToValue Integer where-    toValue = Value.Number . flip Number.number 0+    toValue = flip Pattern.Number 0  instance ToValue Float where     toValue = realFloatToValue@@ -75,13 +68,13 @@     toValue = toValue . Text.pack  instance ToValue Text.Text where-    toValue = Value.String . String.String+    toValue = Pattern.String -instance ToValue LazyText.Text where-    toValue = toValue . LazyText.toStrict+instance ToValue Text.LazyText where+    toValue = toValue . Text.toStrict  instance ToValue a => ToValue (Maybe a) where-    toValue = maybe (Value.Null $ Null.Null ()) toValue+    toValue = maybe Pattern.Null toValue  instance ToValue () where     toValue = const $ toValue ([] :: [Value.Value])@@ -89,30 +82,21 @@ instance (ToValue a, ToValue b) => ToValue (a, b) where     toValue (x, y) = toValue [toValue x, toValue y] -instance ToValue a => ToValue (Data.Array.Array Int a) where-    toValue = Value.Array . Array.Array . fmap toValue- instance ToValue a => ToValue [a] where-    toValue =-        let-            listToArray :: [b] -> Data.Array.Array Int b-            listToArray xs = Data.Array.listArray (0, length xs - 1) xs-        in toValue . listToArray+    toValue = Pattern.Array . fmap toValue  instance ToValue a => ToValue (NonEmpty.NonEmpty a) where     toValue = toValue . NonEmpty.toList  instance ToValue a => ToValue (Map.Map Text.Text a) where-    toValue x = Value.Object-        . Object.Object-        . Data.Array.listArray (0, Map.size x - 1)-        . fmap (\ (k, v) -> Pair.Pair (String.String k, toValue v))+    toValue x = Pattern.Object+        . fmap (\ (k, v) -> Pattern.Member (Pattern.Name k) (toValue v))         $ Map.toAscList x  realFloatToValue :: RealFloat a => a -> Value.Value realFloatToValue x-    | isNaN x = Value.Null $ Null.Null ()-    | isInfinite x = Value.Null $ Null.Null ()+    | isNaN x = Pattern.Null+    | isInfinite x = Pattern.Null     | otherwise =         let isNegative = x < 0         in Value.Number

@@ -2,15 +2,12 @@  import qualified Argo.Class.FromValue as FromValue import qualified Argo.Decoder as Decoder+import qualified Argo.Json.Value as Value import qualified Argo.Result as Result-import qualified Argo.Type.Value as Value-import qualified Data.ByteString as ByteString+import qualified Argo.Vendor.ByteString as ByteString  decode :: FromValue.FromValue a => ByteString.ByteString -> Result.Result a-decode = decodeWith FromValue.fromValue--decodeWith :: (Value.Value -> Result.Result a) -> ByteString.ByteString -> Result.Result a-decodeWith f x =+decode x =     case Decoder.run (Decoder.spaces *> Value.decode <* Decoder.eof) x of         Result.Failure e -> Result.Failure e-        Result.Success (_, y) -> f y+        Result.Success (_, y) -> FromValue.fromValue y

@@ -2,10 +2,9 @@  import qualified Argo.Literal as Literal import qualified Argo.Result as Result+import qualified Argo.Vendor.ByteString as ByteString import qualified Control.Applicative as Applicative import qualified Control.Monad as Monad-import qualified Data.Array as Array-import qualified Data.ByteString as ByteString import qualified Data.Word as Word  newtype Decoder a = Decoder@@ -39,19 +38,19 @@         Result.Failure _ -> run dy b1         Result.Success (b2, x) -> Result.Success (b2, x) -array :: Decoder a -> Decoder (Array.Array Int a)-array f = arrayWith f 0 []+list :: Decoder a -> Decoder [a]+list f = listWith f [] -arrayWith :: Decoder a -> Int -> [(Int, a)] -> Decoder (Array.Array Int a)-arrayWith f n xs = do+listWith :: Decoder a -> [a] -> Decoder [a]+listWith f xs = do     m <- Applicative.optional $ do-        Monad.when (n /= 0) $ do+        Monad.unless (null xs) $ do             word8 Literal.comma             spaces         f     case m of-        Nothing -> pure $ Array.array (0, n - 1) xs-        Just x -> arrayWith f (n + 1) $ (n, x) : xs+        Nothing -> pure $ reverse xs+        Just x -> listWith f $ x : xs  byteString :: ByteString.ByteString -> Decoder () byteString x = do

@@ -1,11 +1,26 @@ module Argo.Encode where  import qualified Argo.Class.ToValue as ToValue-import qualified Argo.Type.Value as Value-import qualified Data.ByteString.Builder as Builder+import qualified Argo.Encoder as Encoder+import qualified Argo.Json.Value as Value+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Monad as Monad+import qualified Data.Functor.Identity as Identity  encode :: ToValue.ToValue a => a -> Builder.Builder-encode = encodeWith ToValue.toValue+encode = encodeWith $ Encoder.Spaces 0 -encodeWith :: (a -> Value.Value) -> a -> Builder.Builder-encodeWith f = Value.encode . f+encodeWith :: ToValue.ToValue a => Encoder.Indent -> a -> Builder.Builder+encodeWith i x =+    let c = Encoder.Config { Encoder.indent = i, Encoder.level = 0 }+    in Identity.runIdentity+    . Trans.execWriterT+    . flip Trans.runReaderT c+    $ do+        Value.encode $ ToValue.toValue x+        Monad.when (Encoder.hasIndent c)+            . Trans.lift+            . Trans.tell+            $ Builder.word8 Literal.newLine

@@ -0,0 +1,57 @@+module Argo.Encoder where++import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Monad as Monad+import qualified Data.Functor.Identity as Identity+import qualified Data.Semigroup as Semigroup++type Encoder = Trans.ReaderT Config (Trans.WriterT Builder.Builder Identity.Identity)++data Config = Config+    { indent :: Indent+    , level :: Int+    } deriving (Eq, Show)++data Indent+    = Spaces Int+    | Tab+    deriving (Eq, Show)++hasIndent :: Config -> Bool+hasIndent x = case indent x of+    Spaces y -> y > 0+    Tab -> True++increaseLevel :: Config -> Config+increaseLevel x = x { level = level x + 1 }++list :: Encoder () -> Encoder () -> Encoder () -> (a -> Encoder ()) -> [a] -> Encoder ()+list l r s f xs = case xs of+    [] -> do+        l+        r+    x : ys -> do+        l+        c <- Trans.ask+        let newLine = if hasIndent c then Builder.word8 Literal.newLine else mempty+        Trans.local increaseLevel $ do+            i <- Trans.asks makeIndent+            Trans.lift . Trans.tell $ newLine <> i+            f x+            Monad.forM_ ys $ \ y -> do+                s+                Trans.lift . Trans.tell $ newLine <> i+                f y+        Trans.lift . Trans.tell $ newLine <> makeIndent c+        r++makeIndent :: Config -> Builder.Builder+makeIndent x = case indent x of+    Spaces y -> if y <= 0 then mempty else+        Semigroup.stimesMonoid (level x)+        . Semigroup.stimes y+        $ Builder.word8 Literal.space+    Tab -> Semigroup.stimesMonoid (level x)+        $ Builder.word8 Literal.horizontalTabulation

@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Array where++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Transformers as Trans+import qualified GHC.Generics as Generics++newtype ArrayOf value+    = Array [value]+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: (value -> Encoder.Encoder ()) -> ArrayOf value -> Encoder.Encoder ()+encode f (Array xs) = Encoder.list+    (Trans.lift . Trans.tell $ Builder.word8 Literal.leftSquareBracket)+    (Trans.lift . Trans.tell $ Builder.word8 Literal.rightSquareBracket)+    (Trans.lift . Trans.tell $ Builder.word8 Literal.comma)+    f+    xs++decode :: Decoder.Decoder value -> Decoder.Decoder (ArrayOf value)+decode f = do+    Decoder.word8 Literal.leftSquareBracket+    Decoder.spaces+    xs <- Decoder.list f+    Decoder.word8 Literal.rightSquareBracket+    Decoder.spaces+    pure $ Array xs

@@ -0,0 +1,35 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Boolean where++import Control.Applicative ((<|>))++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Transformers as Trans+import qualified GHC.Generics as Generics++newtype Boolean+    = Boolean Bool+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: Boolean -> Encoder.Encoder ()+encode (Boolean x) = Trans.lift+    . Trans.tell+    . Builder.byteString+    $ if x then Literal.true else Literal.false++decode :: Decoder.Decoder Boolean+decode = decodeFalse <|> decodeTrue++decodeFalse :: Decoder.Decoder Boolean+decodeFalse = Boolean False <$ Decoder.byteString Literal.false <* Decoder.spaces++decodeTrue :: Decoder.Decoder Boolean+decodeTrue = Boolean True <$ Decoder.byteString Literal.true <* Decoder.spaces

@@ -0,0 +1,36 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Member where++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Json.Name as Name+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Monad as Monad+import qualified GHC.Generics as Generics++data MemberOf value+    = Member Name.Name value+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: (value -> Encoder.Encoder ()) -> MemberOf value -> Encoder.Encoder ()+encode f (Member x y) = do+    Name.encode x+    Trans.lift . Trans.tell $ Builder.word8 Literal.colon+    config <- Trans.ask+    Monad.when (Encoder.hasIndent config)+        . Trans.lift+        . Trans.tell+        $ Builder.word8 Literal.space+    f y++decode :: Decoder.Decoder value -> Decoder.Decoder (MemberOf value)+decode g = Member+    <$> Name.decode <* Decoder.word8 Literal.colon <* Decoder.spaces+    <*> g

@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Name where++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Json.String as String+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified GHC.Generics as Generics++newtype Name+    = Name String.String+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: Name -> Encoder.Encoder ()+encode (Name x) = String.encode x++decode :: Decoder.Decoder Name+decode = Name <$> String.decode

@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Null where++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Transformers as Trans+import qualified GHC.Generics as Generics++newtype Null+    = Null ()+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: Null -> Encoder.Encoder ()+encode = const . Trans.lift . Trans.tell $ Builder.byteString Literal.null++decode :: Decoder.Decoder Null+decode = Null () <$ Decoder.byteString Literal.null <* Decoder.spaces

@@ -0,0 +1,109 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Number where++import Data.Ratio ((%))++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.ByteString as ByteString+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Applicative as Applicative+import qualified Control.Monad as Monad+import qualified Data.Bool as Bool+import qualified Data.Maybe as Maybe+import qualified Data.Ratio as Ratio+import qualified Data.Word as Word+import qualified GHC.Generics as Generics++data Number+    = Number Integer Integer+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++number :: Integer -> Integer -> Number+number x = normalize . Number x++normalize :: Number -> Number+normalize (Number x y) =+    if x == 0+    then Number 0 0+    else let (q, r) = quotRem x 10 in if r == 0+    then normalize $ Number q (y + 1)+    else Number x y++encode :: Number -> Encoder.Encoder ()+encode (Number x y) = do+    Trans.lift . Trans.tell $ Builder.integerDec x+    Monad.when (y /= 0)+        . Trans.lift+        . Trans.tell+        $ Builder.word8 Literal.latinSmallLetterE+        <> Builder.integerDec y++decode :: Decoder.Decoder Number+decode = do+    ni <- fmap Maybe.isJust . Applicative.optional $ Decoder.word8 Literal.hyphenMinus+    i <- Decoder.takeWhile1 Decoder.isDigit+    Monad.when (ByteString.length i > 1 && ByteString.elemIndex Literal.digitZero i == Just 0)+        $ fail "leading zero"+    f <- fmap (Maybe.fromMaybe ByteString.empty) . Applicative.optional $ do+        Decoder.word8 Literal.fullStop+        Decoder.takeWhile1 Decoder.isDigit+    (ne, e) <- fmap (Maybe.fromMaybe (False, ByteString.empty)) . Applicative.optional $ do+        Monad.void+            . Decoder.satisfy+            $ \ x -> x == Literal.latinSmallLetterE || x == Literal.latinCapitalLetterE+        ne <- fmap (== Just Literal.hyphenMinus)+            . Applicative.optional+            . Decoder.satisfy+            $ \ x -> x == Literal.hyphenMinus || x == Literal.plusSign+        e <- Decoder.takeWhile1 Decoder.isDigit+        pure (ne, e)+    Decoder.spaces+    pure $ number+        (negateIf ni $ (fromDigits i * 10 ^ ByteString.length f) + fromDigits f)+        (negateIf ne (fromDigits e) - intToInteger (ByteString.length f))++negateIf :: Bool -> Integer -> Integer+negateIf = Bool.bool id negate++fromDigits :: ByteString.ByteString -> Integer+fromDigits = ByteString.foldl' (\ a e -> (a * 10) + word8ToInteger (e - 0x30)) 0++intToInteger :: Int -> Integer+intToInteger = fromIntegral++word8ToInteger :: Word.Word8 -> Integer+word8ToInteger = fromIntegral++toRational :: Number -> Rational+toRational (Number x y) =+    if y < 0+    then x % (10 ^ (-y))+    else fromInteger $ x * 10 ^ y++fromRational :: Rational -> Maybe Number+fromRational r =+    let+        n = Ratio.numerator r+        d1 = Ratio.denominator r+        (t, d2) = factor 2 (0 :: Integer) d1+        (f, d3) = factor 5 (0 :: Integer) d2+        p = max t f+    in if d3 == 1+    then Just $ number (n * 2 ^ (p - t) * 5 ^ (p - f)) (-p)+    else Nothing++-- factor d 0 x = (p, y) <=> x = (d ^ p) * y+factor :: (Num a, Integral b) => b -> a -> b -> (a, b)+factor d n x =+    let (q, r) = quotRem x d+    in if x /= 0 && r == 0+    then factor d (n + 1) q+    else (n, x)

@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Object where++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Json.Member as Member+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Monad as Monad+import qualified GHC.Generics as Generics++newtype ObjectOf value+    = Object [Member.MemberOf value]+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: (value -> Encoder.Encoder ()) -> ObjectOf value -> Encoder.Encoder ()+encode f (Object xs) = Encoder.list+    (Trans.lift . Trans.tell $ Builder.word8 Literal.leftCurlyBracket)+    (Trans.lift . Trans.tell $ Builder.word8 Literal.rightCurlyBracket)+    (Trans.lift . Trans.tell $ Builder.word8 Literal.comma)+    (Member.encode f)+    xs++encodeElement :: (value -> Encoder.Encoder ()) -> Int -> Member.MemberOf value -> Encoder.Encoder ()+encodeElement f i x = do+    Monad.when (i > 0) . Trans.lift . Trans.tell $ Builder.word8 Literal.comma+    Member.encode f x++decode :: Decoder.Decoder value -> Decoder.Decoder (ObjectOf value)+decode f = do+    Decoder.word8 Literal.leftCurlyBracket+    Decoder.spaces+    xs <- Decoder.list $ Member.decode f+    Decoder.word8 Literal.rightCurlyBracket+    Decoder.spaces+    pure $ Object xs

@@ -0,0 +1,143 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.String where++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Literal as Literal+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.ByteString as ByteString+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Text as Text+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Monad as Monad+import qualified Data.Char as Char+import qualified Data.Word as Word+import qualified GHC.Generics as Generics++newtype String+    = String Text.Text+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: Argo.Json.String.String -> Encoder.Encoder ()+encode (String x) = Trans.lift+    . Trans.tell+    $ Builder.word8 Literal.quotationMark+    <> Text.encodeUtf8BuilderEscaped encodeChar x+    <> Builder.word8 Literal.quotationMark++encodeChar :: Builder.BoundedPrim Word.Word8+encodeChar =+    Builder.condB (== Literal.quotationMark) (encodeShortEscape Literal.quotationMark)+    . Builder.condB (== Literal.reverseSolidus) (encodeShortEscape Literal.reverseSolidus)+    . Builder.condB (== Literal.backspace) (encodeShortEscape Literal.latinSmallLetterB)+    . Builder.condB (== Literal.formFeed) (encodeShortEscape Literal.latinSmallLetterF)+    . Builder.condB (== Literal.newLine) (encodeShortEscape Literal.latinSmallLetterN)+    . Builder.condB (== Literal.carriageReturn) (encodeShortEscape Literal.latinSmallLetterR)+    . Builder.condB (== Literal.horizontalTabulation) (encodeShortEscape Literal.latinSmallLetterT)+    . Builder.condB (< Literal.space) encodeLongEscape+    $ Builder.liftFixedToBounded Builder.word8F++encodeShortEscape :: Word.Word8 -> Builder.BoundedPrim a+encodeShortEscape x = Builder.liftFixedToBounded+    $ const (Literal.reverseSolidus, x)+    Builder.>$< Builder.word8F+    Builder.>*< Builder.word8F++encodeLongEscape :: Builder.BoundedPrim Word.Word8+encodeLongEscape = Builder.liftFixedToBounded+    $ (\ x -> (Literal.reverseSolidus, (Literal.latinSmallLetterU, word8ToWord16 x)))+    Builder.>$< Builder.word8F+    Builder.>*< Builder.word8F+    Builder.>*< Builder.word16HexFixed++word8ToWord16 :: Word.Word8 -> Word.Word16+word8ToWord16 = fromIntegral++decode :: Decoder.Decoder Argo.Json.String.String+decode = do+    Decoder.word8 Literal.quotationMark+    b1 <- Decoder.get+    i <- case getClose b1 0 of+        Nothing -> fail "unterminated string"+        Just i -> pure i+    let (xs, b2) = ByteString.splitAt i b1+    Monad.when (ByteString.any (< Literal.space) xs) $ fail "unescaped control character"+    Decoder.put b2+    Decoder.word8 Literal.quotationMark+    Decoder.spaces+    case Text.decodeUtf8' xs of+        Left e -> fail $ show e+        Right x -> case unescapeText x of+            Nothing -> fail "invalid escape"+            Just y -> pure $ String y++findAt :: Word.Word8 -> Int -> ByteString.ByteString -> Maybe Int+findAt x i = fmap (+ i) . ByteString.elemIndex x . ByteString.drop i++countConsecutive :: Word.Word8 -> Int -> ByteString.ByteString -> Int+countConsecutive x i = ByteString.length . ByteString.takeWhileEnd (== x) . ByteString.take i++getClose :: ByteString.ByteString -> Int -> Maybe Int+getClose b i = do+    j <- findAt Literal.quotationMark i b+    let n = countConsecutive Literal.reverseSolidus j b+    if even n then Just j else getClose b $ j + 1++unescapeText :: Text.Text -> Maybe Text.Text+unescapeText = fmap (Text.pack . combineSurrogatePairs) . unescapeString . Text.unpack++combineSurrogatePairs :: Prelude.String -> Prelude.String+combineSurrogatePairs xs = case xs of+    "" -> xs+    x : y : zs | isHighSurrogate x && isLowSurrogate y ->+        combineSurrogatePair x y : combineSurrogatePairs zs+    x : ys -> x : combineSurrogatePairs ys++combineSurrogatePair :: Char -> Char -> Char+combineSurrogatePair hi lo = Char.chr+    $ 0x10000+    + ((Char.ord hi - 0xd800) * 0x400)+    + (Char.ord lo - 0xdc00)++isHighSurrogate :: Char -> Bool+isHighSurrogate x = '\xd800' <= x && x <= '\xdbff'++isLowSurrogate :: Char -> Bool+isLowSurrogate x = '\xdc00' <= x && x <= '\xdfff'++unescapeString :: Prelude.String -> Maybe Prelude.String+unescapeString xs = case xs of+    "" -> pure xs+    '\\' : ys -> case ys of+        "" -> fail "empty escape"+        x : zs -> case x of+            '"' -> ('"' :) <$> unescapeString zs+            '\\' -> ('\\' :) <$> unescapeString zs+            '/' -> ('/' :) <$> unescapeString zs+            'b' -> ('\b' :) <$> unescapeString zs+            'f' -> ('\f' :) <$> unescapeString zs+            'n' -> ('\n' :) <$> unescapeString zs+            'r' -> ('\r' :) <$> unescapeString zs+            't' -> ('\t' :) <$> unescapeString zs+            'u' -> case zs of+                a : b : c : d : es | Just y <- fromLongEscape a b c d ->+                    (y :) <$> unescapeString es+                _ -> fail "invalid long escape"+            _ -> fail "invalid short escape"+    x : ys -> (x :) <$> unescapeString ys++fromLongEscape :: Char -> Char -> Char -> Char -> Maybe Char+fromLongEscape a b c d = do+    w <- fromHexadecimalDigit a+    x <- fromHexadecimalDigit b+    y <- fromHexadecimalDigit c+    z <- fromHexadecimalDigit d+    pure . Char.chr $ (0x1000 * w) + (0x100 * x) + (0x10 * y) + z++fromHexadecimalDigit :: Char -> Maybe Int+fromHexadecimalDigit x =+    if Char.isHexDigit x then Just $ Char.digitToInt x else Nothing

@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Json.Value where++import Control.Applicative ((<|>))++import qualified Argo.Decoder as Decoder+import qualified Argo.Encoder as Encoder+import qualified Argo.Json.Array as Array+import qualified Argo.Json.Boolean as Boolean+import qualified Argo.Json.Null as Null+import qualified Argo.Json.Number as Number+import qualified Argo.Json.Object as Object+import qualified Argo.Json.String as String+import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified GHC.Generics as Generics++data Value+    = Null Null.Null+    | Boolean Boolean.Boolean+    | Number Number.Number+    | String String.String+    | Array (Array.ArrayOf Value)+    | Object (Object.ObjectOf Value)+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++encode :: Value -> Encoder.Encoder ()+encode x = case x of+    Null y -> Null.encode y+    Boolean y -> Boolean.encode y+    Number y -> Number.encode y+    String y -> String.encode y+    Array y -> Array.encode encode y+    Object y -> Object.encode encode y++decode :: Decoder.Decoder Value+decode =+    Null <$> Null.decode+    <|> Boolean <$> Boolean.decode+    <|> Number <$> Number.decode+    <|> String <$> String.decode+    <|> Array <$> Array.decode decode+    <|> Object <$> Object.decode decode

@@ -1,6 +1,6 @@ module Argo.Literal where -import qualified Data.ByteString as ByteString+import qualified Argo.Vendor.ByteString as ByteString import qualified Data.Word as Word  backspace :: Word.Word8

@@ -0,0 +1,81 @@+module Argo.Main where++import qualified Argo+import qualified Argo.Encoder as Encoder+import qualified Control.Monad as Monad+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Builder as Builder+import qualified Data.Version as Version+import qualified Paths_argo as This+import qualified System.Console.GetOpt as Console+import qualified System.Environment as Environment+import qualified System.Exit as Exit+import qualified System.IO as IO+import qualified Text.Read as Read++main :: IO ()+main = do+    name <- Environment.getProgName+    arguments <- Environment.getArgs+    let (flags, as, os, es) = Console.getOpt' Console.Permute options arguments+    mapM_ (IO.hPutStrLn IO.stderr . mappend "unknown argument " . quote) as+    mapM_ (IO.hPutStrLn IO.stderr . mappend "unknown option " . quote) os+    mapM_ (IO.hPutStr IO.stderr) es+    Monad.unless (null es) Exit.exitFailure++    config <- either fail pure $ Monad.foldM applyFlag defaultConfig flags+    Monad.when (configHelp config) $ do+        putStr $ Console.usageInfo (name <> " version " <> version) options+        Exit.exitSuccess+    Monad.when (configVersion config) $ do+        putStrLn version+        Exit.exitSuccess++    contents <- ByteString.getContents+    case Argo.decode contents of+        Argo.Failure e -> fail e+        Argo.Success value -> Builder.hPutBuilder IO.stdout+            $ Argo.encodeWith (configIndent config) (value :: Argo.Value)++quote :: String -> String+quote x = "`" <> x <> "'"++version :: String+version = Version.showVersion This.version++data Flag+    = FlagHelp+    | FlagSpaces String+    | FlagTab+    | FlagVersion+    deriving (Eq, Show)++options :: [Console.OptDescr Flag]+options =+    [ Console.Option ['h', '?'] ["help"] (Console.NoArg FlagHelp) "shows this help message and exits"+    , Console.Option ['v'] ["version"] (Console.NoArg FlagVersion) "shows the version number and exits"+    , Console.Option ['s'] ["spaces"] (Console.ReqArg FlagSpaces "INT") "pretty-prints the output using INT sapces"+    , Console.Option ['t'] ["tab"] (Console.NoArg FlagTab) "pretty-prints the output using tabs"+    ]++data Config = Config+    { configHelp :: Bool+    , configIndent :: Encoder.Indent+    , configVersion :: Bool+    } deriving (Eq, Show)++defaultConfig :: Config+defaultConfig = Config+    { configHelp = False+    , configIndent = Encoder.Spaces 0+    , configVersion = False+    }++applyFlag :: Config -> Flag -> Either String Config+applyFlag config flag = case flag of+    FlagHelp -> pure config { configHelp = True }+    FlagSpaces string -> do+        int <- Read.readEither string+        pure config { configIndent = Encoder.Spaces int }+    FlagTab -> pure config { configIndent = Encoder.Tab }+    FlagVersion -> pure config { configVersion = True }

@@ -2,16 +2,16 @@  module Argo.Pattern where -import qualified Argo.Type as Type-import qualified Argo.Type.Array as Array-import qualified Argo.Type.Boolean as Boolean-import qualified Argo.Type.Null as Null-import qualified Argo.Type.Number as Number-import qualified Argo.Type.Object as Object-import qualified Argo.Type.Pair as Pair-import qualified Argo.Type.String as String-import qualified Argo.Type.Value as Value-import qualified Data.Text as Text+import qualified Argo.Json.Array as Array+import qualified Argo.Json.Boolean as Boolean+import qualified Argo.Json.Member as Member+import qualified Argo.Json.Name as Name+import qualified Argo.Json.Null as Null+import qualified Argo.Json.Number as Number+import qualified Argo.Json.Object as Object+import qualified Argo.Json.String as String+import qualified Argo.Json.Value as Value+import qualified Argo.Vendor.Text as Text  pattern Null :: Value.Value pattern Null = Value.Null (Null.Null ())@@ -26,15 +26,26 @@ pattern String :: Text.Text -> Value.Value pattern String x = Value.String (String.String x) -pattern Array :: Type.Array -> Value.Value+type Array = [Value.Value]++pattern Array :: Array -> Value.Value pattern Array x = Value.Array (Array.Array x) -pattern Object :: Type.Object -> Value.Value+type Object = [Member]++pattern Object :: Object -> Value.Value pattern Object x = Value.Object (Object.Object x)  {-# COMPLETE Null, Boolean, Number, String, Array, Object #-} -pattern Pair :: Text.Text -> Value.Value -> Pair.Pair String.String Value.Value-pattern Pair k v = Pair.Pair (String.String k, v)+type Member = Member.MemberOf Value.Value -{-# COMPLETE Pair #-}+pattern Member :: Name.Name -> Value.Value -> Member+pattern Member k v = Member.Member k v++{-# COMPLETE Member #-}++pattern Name :: Text.Text -> Name.Name+pattern Name x = Name.Name (String.String x)++{-# COMPLETE Name #-}

@@ -1,21 +1,20 @@ module Argo.QuasiQuoter where  import qualified Argo.Decode as Decode+import qualified Argo.Json.Value as Value import qualified Argo.Result as Result-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Language.Haskell.TH.Quote as QQ-import qualified Language.Haskell.TH.Syntax as TH+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Argo.Vendor.Text as Text -value :: QQ.QuasiQuoter-value = QQ.QuasiQuoter-    { QQ.quoteDec = const $ fail "quoteDec"-    , QQ.quoteExp = quoteExp-    , QQ.quotePat = const $ fail "quotePat"-    , QQ.quoteType = const $ fail "quoteType"+value :: TH.QuasiQuoter+value = TH.QuasiQuoter+    { TH.quoteDec = const $ fail "cannot be used as a declaration"+    , TH.quoteExp = quoteExp+    , TH.quotePat = const $ fail "cannot be used as a pattern"+    , TH.quoteType = const $ fail "cannot be used as a type"     }  quoteExp :: String -> TH.Q TH.Exp-quoteExp x = case Decode.decodeWith pure . Text.encodeUtf8 $ Text.pack x of+quoteExp x = case Decode.decode . Text.encodeUtf8 $ Text.pack x of     Result.Failure e -> fail e-    Result.Success y -> TH.lift y+    Result.Success y -> TH.lift (y :: Value.Value)

@@ -1,10 +0,0 @@-module Argo.Type where--import qualified Argo.Type.Pair as Pair-import qualified Argo.Type.String as String-import qualified Argo.Type.Value as Value-import qualified Data.Array--type Array = Data.Array.Array Int Value.Value--type Object = Data.Array.Array Int (Pair.Pair String.String Value.Value)

@@ -1,42 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.Array where--import qualified Argo.Decoder as Decoder-import qualified Argo.Literal as Literal-import qualified Control.DeepSeq as DeepSeq-import qualified Data.Array as Array-import qualified Data.ByteString.Builder as Builder-import qualified Language.Haskell.TH.Syntax as TH--newtype Array a-    = Array (Array.Array Int a)-    deriving (Eq, Show)--instance TH.Lift a => TH.Lift (Array a) where-    liftTyped (Array x) =-        let-            bounds = Array.bounds x-            elems = Array.elems x-        in [|| Array $ Array.listArray bounds elems ||]--instance DeepSeq.NFData a => DeepSeq.NFData (Array a) where-    rnf (Array x) = DeepSeq.rnf x--encode :: (a -> Builder.Builder) -> Array a -> Builder.Builder-encode f (Array x) =-    Builder.word8 Literal.leftSquareBracket-    <> foldMap-        (\ (i, e) -> (if i /= 0 then Builder.word8 Literal.comma else mempty)-            <> f e)-        (Array.assocs x)-    <> Builder.word8 Literal.rightSquareBracket--decode :: Decoder.Decoder a -> Decoder.Decoder (Array a)-decode f = do-    Decoder.word8 Literal.leftSquareBracket-    Decoder.spaces-    xs <- Decoder.array f-    Decoder.word8 Literal.rightSquareBracket-    Decoder.spaces-    pure $ Array xs

@@ -1,34 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.Boolean where--import Control.Applicative ((<|>))--import qualified Argo.Decoder as Decoder-import qualified Argo.Literal as Literal-import qualified Control.DeepSeq as DeepSeq-import qualified Data.ByteString.Builder as Builder-import qualified Language.Haskell.TH.Syntax as TH--newtype Boolean-    = Boolean Bool-    deriving (Eq, Show)--instance TH.Lift Boolean where-    liftTyped (Boolean x) = [|| Boolean x ||]--instance DeepSeq.NFData Boolean where-    rnf (Boolean x) = DeepSeq.rnf x--encode :: Boolean -> Builder.Builder-encode (Boolean x) =-    Builder.byteString $ if x then Literal.true else Literal.false--decode :: Decoder.Decoder Boolean-decode = decodeFalse <|> decodeTrue--decodeFalse :: Decoder.Decoder Boolean-decodeFalse = Boolean False <$ Decoder.byteString Literal.false <* Decoder.spaces--decodeTrue :: Decoder.Decoder Boolean-decodeTrue = Boolean True <$ Decoder.byteString Literal.true <* Decoder.spaces

@@ -1,25 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.Null where--import qualified Argo.Decoder as Decoder-import qualified Argo.Literal as Literal-import qualified Control.DeepSeq as DeepSeq-import qualified Data.ByteString.Builder as Builder-import qualified Language.Haskell.TH.Syntax as TH--newtype Null-    = Null ()-    deriving (Eq, Show)--instance TH.Lift Null where-    liftTyped (Null x) = [|| Null x ||]--instance DeepSeq.NFData Null where-    rnf (Null x) = DeepSeq.rnf x--encode :: Null -> Builder.Builder-encode = const $ Builder.byteString Literal.null--decode :: Decoder.Decoder Null-decode = Null () <$ Decoder.byteString Literal.null <* Decoder.spaces

@@ -1,109 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.Number where--import Data.Ratio ((%))--import qualified Argo.Decoder as Decoder-import qualified Argo.Literal as Literal-import qualified Control.Applicative as Applicative-import qualified Control.DeepSeq as DeepSeq-import qualified Control.Monad as Monad-import qualified Data.Bool as Bool-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Builder as Builder-import qualified Data.Maybe as Maybe-import qualified Data.Ratio as Ratio-import qualified Data.Word as Word-import qualified Language.Haskell.TH.Syntax as TH--data Number-    = Number Integer Integer-    deriving (Eq, Show)--instance TH.Lift Number where-    liftTyped (Number x y) = [|| Number x y ||]--instance DeepSeq.NFData Number where-    rnf (Number x y) = DeepSeq.deepseq x $ DeepSeq.rnf y--number :: Integer -> Integer -> Number-number x = normalize . Number x--normalize :: Number -> Number-normalize (Number x y) =-    if x == 0-    then Number 0 0-    else let (q, r) = quotRem x 10 in if r == 0-    then normalize $ Number q (y + 1)-    else Number x y--encode :: Number -> Builder.Builder-encode (Number x y) =-    if y == 0-    then Builder.integerDec x-    else Builder.integerDec x-        <> Builder.word8 Literal.latinSmallLetterE-        <> Builder.integerDec y--decode :: Decoder.Decoder Number-decode = do-    ni <- fmap Maybe.isJust . Applicative.optional $ Decoder.word8 Literal.hyphenMinus-    i <- Decoder.takeWhile1 Decoder.isDigit-    Monad.when (ByteString.length i > 1 && ByteString.elemIndex Literal.digitZero i == Just 0)-        $ fail "leading zero"-    f <- fmap (Maybe.fromMaybe ByteString.empty) . Applicative.optional $ do-        Decoder.word8 Literal.fullStop-        Decoder.takeWhile1 Decoder.isDigit-    (ne, e) <- fmap (Maybe.fromMaybe (False, ByteString.empty)) . Applicative.optional $ do-        Monad.void-            . Decoder.satisfy-            $ \ x -> x == Literal.latinSmallLetterE || x == Literal.latinCapitalLetterE-        ne <- fmap (== Just Literal.hyphenMinus)-            . Applicative.optional-            . Decoder.satisfy-            $ \ x -> x == Literal.hyphenMinus || x == Literal.plusSign-        e <- Decoder.takeWhile1 Decoder.isDigit-        pure (ne, e)-    Decoder.spaces-    pure $ number-        (negateIf ni $ (fromDigits i * 10 ^ ByteString.length f) + fromDigits f)-        (negateIf ne (fromDigits e) - intToInteger (ByteString.length f))--negateIf :: Bool -> Integer -> Integer-negateIf = Bool.bool id negate--fromDigits :: ByteString.ByteString -> Integer-fromDigits = ByteString.foldl' (\ a e -> (a * 10) + word8ToInteger (e - 0x30)) 0--intToInteger :: Int -> Integer-intToInteger = fromIntegral--word8ToInteger :: Word.Word8 -> Integer-word8ToInteger = fromIntegral--toRational :: Number -> Rational-toRational (Number x y) =-    if y < 0-    then x % (10 ^ (-y))-    else fromInteger $ x * 10 ^ y--fromRational :: Rational -> Maybe Number-fromRational r =-    let-        n = Ratio.numerator r-        d1 = Ratio.denominator r-        (t, d2) = factor 2 (0 :: Integer) d1-        (f, d3) = factor 5 (0 :: Integer) d2-        p = max t f-    in if d3 == 1-    then Just $ number (n * 2 ^ (p - t) * 5 ^ (p - f)) (-p)-    else Nothing---- factor d 0 x = (p, y) <=> x = (d ^ p) * y-factor :: (Num a, Integral b) => b -> a -> b -> (a, b)-factor d n x =-    let (q, r) = quotRem x d-    in if x /= 0 && r == 0-    then factor d (n + 1) q-    else (n, x)

@@ -1,44 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.Object where--import qualified Argo.Decoder as Decoder-import qualified Argo.Literal as Literal-import qualified Argo.Type.Pair as Pair-import qualified Argo.Type.String as String-import qualified Control.DeepSeq as DeepSeq-import qualified Data.Array as Array-import qualified Data.ByteString.Builder as Builder-import qualified Language.Haskell.TH.Syntax as TH--newtype Object a-    = Object (Array.Array Int (Pair.Pair String.String a))-    deriving (Eq, Show)--instance TH.Lift a => TH.Lift (Object a) where-    liftTyped (Object x) =-        let-            bounds = Array.bounds x-            elems = Array.elems x-        in [|| Object $ Array.listArray bounds elems ||]--instance DeepSeq.NFData a => DeepSeq.NFData (Object a) where-    rnf (Object x) = DeepSeq.rnf x--encode :: (a -> Builder.Builder) -> Object a -> Builder.Builder-encode f (Object x) =-    Builder.word8 Literal.leftCurlyBracket-    <> foldMap-        (\ (i, e) -> (if i /= 0 then Builder.word8 Literal.comma else mempty)-            <> Pair.encode String.encode f e)-        (Array.assocs x)-    <> Builder.word8 Literal.rightCurlyBracket--decode :: Decoder.Decoder a -> Decoder.Decoder (Object a)-decode f = do-    Decoder.word8 Literal.leftCurlyBracket-    Decoder.spaces-    xs <- Decoder.array $ Pair.decode String.decode f-    Decoder.word8 Literal.rightCurlyBracket-    Decoder.spaces-    pure $ Object xs

@@ -1,33 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.Pair where--import qualified Argo.Decoder as Decoder-import qualified Argo.Literal as Literal-import qualified Control.DeepSeq as DeepSeq-import qualified Data.ByteString.Builder as Builder-import qualified Language.Haskell.TH.Syntax as TH--newtype Pair k v-    = Pair (k, v)-    deriving (Eq, Show)--instance (TH.Lift k, TH.Lift v) => TH.Lift (Pair k v) where-    liftTyped (Pair x) = [|| Pair x ||]--instance (DeepSeq.NFData k, DeepSeq.NFData v) => DeepSeq.NFData (Pair k v) where-    rnf (Pair x) = DeepSeq.rnf x--encode :: (k -> Builder.Builder) -> (v -> Builder.Builder) -> Pair k v -> Builder.Builder-encode f g (Pair (x, y)) =-    f x-    <> Builder.word8 Literal.colon-    <> g y--decode :: Decoder.Decoder k -> Decoder.Decoder v -> Decoder.Decoder (Pair k v)-decode f g = do-    k <- f-    Decoder.word8 Literal.colon-    Decoder.spaces-    v <- g-    pure $ Pair (k, v)

@@ -1,145 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.String where--import qualified Argo.Decoder as Decoder-import qualified Argo.Literal as Literal-import qualified Control.DeepSeq as DeepSeq-import qualified Control.Monad as Monad-import qualified Data.ByteString as ByteString-import qualified Data.ByteString.Builder as Builder-import qualified Data.ByteString.Builder.Prim as P-import qualified Data.Char as Char-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Data.Word as Word-import qualified Language.Haskell.TH.Syntax as TH--newtype String-    = String Text.Text-    deriving (Eq, Show)--instance TH.Lift Argo.Type.String.String where-    liftTyped (String x) = [|| String x ||]--instance DeepSeq.NFData Argo.Type.String.String where-    rnf (String x) = DeepSeq.rnf x--encode :: Argo.Type.String.String -> Builder.Builder-encode (String x) =-    Builder.word8 Literal.quotationMark-    <> Text.encodeUtf8BuilderEscaped encodeChar x-    <> Builder.word8 Literal.quotationMark--encodeChar :: P.BoundedPrim Word.Word8-encodeChar =-    P.condB (== Literal.quotationMark) (encodeShortEscape Literal.quotationMark)-    . P.condB (== Literal.reverseSolidus) (encodeShortEscape Literal.reverseSolidus)-    . P.condB (== Literal.backspace) (encodeShortEscape Literal.latinSmallLetterB)-    . P.condB (== Literal.formFeed) (encodeShortEscape Literal.latinSmallLetterF)-    . P.condB (== Literal.newLine) (encodeShortEscape Literal.latinSmallLetterN)-    . P.condB (== Literal.carriageReturn) (encodeShortEscape Literal.latinSmallLetterR)-    . P.condB (== Literal.horizontalTabulation) (encodeShortEscape Literal.latinSmallLetterT)-    . P.condB (< Literal.space) encodeLongEscape-    $ P.liftFixedToBounded P.word8--encodeShortEscape :: Word.Word8 -> P.BoundedPrim a-encodeShortEscape x = P.liftFixedToBounded-    $ const (Literal.reverseSolidus, x)-    P.>$< P.word8-    P.>*< P.word8--encodeLongEscape :: P.BoundedPrim Word.Word8-encodeLongEscape = P.liftFixedToBounded-    $ (\ x -> (Literal.reverseSolidus, (Literal.latinSmallLetterU, word8ToWord16 x)))-    P.>$< P.word8-    P.>*< P.word8-    P.>*< P.word16HexFixed--word8ToWord16 :: Word.Word8 -> Word.Word16-word8ToWord16 = fromIntegral--decode :: Decoder.Decoder Argo.Type.String.String-decode = do-    Decoder.word8 Literal.quotationMark-    b1 <- Decoder.get-    i <- case getClose b1 0 of-        Nothing -> fail "unterminated string"-        Just i -> pure i-    let (xs, b2) = ByteString.splitAt i b1-    Monad.when (ByteString.any (< Literal.space) xs) $ fail "unescaped control character"-    Decoder.put b2-    Decoder.word8 Literal.quotationMark-    Decoder.spaces-    case Text.decodeUtf8' xs of-        Left e -> fail $ show e-        Right x -> case unescapeText x of-            Nothing -> fail "invalid escape"-            Just y -> pure $ String y--findAt :: Word.Word8 -> Int -> ByteString.ByteString -> Maybe Int-findAt x i = fmap (+ i) . ByteString.elemIndex x . ByteString.drop i--countConsecutive :: Word.Word8 -> Int -> ByteString.ByteString -> Int-countConsecutive x i = ByteString.length . ByteString.takeWhileEnd (== x) . ByteString.take i--getClose :: ByteString.ByteString -> Int -> Maybe Int-getClose b i = do-    j <- findAt Literal.quotationMark i b-    let n = countConsecutive Literal.reverseSolidus j b-    if even n then Just j else getClose b $ j + 1--unescapeText :: Text.Text -> Maybe Text.Text-unescapeText = fmap (Text.pack . combineSurrogatePairs) . unescapeString . Text.unpack--combineSurrogatePairs :: Prelude.String -> Prelude.String-combineSurrogatePairs xs = case xs of-    "" -> xs-    x : y : zs | isHighSurrogate x && isLowSurrogate y ->-        combineSurrogatePair x y : combineSurrogatePairs zs-    x : ys -> x : combineSurrogatePairs ys--combineSurrogatePair :: Char -> Char -> Char-combineSurrogatePair hi lo = Char.chr-    $ 0x10000-    + ((Char.ord hi - 0xd800) * 0x400)-    + (Char.ord lo - 0xdc00)--isHighSurrogate :: Char -> Bool-isHighSurrogate x = '\xd800' <= x && x <= '\xdbff'--isLowSurrogate :: Char -> Bool-isLowSurrogate x = '\xdc00' <= x && x <= '\xdfff'--unescapeString :: Prelude.String -> Maybe Prelude.String-unescapeString xs = case xs of-    "" -> pure xs-    '\\' : ys -> case ys of-        "" -> fail "empty escape"-        x : zs -> case x of-            '"' -> ('"' :) <$> unescapeString zs-            '\\' -> ('\\' :) <$> unescapeString zs-            '/' -> ('/' :) <$> unescapeString zs-            'b' -> ('\b' :) <$> unescapeString zs-            'f' -> ('\f' :) <$> unescapeString zs-            'n' -> ('\n' :) <$> unescapeString zs-            'r' -> ('\r' :) <$> unescapeString zs-            't' -> ('\t' :) <$> unescapeString zs-            'u' -> case zs of-                a : b : c : d : es | Just y <- fromLongEscape a b c d ->-                    (y :) <$> unescapeString es-                _ -> fail "invalid long escape"-            _ -> fail "invalid short escape"-    x : ys -> (x :) <$> unescapeString ys--fromLongEscape :: Char -> Char -> Char -> Char -> Maybe Char-fromLongEscape a b c d = do-    w <- fromHexadecimalDigit a-    x <- fromHexadecimalDigit b-    y <- fromHexadecimalDigit c-    z <- fromHexadecimalDigit d-    pure . Char.chr $ (0x1000 * w) + (0x100 * x) + (0x10 * y) + z--fromHexadecimalDigit :: Char -> Maybe Int-fromHexadecimalDigit x =-    if Char.isHexDigit x then Just $ Char.digitToInt x else Nothing

@@ -1,61 +0,0 @@-{-# LANGUAGE TemplateHaskellQuotes #-}--module Argo.Type.Value where--import Control.Applicative ((<|>))--import qualified Argo.Decoder as Decoder-import qualified Argo.Type.Array as Array-import qualified Argo.Type.Boolean as Boolean-import qualified Argo.Type.Null as Null-import qualified Argo.Type.Number as Number-import qualified Argo.Type.Object as Object-import qualified Argo.Type.String as String-import qualified Control.DeepSeq as DeepSeq-import qualified Data.ByteString.Builder as Builder-import qualified Language.Haskell.TH.Syntax as TH--data Value-    = Null Null.Null-    | Boolean Boolean.Boolean-    | Number Number.Number-    | String String.String-    | Array (Array.Array Value)-    | Object (Object.Object Value)-    deriving (Eq, Show)--instance TH.Lift Value where-    liftTyped x = case x of-        Null y -> [|| Null y ||]-        Boolean y -> [|| Boolean y ||]-        Number y -> [|| Number y ||]-        String y -> [|| String y ||]-        Array y -> [|| Array y ||]-        Object y -> [|| Object y ||]--instance DeepSeq.NFData Value where-    rnf x = case x of-        Null y -> DeepSeq.rnf y-        Boolean y -> DeepSeq.rnf y-        Number y -> DeepSeq.rnf y-        String y -> DeepSeq.rnf y-        Array y -> DeepSeq.rnf y-        Object y -> DeepSeq.rnf y--encode :: Value -> Builder.Builder-encode x = case x of-    Null y -> Null.encode y-    Boolean y -> Boolean.encode y-    Number y -> Number.encode y-    String y -> String.encode y-    Array y -> Array.encode encode y-    Object y -> Object.encode encode y--decode :: Decoder.Decoder Value-decode =-    Null <$> Null.decode-    <|> Boolean <$> Boolean.decode-    <|> Number <$> Number.decode-    <|> String <$> String.decode-    <|> Array <$> Array.decode decode-    <|> Object <$> Object.decode decode

@@ -0,0 +1,20 @@+module Argo.Vendor.Builder+    ( Prim.BoundedPrim+    , Builder.Builder+    , Builder.byteString+    , Prim.condB+    , Builder.integerDec+    , Prim.liftFixedToBounded+    , Builder.word8+    , word8F+    , Prim.word16HexFixed+    , (Prim.>$<)+    , (Prim.>*<)+    ) where++import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Builder.Prim as Prim+import qualified Data.Word as Word++word8F :: Prim.FixedPrim Word.Word8+word8F = Prim.word8

@@ -0,0 +1,20 @@+module Argo.Vendor.ByteString+    ( ByteString.ByteString+    , ByteString.any+    , ByteString.drop+    , ByteString.dropWhile+    , ByteString.elemIndex+    , ByteString.empty+    , ByteString.foldl'+    , ByteString.length+    , ByteString.null+    , ByteString.pack+    , ByteString.span+    , ByteString.splitAt+    , ByteString.stripPrefix+    , ByteString.take+    , ByteString.takeWhileEnd+    , ByteString.uncons+    ) where++import qualified Data.ByteString as ByteString

@@ -0,0 +1,6 @@+module Argo.Vendor.DeepSeq+    ( DeepSeq.NFData(..)+    , DeepSeq.deepseq+    ) where++import qualified Control.DeepSeq as DeepSeq

@@ -0,0 +1,9 @@+module Argo.Vendor.TemplateHaskell+    ( TH.Exp+    , TH.Lift(..)+    , TH.Q+    , QQ.QuasiQuoter(..)+    ) where++import qualified Language.Haskell.TH.Quote as QQ+import qualified Language.Haskell.TH.Syntax as TH

@@ -0,0 +1,20 @@+module Argo.Vendor.Text+    ( LazyText+    , Text.Text+    , Encoding.decodeUtf8'+    , Encoding.encodeUtf8+    , Encoding.encodeUtf8BuilderEscaped+    , LazyText.fromStrict+    , Text.null+    , Text.pack+    , Text.singleton+    , LazyText.toStrict+    , Text.uncons+    , Text.unpack+    ) where++import qualified Data.Text as Text+import qualified Data.Text.Encoding as Encoding+import qualified Data.Text.Lazy as LazyText++type LazyText = LazyText.Text

@@ -0,0 +1,15 @@+module Argo.Vendor.Transformers+    ( ReaderT.ReaderT+    , WriterT.WriterT+    , ReaderT.ask+    , ReaderT.asks+    , WriterT.execWriterT+    , Trans.lift+    , ReaderT.local+    , ReaderT.runReaderT+    , WriterT.tell+    ) where++import qualified Control.Monad.Trans.Class as Trans+import qualified Control.Monad.Trans.Reader as ReaderT+import qualified Control.Monad.Trans.Writer as WriterT

@@ -4,15 +4,17 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +import Data.GenValidity.Map ()+import Data.GenValidity.Text () import Data.List.NonEmpty (NonEmpty((:|))) import Test.Tasty.HUnit ((@?=)) import Test.Tasty.QuickCheck ((===))  import qualified Argo-import qualified Data.Array as Array import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.GenValidity as GenValidity import qualified Data.Int as Int import qualified Data.Map as Map import qualified Data.Text as Text@@ -87,19 +89,19 @@             ]         , Tasty.testGroup "Array"             [ Tasty.testCase "empty" $ do-                encode (Argo.Array (array [])) @?= "[]"+                encode (Argo.Array []) @?= "[]"             , Tasty.testCase "one element" $ do-                encode (Argo.Array (array [Argo.Number 1 0])) @?= "[1]"+                encode (Argo.Array [Argo.Number 1 0]) @?= "[1]"             , Tasty.testCase "two elements" $ do-                encode (Argo.Array (array [Argo.Number 1 0, Argo.Number 2 0])) @?= "[1,2]"+                encode (Argo.Array [Argo.Number 1 0, Argo.Number 2 0]) @?= "[1,2]"             ]         , Tasty.testGroup "Object"             [ Tasty.testCase "empty" $ do-                encode (Argo.Object (array [])) @?= "{}"+                encode (Argo.Object []) @?= "{}"             , Tasty.testCase "one element" $ do-                encode (Argo.Object (array [Argo.Pair "a" $ Argo.Number 1 0])) @?= "{\"a\":1}"+                encode (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0]) @?= "{\"a\":1}"             , Tasty.testCase "two elements" $ do-                encode (Argo.Object (array [Argo.Pair "a" $ Argo.Number 1 0, Argo.Pair "b" $ Argo.Number 2 0])) @?= "{\"a\":1,\"b\":2}"+                encode (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0, Argo.Member (Argo.Name "b") $ Argo.Number 2 0]) @?= "{\"a\":1,\"b\":2}"             ]         ]     , Tasty.testGroup "decode" $ let decode = resultToMaybe . Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in@@ -239,13 +241,13 @@             ]         , Tasty.testGroup "Array"             [ Tasty.testCase "empty" $ do-                decode "[]" @?= Just (Argo.Array $ array [])+                decode "[]" @?= Just (Argo.Array [])             , Tasty.testCase "one element" $ do-                decode "[1]" @?= Just (Argo.Array $ array [Argo.Number 1 0])+                decode "[1]" @?= Just (Argo.Array [Argo.Number 1 0])             , Tasty.testCase "two elements" $ do-                decode "[1,2]" @?= Just (Argo.Array $ array [Argo.Number 1 0, Argo.Number 2 0])+                decode "[1,2]" @?= Just (Argo.Array [Argo.Number 1 0, Argo.Number 2 0])             , Tasty.testCase "nested" $ do-                decode "[1,[2]]" @?= Just (Argo.Array $ array [Argo.Number 1 0, Argo.Array $ array [Argo.Number 2 0]])+                decode "[1,[2]]" @?= Just (Argo.Array [Argo.Number 1 0, Argo.Array [Argo.Number 2 0]])             , Tasty.testCase "not closed" $ do                 decode "[" @?= Nothing             , Tasty.testCase "not opened" $ do@@ -261,13 +263,13 @@             ]         , Tasty.testGroup "Object"             [ Tasty.testCase "empty" $ do-                decode "{}" @?= Just (Argo.Object $ array [])+                decode "{}" @?= Just (Argo.Object [])             , Tasty.testCase "one element" $ do-                decode "{\"a\":1}" @?= Just (Argo.Object $ array [Argo.Pair "a" $ Argo.Number 1 0])+                decode "{\"a\":1}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0])             , Tasty.testCase "two elements" $ do-                decode "{\"a\":1,\"b\":2}" @?= Just (Argo.Object $ array [Argo.Pair "a" $ Argo.Number 1 0, Argo.Pair "b" $ Argo.Number 2 0])+                decode "{\"a\":1,\"b\":2}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0, Argo.Member (Argo.Name "b") $ Argo.Number 2 0])             , Tasty.testCase "nested" $ do-                decode "{\"a\":{\"b\":2}}" @?= Just (Argo.Object $ array [Argo.Pair "a" . Argo.Object $ array [Argo.Pair "b" $ Argo.Number 2 0]])+                decode "{\"a\":{\"b\":2}}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Object [Argo.Member (Argo.Name "b") $ Argo.Number 2 0]])             , Tasty.testCase "not closed" $ do                 decode "{" @?= Nothing             , Tasty.testCase "not opened" $ do@@ -338,17 +340,15 @@         , Tasty.testCase "Maybe a" $ do             fromValue (Argo.Boolean False) @?= Just (Just False)         , Tasty.testCase "()" $ do-            fromValue (Argo.Array $ array []) @?= Just ()+            fromValue (Argo.Array []) @?= Just ()         , Tasty.testCase "(a, b)" $ do-            fromValue (Argo.Array $ array [Argo.Boolean False, Argo.String "a"]) @?= Just (False, 'a')-        , Tasty.testCase "Array Int a" $ do-            fromValue (Argo.Array $ array []) @?= Just (array [] :: Array.Array Int Bool)+            fromValue (Argo.Array [Argo.Boolean False, Argo.String "a"]) @?= Just (False, 'a')         , Tasty.testCase "[a]" $ do-            fromValue (Argo.Array $ array []) @?= Just ([] :: [Bool])+            fromValue (Argo.Array []) @?= Just ([] :: [Bool])         , Tasty.testCase "NonEmpty a" $ do-            fromValue (Argo.Array $ array [Argo.Boolean False]) @?= Just (False :| [])+            fromValue (Argo.Array [Argo.Boolean False]) @?= Just (False :| [])         , Tasty.testCase "Map Text a" $ do-            fromValue (Argo.Object $ array [Argo.Pair "a" $ Argo.Boolean False]) @?= Just (Map.fromList [("a" :: Text.Text, False)])+            fromValue (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]) @?= Just (Map.fromList [("a" :: Text.Text, False)])         ]     , Tasty.testGroup "toValue"         [ Tasty.testCase "Value" $ do@@ -392,17 +392,15 @@         , Tasty.testCase "Maybe a" $ do             Argo.toValue (Just False) @?= Argo.Boolean False         , Tasty.testCase "()" $ do-            Argo.toValue () @?= Argo.Array (array [])+            Argo.toValue () @?= Argo.Array []         , Tasty.testCase "(a, b)" $ do-            Argo.toValue (False, 'a') @?= Argo.Array (array [Argo.Boolean False, Argo.String "a"])-        , Tasty.testCase "Array Int a" $ do-            Argo.toValue (array [] :: Array.Array Int Bool) @?= Argo.Array (array [])+            Argo.toValue (False, 'a') @?= Argo.Array [Argo.Boolean False, Argo.String "a"]         , Tasty.testCase "[a]" $ do-            Argo.toValue ([] :: [Bool]) @?= Argo.Array (array [])+            Argo.toValue ([] :: [Bool]) @?= Argo.Array []         , Tasty.testCase "NonEmpty a" $ do-            Argo.toValue (False :| []) @?= Argo.Array (array [Argo.Boolean False])+            Argo.toValue (False :| []) @?= Argo.Array [Argo.Boolean False]         , Tasty.testCase "Map Text a" $ do-            Argo.toValue (Map.fromList [("a" :: Text.Text, False)]) @?= Argo.Object (array [Argo.Pair "a" $ Argo.Boolean False])+            Argo.toValue (Map.fromList [("a" :: Text.Text, False)]) @?= Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]         ]     , Tasty.testGroup "quasi quoter"         [ Tasty.testCase "Null" $ do@@ -414,120 +412,138 @@         , Tasty.testCase "String" $ do             [Argo.value| "" |] @?= Argo.String ""         , Tasty.testCase "Array" $ do-            [Argo.value| [] |] @?= Argo.Array (array [])+            [Argo.value| [] |] @?= Argo.Array []         , Tasty.testCase "Object" $ do-            [Argo.value| {} |] @?= Argo.Object (array [])+            [Argo.value| {} |] @?= Argo.Object []         ]     , Tasty.testGroup "property"-        [ Tasty.testProperty "decode . encode" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->-            (resultToMaybe . Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode y) === Just y+        [ property "decode . encode" $ \ x ->+            (resultToMaybe . Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode x) === Just (x :: Argo.Value)+        , property "decode . encodeWith" $ \ x ->+            (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encodeWith Argo.Tab x) === Argo.Success (x :: Argo.Value)         , Tasty.testGroup "fromValue . toValue"-            [ Tasty.testProperty "Value" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->-                (resultToMaybe . Argo.fromValue $ Argo.toValue y) === Just y-            , Tasty.testProperty "Bool" $ \ x ->+            [ property "Value" $ \ x ->+                (resultToMaybe . Argo.fromValue $ Argo.toValue x) === Just (x :: Argo.Value)+            , property "Bool" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Bool)-            , Tasty.testProperty "Char" $ \ x ->-                Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Char)-            , Tasty.testProperty "Int" $ \ x ->+            , property "Char" $ \ x ->+                Argo.fromValue (Argo.toValue x) === if '\xd800' <= x && x <= '\xdfff'+                    then Argo.Success '\xfffd'+                    else Argo.Success x+            , property "Int" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int)-            , Tasty.testProperty "Int8" $ \ x ->+            , property "Int8" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int8)-            , Tasty.testProperty "Int16" $ \ x ->+            , property "Int16" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int16)-            , Tasty.testProperty "Int32" $ \ x ->+            , property "Int32" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int32)-            , Tasty.testProperty "Int64" $ \ x ->+            , property "Int64" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int64)-            , Tasty.testProperty "Word" $ \ x ->+            , property "Word" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word)-            , Tasty.testProperty "Word8" $ \ x ->+            , property "Word8" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word8)-            , Tasty.testProperty "Word16" $ \ x ->+            , property "Word16" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word16)-            , Tasty.testProperty "Word32" $ \ x ->+            , property "Word32" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word32)-            , Tasty.testProperty "Word64" $ \ x ->+            , property "Word64" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word64)-            , Tasty.testProperty "Integer" $ \ x ->+            , property "Integer" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Integer)-            , Tasty.testProperty "Float" $ \ x ->-                Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Float)-            , Tasty.testProperty "Double" $ \ x ->-                Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Double)-            , Tasty.testProperty "String" $ \ x ->-                Argo.fromValue (Argo.toValue x) === Argo.Success (x :: String)-            , Tasty.testProperty "Text" $ \ x ->+            , property "Float" $ \ x ->+                Argo.fromValue (Argo.toValue x) === if isNaN x || isInfinite x+                    then Argo.Failure "expected Float but got Null (Null ())"+                    else Argo.Success (x :: Float)+            , property "Double" $ \ x ->+                Argo.fromValue (Argo.toValue x) === if isNaN x || isInfinite x+                    then Argo.Failure "expected Double but got Null (Null ())"+                    else Argo.Success (x :: Double)+            , property "String" $ \ x ->+                Argo.fromValue (Argo.toValue x) === Argo.Success (Text.unpack $ Text.pack x)+            , property "Text" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Text.Text)-            , Tasty.testProperty "LazyText" $ \ x ->+            , property "LazyText" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: LazyText.Text)-            , Tasty.testProperty "Maybe a" $ \ x ->+            , property "Maybe a" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Maybe Bool)-            , Tasty.testProperty "()" $ \ x ->+            , property "()" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: ())-            , Tasty.testProperty "(a, b)" $ \ x ->+            , property "(a, b)" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: (Bool, Int.Int8))-            , Tasty.testProperty "Array Int a" $ \ x ->-                Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Array.Array Int Bool)-            , Tasty.testProperty "[a]" $ \ x ->+            , property "[a]" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: [Bool])-            , Tasty.testProperty "NonEmpty a" $ \ x ->+            , property "NonEmpty a" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: NonEmpty Bool)-            , Tasty.testProperty "Map Text a" $ \ x ->+            , property "Map Text a" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Map.Map Text.Text Bool)             ]         ]     ] -array :: [a] -> Array.Array Int a-array xs = Array.listArray (0, length xs - 1) xs+property+    :: (Show t, Tasty.Testable prop, GenValidity.GenValid t)+    => Tasty.TestName+    -> (t -> prop)+    -> Tasty.TestTree+property n = propertyWith n GenValidity.genValid GenValidity.shrinkValid -genValue :: Tasty.Gen Argo.Value-genValue = Tasty.sized genValueSized+propertyWith+    :: (Show t, Tasty.Testable prop)+    => Tasty.TestName+    -> Tasty.Gen t+    -> (t -> [t])+    -> (t -> prop)+    -> Tasty.TestTree+propertyWith n g s f = Tasty.testProperty n+    . Tasty.forAll g+    $ \ x -> Tasty.shrinking s x f -genValueSized :: Int -> Tasty.Gen Argo.Value-genValueSized size = let newSize = div size 3 in Tasty.oneof-    [ pure Argo.Null-    , Argo.Boolean <$> Tasty.arbitrary-    , Argo.Number <$> Tasty.arbitrary <*> Tasty.arbitrary-    , Argo.String <$> Tasty.arbitrary-    , Argo.Array <$> genArray size (genValueSized newSize)-    , Argo.Object <$> genArray size (Argo.Pair <$> Tasty.arbitrary <*> genValueSized newSize)-    ]+instance GenValidity.Validity Argo.Name where+    validate (Argo.Name x) = GenValidity.validate x -genArray :: Int -> Tasty.Gen a -> Tasty.Gen (Array.Array Int a)-genArray n = fmap (Array.listArray (0, n - 1)) . Tasty.vectorOf n+instance GenValidity.GenValid Argo.Name where+    genValid = Argo.Name <$> GenValidity.genValid+    shrinkValid (Argo.Name x) = Argo.Name <$> GenValidity.shrinkValid x -type Shrink a = a -> [a]+instance GenValidity.Validity Argo.Member where+    validate (Argo.Member k v) = GenValidity.validate (k, v) -shrinkValue :: Shrink Argo.Value-shrinkValue x = case x of-    Argo.Null -> []-    Argo.Boolean y -> Argo.Boolean <$> Tasty.shrink y-    Argo.Number y z -> uncurry Argo.Number <$> Tasty.shrink (y, z)-    Argo.String y -> Argo.String <$> Tasty.shrink y-    Argo.Array y -> Argo.Array <$> shrinkArray shrinkValue y-    Argo.Object y -> Argo.Object <$> shrinkArray (\ (Argo.Pair k v) -> Argo.Pair <$> Tasty.shrink k <*> shrinkValue v) y+instance GenValidity.GenValid Argo.Member where+    genValid = Argo.Member <$> GenValidity.genValid <*> GenValidity.genValid+    shrinkValid (Argo.Member k v) = uncurry Argo.Member <$> GenValidity.shrinkValid (k, v) -shrinkArray :: Shrink a -> Shrink (Array.Array Int a)-shrinkArray = Tasty.shrinkMapBy array Array.elems . Tasty.shrinkList+instance GenValidity.Validity Argo.Value where+    validate x = case x of+        Argo.Null -> GenValidity.valid+        Argo.Boolean y -> GenValidity.annotate y "Boolean"+        Argo.Number y z -> GenValidity.annotate (y, z) "Number"+        Argo.String y -> GenValidity.annotate y "String"+        Argo.Array y -> GenValidity.annotate y "Array"+        Argo.Object y -> GenValidity.annotate y "Object" +instance GenValidity.GenValid Argo.Value where+    genValid = Tasty.sized genValueSized+    shrinkValid x = case x of+        Argo.Null -> []+        Argo.Boolean y -> Argo.Boolean <$> GenValidity.shrinkValid y+        Argo.Number y z -> uncurry Argo.Number <$> GenValidity.shrinkValid (y, z)+        Argo.String y -> Argo.String <$> GenValidity.shrinkValid y+        Argo.Array y -> Argo.Array <$> GenValidity.shrinkValid y+        Argo.Object y -> Argo.Object <$> GenValidity.shrinkValid y++genValueSized :: Int -> Tasty.Gen Argo.Value+genValueSized size = let newSize = div size 3 in Tasty.oneof+    [ pure Argo.Null+    , Argo.Boolean <$> GenValidity.genValid+    , Argo.Number <$> GenValidity.genValid <*> GenValidity.genValid+    , Argo.String <$> GenValidity.genValid+    , Argo.Array <$> Tasty.vectorOf size (genValueSized newSize)+    , Argo.Object <$> Tasty.vectorOf size (Argo.Member <$> GenValidity.genValid <*> genValueSized newSize)+    ]+ resultToMaybe :: Argo.Result a -> Maybe a resultToMaybe r = case r of     Argo.Failure _ -> Nothing     Argo.Success x -> Just x--instance Tasty.Arbitrary Text.Text where-    arbitrary = Text.pack <$> Tasty.arbitrary-    shrink = Tasty.shrinkMap Text.pack Text.unpack--instance Tasty.Arbitrary LazyText.Text where-    arbitrary = LazyText.pack <$> Tasty.arbitrary-    shrink = Tasty.shrinkMap LazyText.pack LazyText.unpack--instance Tasty.Arbitrary a => Tasty.Arbitrary (NonEmpty a) where-    arbitrary = (:|) <$> Tasty.arbitrary <*> Tasty.arbitrary-    shrink (x :| xs) = uncurry (:|) <$> Tasty.shrink (x, xs)--instance Tasty.Arbitrary a => Tasty.Arbitrary (Array.Array Int a) where-    arbitrary = array <$> Tasty.arbitrary-    shrink = Tasty.shrinkMap array Array.elems