argo (empty) → 0.2021.10.12
raw patch · 18 files changed
+1317/−0 lines, 18 filesdep +argodep +arraydep +base
Dependencies added: argo, array, base, bytestring, deepseq, tasty, tasty-bench, tasty-hunit, tasty-quickcheck, text
Files
- LICENSE.txt +21/−0
- argo.cabal +97/−0
- source/benchmark/Main.hs +78/−0
- source/executable/Main.hs +11/−0
- source/library/Argo.hs +77/−0
- source/library/Argo/Class/FromValue.hs +60/−0
- source/library/Argo/Class/ToValue.hs +34/−0
- source/library/Argo/Decoder.hs +114/−0
- source/library/Argo/Literal.hs +97/−0
- source/library/Argo/Type/Array.hs +32/−0
- source/library/Argo/Type/Boolean.hs +28/−0
- source/library/Argo/Type/Null.hs +19/−0
- source/library/Argo/Type/Number.hs +71/−0
- source/library/Argo/Type/Object.hs +34/−0
- source/library/Argo/Type/Pair.hs +27/−0
- source/library/Argo/Type/String.hs +139/−0
- source/library/Argo/Type/Value.hs +49/−0
- source/test-suite/Main.hs +329/−0
+ LICENSE.txt view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Taylor Fausak++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ argo.cabal view
@@ -0,0 +1,97 @@+cabal-version: 2.2++name: argo+version: 0.2021.10.12++build-type: Simple+category: JSON+description: Argo parses and renders JSON.+license-file: LICENSE.txt+license: MIT+maintainer: Taylor Fausak+synopsis: Parse and render JSON.++source-repository head+ location: https://github.com/tfausak/argo+ type: git++flag pedantic+ default: False+ manual: True++common library+ build-depends:+ , array >= 0.5.4 && < 0.6+ , base >= 4.15.0 && < 4.16+ , bytestring >= 0.10.12 && < 0.11+ , deepseq >= 1.4.5 && < 1.5+ , text >= 1.2.4 && < 1.3+ default-language: Haskell2010+ ghc-options:+ -Weverything+ -Wno-all-missed-specialisations+ -Wno-implicit-prelude+ -Wno-missing-deriving-strategies+ -Wno-missing-export-lists+ -Wno-missing-exported-signatures+ -Wno-missing-safe-haskell-mode+ -Wno-prepositive-qualified-module+ -Wno-safe+ -Wno-unsafe++ if flag(pedantic)+ ghc-options: -Werror++common executable+ import: library++ build-depends: argo+ ghc-options:+ -rtsopts+ -threaded+ -Wno-unused-packages++library+ import: library++ exposed-modules:+ Argo+ Argo.Class.FromValue+ Argo.Class.ToValue+ Argo.Decoder+ Argo.Literal+ 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++executable argo+ import: executable++ hs-source-dirs: source/executable+ main-is: Main.hs++test-suite argo-test-suite+ import: executable++ build-depends:+ , tasty >= 1.4.2 && < 1.5+ , tasty-hunit >= 0.10.0 && < 0.11+ , tasty-quickcheck >= 0.10.1 && < 0.11+ hs-source-dirs: source/test-suite+ main-is: Main.hs+ type: exitcode-stdio-1.0++benchmark argo-benchmark+ import: executable++ build-depends:+ , tasty-bench >= 0.3 && < 0.4+ hs-source-dirs: source/benchmark+ main-is: Main.hs+ type: exitcode-stdio-1.0
+ source/benchmark/Main.hs view
@@ -0,0 +1,78 @@+{-# 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+import qualified Data.Text as Text+import qualified Test.Tasty.Bench as Tasty++main :: IO ()+main = Tasty.defaultMain+ [ Tasty.bgroup "encode" $ let encode = Builder.toLazyByteString . Argo.encode :: Argo.Value -> LazyByteString.ByteString in+ [ Tasty.bgroup "Null"+ [ Tasty.bench "null" $ Tasty.nf encode Argo.Null+ ]+ , Tasty.bgroup "Boolean"+ [ Tasty.bench "false" . Tasty.nf encode $ Argo.Boolean False+ ]+ , Tasty.bgroup "Number"+ [ Tasty.bench "zero" . Tasty.nf encode $ Argo.Number 0 0+ ]+ , Tasty.bgroup "String"+ [ Tasty.bench "empty" . Tasty.nf encode $ Argo.String ""+ , Tasty.bench "1 character" . Tasty.nf encode . Argo.String . Text.pack $ replicate 1 'a'+ , Tasty.bench "10 characters" . Tasty.nf encode . Argo.String . Text.pack $ replicate 10 'a'+ , Tasty.bench "100 characters" . Tasty.nf encode . Argo.String . Text.pack $ replicate 100 'a'+ , Tasty.bench "1000 characters" . Tasty.nf encode . Argo.String . Text.pack $ replicate 1000 'a'+ , 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.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.bgroup "decode" $ let decode = Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in+ [ Tasty.bgroup "Null"+ [ Tasty.bench "null" $ Tasty.nf decode "null"+ ]+ , Tasty.bgroup "Boolean"+ [ Tasty.bench "false" $ Tasty.nf decode "false"+ ]+ , Tasty.bgroup "Number"+ [ Tasty.bench "zero" $ Tasty.nf decode "0"+ ]+ , Tasty.bgroup "String"+ [ Tasty.bench "empty" $ Tasty.nf decode "\"\""+ , Tasty.bench "one byte" $ Tasty.nf decode "\"$\""+ , Tasty.bench "two bytes" $ Tasty.nf decode "\"\xc2\xa2\""+ , Tasty.bench "three bytes" $ Tasty.nf decode "\"\xe2\x82\xac\""+ , Tasty.bench "four bytes" $ Tasty.nf decode "\"\xf0\x90\x8d\x88\""+ , 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.bgroup "Array"+ [ Tasty.bench "empty" $ Tasty.nf decode "[]"+ ]+ , Tasty.bgroup "Object"+ [ Tasty.bench "empty" $ Tasty.nf decode "{}"+ ]+ ]+ ]++array :: [a] -> Data.Array.Array Int a+array xs = Data.Array.listArray (0, length xs - 1) xs
+ source/executable/Main.hs view
@@ -0,0 +1,11 @@+import qualified Argo+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Builder as Builder+import qualified System.IO as IO++main :: IO ()+main = do+ contents <- ByteString.getContents+ case Argo.decode contents of+ Nothing -> fail "invalid JSON"+ Just value -> Builder.hPutBuilder IO.stdout $ Argo.encode (value :: Argo.Value)
+ source/library/Argo.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE PatternSynonyms #-}++module Argo+ ( Value+ , Array+ , Pair+ , Object+ , pattern Null+ , pattern Boolean+ , pattern Number+ , pattern String+ , pattern Array+ , pattern Object+ , pattern Pair+ , encode+ , decode+ , FromValue.FromValue(..)+ , ToValue.ToValue(..)+ ) where++import qualified Argo.Class.FromValue as FromValue+import qualified Argo.Class.ToValue as ToValue+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.Pair as Pair+import qualified Argo.Type.String as String+import qualified Argo.Type.Value as Value+import qualified Data.Array+import qualified Data.ByteString as ByteString+import qualified Data.ByteString.Builder as Builder+import qualified Data.Text as Text++type Value = Value.Value++type Array = Data.Array.Array Int Value++type Pair = Pair.Pair String.String Value++type Object = Data.Array.Array Int Pair++pattern Null :: Value+pattern Null = Value.Null (Null.Null ())++pattern Boolean :: Bool -> Value+pattern Boolean x = Value.Boolean (Boolean.Boolean x)++pattern Number :: Integer -> Integer -> Value+pattern Number x y <- Value.Number (Number.Number x y) where+ Number x y = Value.Number . Number.normalize $ Number.Number x y++pattern String :: Text.Text -> Value+pattern String x = Value.String (String.String x)++pattern Array :: Array -> Value+pattern Array x = Value.Array (Array.Array x)++pattern Object :: Object -> Value+pattern Object x = Value.Object (Object.Object x)++{-# COMPLETE Null, Boolean, Number, String, Array, Object #-}++pattern Pair :: Text.Text -> Value -> Pair+pattern Pair k v = Pair.Pair (String.String k, v)++{-# COMPLETE Pair #-}++encode :: ToValue.ToValue a => a -> Builder.Builder+encode = Value.encode . ToValue.toValue++decode :: FromValue.FromValue a => ByteString.ByteString -> Maybe a+decode x = do+ (_, y) <- Decoder.run (Decoder.spaces *> Value.decode <* Decoder.eof) x+ FromValue.fromValue y
+ source/library/Argo/Class/FromValue.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}++module Argo.Class.FromValue where++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 Data.Text as Text++class FromValue a where+ fromValue :: Value.Value -> Maybe a++instance FromValue Value.Value where+ fromValue = Just++instance FromValue Bool where+ fromValue = withBoolean "Bool" pure++instance FromValue Integer where+ fromValue = withNumber "Integer" $ \ x y ->+ if y < 0 then fail "fractional" else pure $ x * 10 ^ y++instance FromValue Text.Text where+ fromValue = withString "Text" pure++instance FromValue a => FromValue (Data.Array.Array Int a) where+ fromValue = withArray "Array" $ traverse fromValue++instance FromValue a => FromValue (Data.Array.Array Int (Pair.Pair String.String a)) where+ fromValue = withObject "Object" $ traverse $ \ (Pair.Pair (k, v)) -> Pair.Pair . (,) k <$> fromValue v++withBoolean :: String -> (Bool -> Maybe a) -> Value.Value -> Maybe a+withBoolean s f x = case x of+ Value.Boolean (Boolean.Boolean y) -> f y+ _ -> fail s++withNumber :: String -> (Integer -> Integer -> Maybe a) -> Value.Value -> Maybe a+withNumber s f x = case x of+ Value.Number (Number.Number y z) -> f y z+ _ -> fail s++withString :: String -> (Text.Text -> Maybe a) -> Value.Value -> Maybe a+withString s f x = case x of+ Value.String (String.String y) -> f y+ _ -> fail s++withArray :: String -> (Data.Array.Array Int Value.Value -> Maybe a) -> Value.Value -> Maybe a+withArray s f x = case x of+ Value.Array (Array.Array y) -> f y+ _ -> fail s++withObject :: String -> (Data.Array.Array Int (Pair.Pair String.String Value.Value) -> Maybe a) -> Value.Value -> Maybe a+withObject s f x = case x of+ Value.Object (Object.Object y) -> f y+ _ -> fail s
+ source/library/Argo/Class/ToValue.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleInstances #-}++module Argo.Class.ToValue where++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 Data.Text as Text++class ToValue a where+ toValue :: a -> Value.Value++instance ToValue Value.Value where+ toValue = id++instance ToValue Bool where+ toValue = Value.Boolean . Boolean.Boolean++instance ToValue Integer where+ toValue = Value.Number . Number.normalize . flip Number.Number 0++instance ToValue Text.Text where+ toValue = Value.String . String.String++instance ToValue a => ToValue (Data.Array.Array Int a) where+ toValue = Value.Array . Array.Array . fmap toValue++instance ToValue a => ToValue (Data.Array.Array Int (Pair.Pair String.String a)) where+ toValue = Value.Object . Object.Object . fmap (\ (Pair.Pair (k, v)) -> Pair.Pair (k, toValue v))
+ source/library/Argo/Decoder.hs view
@@ -0,0 +1,114 @@+module Argo.Decoder where++import qualified Argo.Literal as Literal+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+ { run :: ByteString.ByteString -> Maybe (ByteString.ByteString, a)+ }++instance Functor Decoder where+ fmap f d = Decoder $ \ b1 -> case run d b1 of+ Nothing -> Nothing+ Just (b2, x) -> Just (b2, f x)++instance Applicative Decoder where+ pure x = Decoder $ \ b -> Just (b, x)+ df <*> dx = Decoder $ \ b1 -> case run df b1 of+ Nothing -> Nothing+ Just (b2, f) -> case run dx b2 of+ Nothing -> Nothing+ Just (b3, x) -> Just (b3, f x)++instance Monad Decoder where+ d >>= f = Decoder $ \ b1 -> case run d b1 of+ Nothing -> Nothing+ Just (b2, x) -> run (f x) b2++instance MonadFail Decoder where+ fail _ = Decoder $ const Nothing++instance Applicative.Alternative Decoder where+ empty = fail "empty"+ dx <|> dy = Decoder $ \ b1 -> case run dx b1 of+ Nothing -> run dy b1+ Just (b2, x) -> Just (b2, x)++array :: Decoder a -> Decoder (Array.Array Int a)+array f = arrayWith f 0 []++arrayWith :: Decoder a -> Int -> [(Int, a)] -> Decoder (Array.Array Int a)+arrayWith f n xs = do+ m <- Applicative.optional $ do+ Monad.when (n /= 0) $ 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++byteString :: ByteString.ByteString -> Decoder ()+byteString x = do+ b1 <- get+ case ByteString.stripPrefix x b1 of+ Nothing -> fail $ "byteString: " <> show x+ Just b2 -> put b2++dropWhile :: (Word.Word8 -> Bool) -> Decoder ()+dropWhile f = do+ b <- get+ put $ ByteString.dropWhile f b++eof :: Decoder ()+eof = do+ b <- get+ Monad.unless (ByteString.null b) $ fail "eof"++get :: Decoder ByteString.ByteString+get = Decoder $ \ b -> Just (b, b)++isDigit :: Word.Word8 -> Bool+isDigit x = Literal.digitZero <= x && x <= Literal.digitNine++isSpace :: Word.Word8 -> Bool+isSpace x =+ x == Literal.space+ || x == Literal.horizontalTabulation+ || x == Literal.newLine+ || x == Literal.carriageReturn++put :: ByteString.ByteString -> Decoder ()+put b = Decoder $ \ _ -> Just (b, ())++satisfy :: (Word.Word8 -> Bool) -> Decoder Word.Word8+satisfy f = do+ b1 <- get+ case ByteString.uncons b1 of+ Just (x, b2) | f x -> do+ put b2+ pure x+ _ -> fail "satisfy"++spaces :: Decoder ()+spaces = Argo.Decoder.dropWhile isSpace++takeWhile :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString+takeWhile f = do+ b1 <- get+ let (x, b2) = ByteString.span f b1+ put b2+ pure x++takeWhile1 :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString+takeWhile1 f = do+ x <- Argo.Decoder.takeWhile f+ Monad.when (ByteString.null x) $ fail "takeWhile1"+ pure x++word8 :: Word.Word8 -> Decoder ()+word8 = Monad.void . satisfy . (==)
+ source/library/Argo/Literal.hs view
@@ -0,0 +1,97 @@+module Argo.Literal where++import qualified Data.ByteString as ByteString+import qualified Data.Word as Word++backspace :: Word.Word8+backspace = 0x08++carriageReturn :: Word.Word8+carriageReturn = 0x0d++colon :: Word.Word8+colon = 0x3a++comma :: Word.Word8+comma = 0x2c++digitNine :: Word.Word8+digitNine = 0x39++digitOne :: Word.Word8+digitOne = 0x31++digitZero :: Word.Word8+digitZero = 0x30++false :: ByteString.ByteString+false = ByteString.pack [0x66, 0x61, 0x6c, 0x73, 0x65]++formFeed :: Word.Word8+formFeed = 0x0c++fullStop :: Word.Word8+fullStop = 0x2e++horizontalTabulation :: Word.Word8+horizontalTabulation = 0x09++hyphenMinus :: Word.Word8+hyphenMinus = 0x2d++latinCapitalLetterE :: Word.Word8+latinCapitalLetterE = 0x45++latinSmallLetterB :: Word.Word8+latinSmallLetterB = 0x62++latinSmallLetterE :: Word.Word8+latinSmallLetterE = 0x65++latinSmallLetterF :: Word.Word8+latinSmallLetterF = 0x66++latinSmallLetterN :: Word.Word8+latinSmallLetterN = 0x6e++latinSmallLetterR :: Word.Word8+latinSmallLetterR = 0x72++latinSmallLetterT :: Word.Word8+latinSmallLetterT = 0x74++latinSmallLetterU :: Word.Word8+latinSmallLetterU = 0x75++leftCurlyBracket :: Word.Word8+leftCurlyBracket = 0x7b++leftSquareBracket :: Word.Word8+leftSquareBracket = 0x5b++newLine :: Word.Word8+newLine = 0x0a++null :: ByteString.ByteString+null = ByteString.pack [0x6e, 0x75, 0x6c, 0x6c]++plusSign :: Word.Word8+plusSign = 0x2b++quotationMark :: Word.Word8+quotationMark = 0x22++reverseSolidus :: Word.Word8+reverseSolidus = 0x5c++rightCurlyBracket :: Word.Word8+rightCurlyBracket = 0x7d++rightSquareBracket :: Word.Word8+rightSquareBracket = 0x5d++space :: Word.Word8+space = 0x20++true :: ByteString.ByteString+true = ByteString.pack [0x74, 0x72, 0x75, 0x65]
+ source/library/Argo/Type/Array.hs view
@@ -0,0 +1,32 @@+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++newtype Array a+ = Array (Array.Array Int a)+ deriving (Eq, Show)++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
+ source/library/Argo/Type/Boolean.hs view
@@ -0,0 +1,28 @@+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++newtype Boolean+ = Boolean Bool+ deriving (Eq, Show)++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
+ source/library/Argo/Type/Null.hs view
@@ -0,0 +1,19 @@+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++newtype Null+ = Null ()+ deriving (Eq, Show)++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
+ source/library/Argo/Type/Number.hs view
@@ -0,0 +1,71 @@+module Argo.Type.Number where++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.Word as Word++data Number+ = Number Integer Integer+ deriving (Eq, Show)++instance DeepSeq.NFData Number where+ rnf (Number x y) = DeepSeq.deepseq x $ DeepSeq.rnf y++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 . normalize $ 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
+ source/library/Argo/Type/Object.hs view
@@ -0,0 +1,34 @@+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++newtype Object a+ = Object (Array.Array Int (Pair.Pair String.String a))+ deriving (Eq, Show)++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
+ source/library/Argo/Type/Pair.hs view
@@ -0,0 +1,27 @@+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++newtype Pair k v+ = Pair (k, v)+ deriving (Eq, Show)++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)
+ source/library/Argo/Type/String.hs view
@@ -0,0 +1,139 @@+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++newtype String+ = String Text.Text+ deriving (Eq, Show)++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
+ source/library/Argo/Type/Value.hs view
@@ -0,0 +1,49 @@+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++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 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
+ source/test-suite/Main.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE OverloadedStrings #-}++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.Text as Text+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.HUnit as Tasty+import qualified Test.Tasty.QuickCheck as Tasty++main :: IO ()+main = Tasty.defaultMain $ Tasty.testGroup "Argo"+ [ Tasty.testGroup "encode" $ let encode = Builder.toLazyByteString . Argo.encode :: Argo.Value -> LazyByteString.ByteString in+ [ Tasty.testGroup "Null"+ [ Tasty.testCase "null" $ do+ encode Argo.Null @?= "null"+ ]+ , Tasty.testGroup "Boolean"+ [ Tasty.testCase "false" $ do+ encode (Argo.Boolean False) @?= "false"+ , Tasty.testCase "true" $ do+ encode (Argo.Boolean True) @?= "true"+ ]+ , Tasty.testGroup "Number"+ [ Tasty.testCase "zero" $ do+ encode (Argo.Number 0 0) @?= "0"+ , Tasty.testCase "positive integer" $ do+ encode (Argo.Number 1 0) @?= "1"+ , Tasty.testCase "negative integer" $ do+ encode (Argo.Number (-1) 0) @?= "-1"+ , Tasty.testCase "positive exponent" $ do+ encode (Argo.Number 1 1) @?= "1e1"+ , Tasty.testCase "negative exponent" $ do+ encode (Argo.Number 1 (-1)) @?= "1e-1"+ , Tasty.testCase "multiple integer digits" $ do+ encode (Argo.Number 12 0) @?= "12"+ , Tasty.testCase "multiple exponent digits" $ do+ encode (Argo.Number 1 12) @?= "1e12"+ ]+ , Tasty.testGroup "String"+ [ Tasty.testCase "empty" $ do+ encode (Argo.String "") @?= "\"\""+ , Tasty.testCase "one character" $ do+ encode (Argo.String "a") @?= "\"a\""+ , Tasty.testCase "multiple characters" $ do+ encode (Argo.String "ab") @?= "\"ab\""+ , Tasty.testCase "quotation mark" $ do+ encode (Argo.String "\"") @?= "\"\\\"\""+ , Tasty.testCase "reverse solidus" $ do+ encode (Argo.String "\\") @?= "\"\\\\\""+ , Tasty.testCase "backspace" $ do+ encode (Argo.String "\b") @?= "\"\\b\""+ , Tasty.testCase "form feed" $ do+ encode (Argo.String "\f") @?= "\"\\f\""+ , Tasty.testCase "new line" $ do+ encode (Argo.String "\n") @?= "\"\\n\""+ , Tasty.testCase "carriage return" $ do+ encode (Argo.String "\r") @?= "\"\\r\""+ , Tasty.testCase "horizontal tabulation" $ do+ encode (Argo.String "\t") @?= "\"\\t\""+ , Tasty.testCase "null" $ do+ encode (Argo.String "\x0") @?= "\"\\u0000\""+ , Tasty.testCase "unit separator" $ do+ encode (Argo.String "\x1f") @?= "\"\\u001f\""+ , Tasty.testCase "one byte" $ do+ encode (Argo.String "$") @?= "\"$\""+ , Tasty.testCase "two bytes" $ do+ encode (Argo.String "\xa2") @?= "\"\xc2\xa2\""+ , Tasty.testCase "three bytes" $ do+ encode (Argo.String "\x20ac") @?= "\"\xe2\x82\xac\""+ , Tasty.testCase "four bytes" $ do+ encode (Argo.String "\x10348") @?= "\"\xf0\x90\x8d\x88\""+ ]+ , Tasty.testGroup "Array"+ [ Tasty.testCase "empty" $ do+ encode (Argo.Array (array [])) @?= "[]"+ , Tasty.testCase "one element" $ do+ encode (Argo.Array (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]"+ ]+ , Tasty.testGroup "Object"+ [ Tasty.testCase "empty" $ do+ encode (Argo.Object (array [])) @?= "{}"+ , Tasty.testCase "one element" $ do+ encode (Argo.Object (array [Argo.Pair "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}"+ ]+ ]+ , Tasty.testGroup "decode" $ let decode = Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in+ [ Tasty.testGroup "Null"+ [ Tasty.testCase "null" $ do+ decode "null" @?= Just Argo.Null+ , Tasty.testCase "leading space" $ do+ decode " null" @?= Just Argo.Null+ , Tasty.testCase "trailing space" $ do+ decode "null " @?= Just Argo.Null+ , Tasty.testCase "trailing new line" $ do+ decode "null\n" @?= Just Argo.Null+ , Tasty.testCase "trailing carriage return" $ do+ decode "null\r" @?= Just Argo.Null+ , Tasty.testCase "trailing horizontal tab" $ do+ decode "null\t" @?= Just Argo.Null+ ]+ , Tasty.testGroup "Boolean"+ [ Tasty.testCase "false" $ do+ decode "false" @?= Just (Argo.Boolean False)+ , Tasty.testCase "true" $ do+ decode "true" @?= Just (Argo.Boolean True)+ ]+ , Tasty.testGroup "Number"+ [ Tasty.testCase "zero" $ do+ decode "0" @?= Just (Argo.Number 0 0)+ , Tasty.testCase "negative zero" $ do+ decode "-0" @?= Just (Argo.Number 0 0)+ , Tasty.testCase "positive integer" $ do+ decode "1" @?= Just (Argo.Number 1 0)+ , Tasty.testCase "multiple integer digits" $ do+ decode "12" @?= Just (Argo.Number 12 0)+ , Tasty.testCase "negative integer" $ do+ decode "-1" @?= Just (Argo.Number (-1) 0)+ , Tasty.testCase "fraction" $ do+ decode "0.1" @?= Just (Argo.Number 1 (-1))+ , Tasty.testCase "multiple fraction digits" $ do+ decode "0.12" @?= Just (Argo.Number 12 (-2))+ , Tasty.testCase "leading zero fraction" $ do+ decode "0.01" @?= Just (Argo.Number 1 (-2))+ , Tasty.testCase "positive exponent" $ do+ decode "1e1" @?= Just (Argo.Number 1 1)+ , Tasty.testCase "capital exponent" $ do+ decode "1E1" @?= Just (Argo.Number 1 1)+ , Tasty.testCase "leading zero exponent" $ do+ decode "1e01" @?= Just (Argo.Number 1 1)+ , Tasty.testCase "explicit positive exponent" $ do+ decode "1e+1" @?= Just (Argo.Number 1 1)+ , Tasty.testCase "negative exponent" $ do+ decode "1e-1" @?= Just (Argo.Number 1 (-1))+ , Tasty.testCase "multiple exponent digits" $ do+ decode "1e12" @?= Just (Argo.Number 1 12)+ , Tasty.testCase "kitchen sink" $ do+ decode "12.34e56" @?= Just (Argo.Number 1234 54)+ , Tasty.testCase "normalized" $ do+ decode "10" @?= Just (Argo.Number 1 1)+ , Tasty.testCase "leading zero" $ do+ decode "01" @?= Nothing+ , Tasty.testCase "trailing fraction" $ do+ decode "1." @?= Nothing+ , Tasty.testCase "leading fraction" $ do+ decode ".1" @?= Nothing+ , Tasty.testCase "trailing exponent" $ do+ decode "1e" @?= Nothing+ , Tasty.testCase "leading exponent" $ do+ decode "e1" @?= Nothing+ ]+ , Tasty.testGroup "String"+ [ Tasty.testCase "empty" $ do+ decode "\"\"" @?= Just (Argo.String "")+ , Tasty.testCase "one character" $ do+ decode "\"a\"" @?= Just (Argo.String "a")+ , Tasty.testCase "multiple characters" $ do+ decode "\"ab\"" @?= Just (Argo.String "ab")+ , Tasty.testCase "unnecessary escape" $ do+ decode "\"\\u0020\"" @?= Just (Argo.String " ")+ , Tasty.testCase "quotation mark" $ do+ decode "\"\\\"\"" @?= Just (Argo.String "\"")+ , Tasty.testCase "reverse solidus" $ do+ decode "\"\\\\\"" @?= Just (Argo.String "\\")+ , Tasty.testCase "solidus" $ do+ decode "\"\\/\"" @?= Just (Argo.String "/")+ , Tasty.testCase "backspace" $ do+ decode "\"\\b\"" @?= Just (Argo.String "\b")+ , Tasty.testCase "form feed" $ do+ decode "\"\\f\"" @?= Just (Argo.String "\f")+ , Tasty.testCase "new line" $ do+ decode "\"\\n\"" @?= Just (Argo.String "\n")+ , Tasty.testCase "carriage return" $ do+ decode "\"\\r\"" @?= Just (Argo.String "\r")+ , Tasty.testCase "horizontal tabulation" $ do+ decode "\"\\t\"" @?= Just (Argo.String "\t")+ , Tasty.testCase "null" $ do+ decode "\"\\u0000\"" @?= Just (Argo.String "\x0")+ , Tasty.testCase "unit separator" $ do+ decode "\"\\u001f\"" @?= Just (Argo.String "\x1f")+ , Tasty.testCase "capital long escape" $ do+ decode "\"\\u001F\"" @?= Just (Argo.String "\x1f")+ , Tasty.testCase "digits after long escape" $ do+ decode "\"\\u00205\"" @?= Just (Argo.String " 5")+ , Tasty.testCase "one byte" $ do+ decode "\"$\"" @?= Just (Argo.String "$")+ , Tasty.testCase "one byte escaped" $ do+ decode "\"\\u0024\"" @?= Just (Argo.String "$")+ , Tasty.testCase "two bytes" $ do+ decode "\"\xc2\xa2\"" @?= Just (Argo.String "\xa2")+ , Tasty.testCase "two bytes escaped" $ do+ decode "\"\\u00a2\"" @?= Just (Argo.String "\xa2")+ , Tasty.testCase "three bytes" $ do+ decode "\"\xe2\x82\xac\"" @?= Just (Argo.String "\x20ac")+ , Tasty.testCase "three bytes escaped" $ do+ decode "\"\\u20ac\"" @?= Just (Argo.String "\x20ac")+ , Tasty.testCase "four bytes" $ do+ decode "\"\xf0\x90\x8d\x88\"" @?= Just (Argo.String "\x10348")+ , Tasty.testCase "surrogate pair" $ do+ decode "\"\\ud834\\udd1e\"" @?= Just (Argo.String "\x1d11e")+ , Tasty.testCase "unpaired high surrogate" $ do+ decode "\"\\ud800\"" @?= Just (Argo.String "\xfffd")+ , Tasty.testCase "unpaired low surrogate" $ do+ decode "\"\\udc00\"" @?= Just (Argo.String "\xfffd")+ , Tasty.testCase "delete" $ do+ decode "\"\x7f\"" @?= Just (Argo.String "\x7f")+ , Tasty.testCase "invalid short escape" $ do+ decode "\"\\z\"" @?= Nothing+ , Tasty.testCase "capital short escape" $ do+ decode "\"\\T\"" @?= Nothing+ , Tasty.testCase "invalid long escape" $ do+ decode "\"\\uwxyz\"" @?= Nothing+ , Tasty.testCase "incomplete long escape" $ do+ decode "\"\\u00\"" @?= Nothing+ , Tasty.testCase "unescaped control character" $ do+ decode "\"\n\"" @?= Nothing+ , Tasty.testCase "unterminated" $ do+ decode "\"" @?= Nothing+ , Tasty.testCase "invalid UTF-8 byte" $ do+ decode "\"\xff\"" @?= Nothing+ ]+ , Tasty.testGroup "Array"+ [ Tasty.testCase "empty" $ do+ decode "[]" @?= Just (Argo.Array $ array [])+ , Tasty.testCase "one element" $ do+ decode "[1]" @?= Just (Argo.Array $ 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])+ , Tasty.testCase "nested" $ do+ decode "[1,[2]]" @?= Just (Argo.Array $ array [Argo.Number 1 0, Argo.Array $ array [Argo.Number 2 0]])+ , Tasty.testCase "not closed" $ do+ decode "[" @?= Nothing+ , Tasty.testCase "not opened" $ do+ decode "]" @?= Nothing+ , Tasty.testCase "leading comma" $ do+ decode "[,1]" @?= Nothing+ , Tasty.testCase "trailing comma" $ do+ decode "[1,]" @?= Nothing+ , Tasty.testCase "consecutive commas" $ do+ decode "[1,,2]" @?= Nothing+ , Tasty.testCase "like an object" $ do+ decode "[\"a\":1]" @?= Nothing+ ]+ , Tasty.testGroup "Object"+ [ Tasty.testCase "empty" $ do+ decode "{}" @?= Just (Argo.Object $ array [])+ , Tasty.testCase "one element" $ do+ decode "{\"a\":1}" @?= Just (Argo.Object $ array [Argo.Pair "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])+ , 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]])+ , Tasty.testCase "not closed" $ do+ decode "{" @?= Nothing+ , Tasty.testCase "not opened" $ do+ decode "}" @?= Nothing+ , Tasty.testCase "leading comma" $ do+ decode "{,\"a\":1}" @?= Nothing+ , Tasty.testCase "trailing comma" $ do+ decode "{\"a\":1,}" @?= Nothing+ , Tasty.testCase "consecutive commas" $ do+ decode "{\"a\":1,,\"b\":2}" @?= Nothing+ , Tasty.testCase "missing key" $ do+ decode "{:1}" @?= Nothing+ , Tasty.testCase "missing value" $ do+ decode "{\"a\":}" @?= Nothing+ , Tasty.testCase "missing separator" $ do+ decode "{\"a\"1}" @?= Nothing+ , Tasty.testCase "duplicate separator" $ do+ decode "{\"a\"::1}" @?= Nothing+ , Tasty.testCase "like an array" $ do+ decode "{1}" @?= Nothing+ , Tasty.testCase "non-string key" $ do+ decode "{1:2}" @?= Nothing+ ]+ ]+ , Tasty.testGroup "property"+ [ Tasty.testProperty "round trip" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->+ (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode y) === Just y+ ]+ ]++array :: [a] -> Array.Array Int a+array xs = Array.listArray (0, length xs - 1) xs++genValue :: Tasty.Gen Argo.Value+genValue = Tasty.sized genValueSized++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 <$> genText+ , Argo.Array <$> genArray size (genValueSized newSize)+ , Argo.Object <$> genArray size (Argo.Pair <$> genText <*> genValueSized newSize)+ ]++genText :: Tasty.Gen Text.Text+genText = Text.pack <$> Tasty.arbitrary++genArray :: Int -> Tasty.Gen a -> Tasty.Gen (Array.Array Int a)+genArray n = fmap (Array.listArray (0, n - 1)) . Tasty.vectorOf n++type Shrink a = a -> [a]++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 <$> shrinkText y+ Argo.Array y -> Argo.Array <$> shrinkArray shrinkValue y+ Argo.Object y -> Argo.Object <$> shrinkArray (\ (Argo.Pair k v) -> Argo.Pair <$> shrinkText k <*> shrinkValue v) y++shrinkText :: Shrink Text.Text+shrinkText = Tasty.shrinkMap Text.pack Text.unpack++shrinkArray :: Shrink a -> Shrink (Array.Array Int a)+shrinkArray = Tasty.shrinkMapBy array Array.elems . Tasty.shrinkList