argo 0.2021.10.13 → 0.2021.10.17

raw patch · 18 files changed

+581/−87 lines, 18 filesdep +containersdep +template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers, template-haskell

API changes (from Hackage documentation)

Files

• argo.cabal +8/−1
• source/library/Argo.hs +21/−70
• source/library/Argo/Class/FromValue.hs +135/−9
• source/library/Argo/Class/ToValue.hs +94/−5
• source/library/Argo/Decode.hs +14/−0
• source/library/Argo/Encode.hs +11/−0
• source/library/Argo/Pattern.hs +40/−0
• source/library/Argo/QuasiQuoter.hs +18/−0
• source/library/Argo/Type.hs +14/−0
• source/library/Argo/Type/Array.hs +10/−0
• source/library/Argo/Type/Boolean.hs +6/−0
• source/library/Argo/Type/Null.hs +6/−0
• source/library/Argo/Type/Number.hs +39/−1
• source/library/Argo/Type/Object.hs +10/−0
• source/library/Argo/Type/Pair.hs +6/−0
• source/library/Argo/Type/String.hs +6/−0
• source/library/Argo/Type/Value.hs +12/−0
• source/test-suite/Main.hs +131/−1

@@ -1,7 +1,7 @@ cabal-version: 2.2  name: argo-version: 0.2021.10.13+version: 0.2021.10.17  build-type: Simple category: JSON@@ -24,7 +24,9 @@         , 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     default-language: Haskell2010     ghc-options:@@ -58,8 +60,13 @@         Argo         Argo.Class.FromValue         Argo.Class.ToValue+        Argo.Decode         Argo.Decoder+        Argo.Encode         Argo.Literal+        Argo.Pattern+        Argo.QuasiQuoter+        Argo.Type         Argo.Type.Array         Argo.Type.Boolean         Argo.Type.Null

@@ -1,77 +1,28 @@ {-# 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(..)+    ( Type.Value+    , Type.Array+    , Type.Pair+    , Type.Object+    , pattern Pattern.Null+    , pattern Pattern.Boolean+    , pattern Pattern.Number+    , pattern Pattern.String+    , pattern Pattern.Array+    , pattern Pattern.Object+    , pattern Pattern.Pair+    , Encode.encode+    , Decode.decode+    , FromValue.FromValue(fromValue)+    , ToValue.ToValue(toValue)+    , QuasiQuoter.value     ) 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+import qualified Argo.Decode as Decode+import qualified Argo.Encode as Encode+import qualified Argo.Pattern as Pattern+import qualified Argo.QuasiQuoter as QuasiQuoter+import qualified Argo.Type as Type

@@ -2,6 +2,9 @@  module Argo.Class.FromValue where +import Control.Monad ((<=<))++import qualified Argo.Type as Type import qualified Argo.Type.Array as Array import qualified Argo.Type.Boolean as Boolean import qualified Argo.Type.Number as Number@@ -10,51 +13,174 @@ import qualified Argo.Type.String as String import qualified Argo.Type.Value as Value import qualified Data.Array+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-    fromValue :: Value.Value -> Maybe a+    fromValue :: Type.Value -> Maybe a -instance FromValue Value.Value where+instance FromValue Type.Value where     fromValue = Just  instance FromValue Bool where     fromValue = withBoolean "Bool" pure +instance FromValue Char where+    fromValue = withString "Char" $ \ x -> case Text.uncons x of+        Just (y, z) | Text.null z -> pure y+        _ -> fail "not singleton"++instance FromValue Int where+    fromValue =+        let+            integerToInt :: Integer -> Maybe Int+            integerToInt = Bits.toIntegralSized+        in integerToInt <=< fromValue++instance FromValue Int.Int8 where+    fromValue =+        let+            integerToInt8 :: Integer -> Maybe Int.Int8+            integerToInt8 = Bits.toIntegralSized+        in integerToInt8 <=< fromValue++instance FromValue Int.Int16 where+    fromValue =+        let+            integerToInt16 :: Integer -> Maybe Int.Int16+            integerToInt16 = Bits.toIntegralSized+        in integerToInt16 <=< fromValue++instance FromValue Int.Int32 where+    fromValue =+        let+            integerToInt32 :: Integer -> Maybe Int.Int32+            integerToInt32 = Bits.toIntegralSized+        in integerToInt32 <=< fromValue++instance FromValue Int.Int64 where+    fromValue =+        let+            integerToInt64 :: Integer -> Maybe Int.Int64+            integerToInt64 = Bits.toIntegralSized+        in integerToInt64 <=< fromValue++instance FromValue Word where+    fromValue =+        let+            integerToWord :: Integer -> Maybe Word+            integerToWord = Bits.toIntegralSized+        in integerToWord <=< fromValue++instance FromValue Word.Word8 where+    fromValue =+        let+            integerToWord8 :: Integer -> Maybe Word.Word8+            integerToWord8 = Bits.toIntegralSized+        in integerToWord8 <=< fromValue++instance FromValue Word.Word16 where+    fromValue =+        let+            integerToWord16 :: Integer -> Maybe Word.Word16+            integerToWord16 = Bits.toIntegralSized+        in integerToWord16 <=< fromValue++instance FromValue Word.Word32 where+    fromValue =+        let+            integerToWord32 :: Integer -> Maybe Word.Word32+            integerToWord32 = Bits.toIntegralSized+        in integerToWord32 <=< fromValue++instance FromValue Word.Word64 where+    fromValue =+        let+            integerToWord64 :: Integer -> Maybe Word.Word64+            integerToWord64 = Bits.toIntegralSized+        in integerToWord64 <=< fromValue+ instance FromValue Integer where     fromValue = withNumber "Integer" $ \ x y ->         if y < 0 then fail "fractional" else pure $ x * 10 ^ y +instance FromValue Float where+    fromValue = withNumber "Float" $ \ x y ->+        pure . fromRational . Number.toRational $ Number.Number x y++instance FromValue Double where+    fromValue = withNumber "Double" $ \ x y ->+        pure . fromRational . Number.toRational $ Number.Number x y++instance {-# OVERLAPPING #-} FromValue String where+    fromValue = fmap Text.unpack . fromValue+ instance FromValue Text.Text where     fromValue = withString "Text" pure +instance FromValue LazyText.Text where+    fromValue = fmap LazyText.fromStrict . fromValue++instance FromValue a => FromValue (Maybe a) where+    fromValue x = case x of+        Value.Null _ -> pure Nothing+        _ -> Just <$> fromValue x++instance FromValue () where+    fromValue x = do+        [] <- fromValue x :: Maybe [Type.Value]+        pure ()++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 -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+instance FromValue a => FromValue [a] where+    fromValue =+        let+            arrayToList :: Data.Array.Array Int b -> [b]+            arrayToList = Data.Array.elems+        in fmap arrayToList . fromValue -withBoolean :: String -> (Bool -> Maybe a) -> Value.Value -> Maybe a+instance FromValue a => FromValue (NonEmpty.NonEmpty a) where+    fromValue = NonEmpty.nonEmpty <=< fromValue++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++withBoolean :: String -> (Bool -> Maybe a) -> Type.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 :: String -> (Integer -> Integer -> Maybe a) -> Type.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 :: String -> (Text.Text -> Maybe a) -> Type.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 :: String -> (Data.Array.Array Int Type.Value -> Maybe a) -> Type.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 :: String -> (Data.Array.Array Int (Pair.Pair String.String Type.Value) -> Maybe a) -> Type.Value -> Maybe a withObject s f x = case x of     Value.Object (Object.Object y) -> f y     _ -> fail s

@@ -2,33 +2,122 @@  module Argo.Class.ToValue 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.Array+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  class ToValue a where-    toValue :: a -> Value.Value+    toValue :: a -> Type.Value -instance ToValue Value.Value where+instance ToValue Type.Value where     toValue = id  instance ToValue Bool where     toValue = Value.Boolean . Boolean.Boolean +instance ToValue Char where+    toValue = toValue . Text.singleton++instance ToValue Int where+    toValue = toValue . toInteger++instance ToValue Int.Int8 where+    toValue = toValue . toInteger++instance ToValue Int.Int16 where+    toValue = toValue . toInteger++instance ToValue Int.Int32 where+    toValue = toValue . toInteger++instance ToValue Int.Int64 where+    toValue = toValue . toInteger++instance ToValue Word where+    toValue = toValue . toInteger++instance ToValue Word.Word8 where+    toValue = toValue . toInteger++instance ToValue Word.Word16 where+    toValue = toValue . toInteger++instance ToValue Word.Word32 where+    toValue = toValue . toInteger++instance ToValue Word.Word64 where+    toValue = toValue . toInteger+ instance ToValue Integer where-    toValue = Value.Number . Number.normalize . flip Number.Number 0+    toValue = Value.Number . flip Number.number 0 +instance ToValue Float where+    toValue = realFloatToValue++instance ToValue Double where+    toValue = realFloatToValue++instance {-# OVERLAPPING #-} ToValue String where+    toValue = toValue . Text.pack+ instance ToValue Text.Text where     toValue = Value.String . String.String +instance ToValue LazyText.Text where+    toValue = toValue . LazyText.toStrict++instance ToValue a => ToValue (Maybe a) where+    toValue = maybe (Value.Null $ Null.Null ()) toValue++instance ToValue () where+    toValue = const $ toValue ([] :: [Type.Value])++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 (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))+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++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))+        $ Map.toAscList x++realFloatToValue :: RealFloat a => a -> Value.Value+realFloatToValue x+    | isNaN x = Value.Null $ Null.Null ()+    | isInfinite x = Value.Null $ Null.Null ()+    | otherwise = Value.Number . uncurry digitsToNumber $ Numeric.floatToDigits 10 x++digitsToNumber :: [Int] -> Int -> Number.Number+digitsToNumber ds e = uncurry Number.number $ List.foldl'+    (\ (a, n) d -> (a * 10 + toInteger d, n - 1))+    (0, toInteger e)+    ds

@@ -0,0 +1,14 @@+module Argo.Decode where++import qualified Argo.Class.FromValue as FromValue+import qualified Argo.Decoder as Decoder+import qualified Argo.Type.Value as Value+import qualified Data.ByteString as ByteString++decode :: FromValue.FromValue a => ByteString.ByteString -> Maybe a+decode = decodeWith FromValue.fromValue++decodeWith :: (Value.Value -> Maybe a) -> ByteString.ByteString -> Maybe a+decodeWith f x = do+    (_, y) <- Decoder.run (Decoder.spaces *> Value.decode <* Decoder.eof) x+    f y

@@ -0,0 +1,11 @@+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++encode :: ToValue.ToValue a => a -> Builder.Builder+encode = encodeWith ToValue.toValue++encodeWith :: (a -> Value.Value) -> a -> Builder.Builder+encodeWith f = Value.encode . f

@@ -0,0 +1,40 @@+{-# LANGUAGE PatternSynonyms #-}++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++pattern Null :: Type.Value+pattern Null = Value.Null (Null.Null ())++pattern Boolean :: Bool -> Type.Value+pattern Boolean x = Value.Boolean (Boolean.Boolean x)++pattern Number :: Integer -> Integer -> Type.Value+pattern Number x y <- Value.Number (Number.Number x y) where+    Number x y = Value.Number $ Number.number x y++pattern String :: Text.Text -> Type.Value+pattern String x = Value.String (String.String x)++pattern Array :: Type.Array -> Type.Value+pattern Array x = Value.Array (Array.Array x)++pattern Object :: Type.Object -> Type.Value+pattern Object x = Value.Object (Object.Object x)++{-# COMPLETE Null, Boolean, Number, String, Array, Object #-}++pattern Pair :: Text.Text -> Type.Value -> Type.Pair+pattern Pair k v = Pair.Pair (String.String k, v)++{-# COMPLETE Pair #-}

@@ -0,0 +1,18 @@+module Argo.QuasiQuoter where++import qualified Argo.Decode as Decode+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++value :: QQ.QuasiQuoter+value = QQ.QuasiQuoter+    { QQ.quoteDec = const $ fail "quoteDec"+    , QQ.quoteExp = maybe (fail "invalid JSON") TH.lift+        . Decode.decodeWith pure+        . Text.encodeUtf8+        . Text.pack+    , QQ.quotePat = const $ fail "quotePat"+    , QQ.quoteType = const $ fail "quoteType"+    }

@@ -0,0 +1,14 @@+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 Value = Value.Value++type Array = Data.Array.Array Int Value++type Pair = Pair.Pair String.String Value++type Object = Data.Array.Array Int Pair

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskellQuotes #-}+ module Argo.Type.Array where  import qualified Argo.Decoder as Decoder@@ -5,10 +7,18 @@ 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

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskellQuotes #-}+ module Argo.Type.Boolean where  import Control.Applicative ((<|>))@@ -6,10 +8,14 @@ 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

@@ -1,13 +1,19 @@+{-# 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

@@ -1,5 +1,9 @@+{-# 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@@ -9,15 +13,23 @@ 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@@ -54,7 +66,7 @@         e <- Decoder.takeWhile1 Decoder.isDigit         pure (ne, e)     Decoder.spaces-    pure . normalize $ Number+    pure $ number         (negateIf ni $ (fromDigits i * 10 ^ ByteString.length f) + fromDigits f)         (negateIf ne (fromDigits e) - intToInteger (ByteString.length f)) @@ -69,3 +81,29 @@  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,3 +1,5 @@+{-# LANGUAGE TemplateHaskellQuotes #-}+ module Argo.Type.Object where  import qualified Argo.Decoder as Decoder@@ -7,10 +9,18 @@ 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

@@ -1,13 +1,19 @@+{-# 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

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskellQuotes #-}+ module Argo.Type.String where  import qualified Argo.Decoder as Decoder@@ -11,10 +13,14 @@ 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

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskellQuotes #-}+ module Argo.Type.Value where  import Control.Applicative ((<|>))@@ -11,6 +13,7 @@ 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@@ -20,6 +23,15 @@     | 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

@@ -1,5 +1,7 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} +import Data.List.NonEmpty (NonEmpty((:|))) import Test.Tasty.HUnit ((@?=)) import Test.Tasty.QuickCheck ((===)) @@ -8,7 +10,11 @@ import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.Int as Int+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 Test.Tasty as Tasty import qualified Test.Tasty.HUnit as Tasty import qualified Test.Tasty.QuickCheck as Tasty@@ -283,9 +289,133 @@                 decode "{1:2}" @?= Nothing             ]         ]+    , Tasty.testGroup "fromValue"+        [ Tasty.testCase "Value" $ do+            Argo.fromValue Argo.Null @?= Just Argo.Null+        , Tasty.testCase "Bool" $ do+            Argo.fromValue (Argo.Boolean False) @?= Just False+        , Tasty.testCase "Char" $ do+            Argo.fromValue (Argo.String "a") @?= Just 'a'+        , Tasty.testCase "Int" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int)+        , Tasty.testCase "Int8" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int8)+        , Tasty.testCase "Int16" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int16)+        , Tasty.testCase "Int32" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int32)+        , Tasty.testCase "Int64" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int64)+        , Tasty.testCase "Word" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word)+        , Tasty.testCase "Word8" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word8)+        , Tasty.testCase "Word16" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word16)+        , Tasty.testCase "Word32" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word32)+        , Tasty.testCase "Word64" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word64)+        , Tasty.testCase "Integer" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Integer)+        , Tasty.testCase "Float" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Float)+        , Tasty.testCase "Double" $ do+            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Double)+        , Tasty.testCase "String" $ do+            Argo.fromValue (Argo.String "") @?= Just ("" :: String)+        , Tasty.testCase "Text" $ do+            Argo.fromValue (Argo.String "") @?= Just ("" :: Text.Text)+        , Tasty.testCase "LazyText" $ do+            Argo.fromValue (Argo.String "") @?= Just ("" :: LazyText.Text)+        , Tasty.testCase "Maybe a" $ do+            Argo.fromValue (Argo.Boolean False) @?= Just (Just False)+        , Tasty.testCase "()" $ do+            Argo.fromValue (Argo.Array $ array []) @?= Just ()+        , Tasty.testCase "(a, b)" $ do+            Argo.fromValue (Argo.Array $ array [Argo.Boolean False, Argo.String "a"]) @?= Just (False, 'a')+        , Tasty.testCase "Array Int a" $ do+            Argo.fromValue (Argo.Array $ array []) @?= Just (array [] :: Array.Array Int Bool)+        , Tasty.testCase "[a]" $ do+            Argo.fromValue (Argo.Array $ array []) @?= Just ([] :: [Bool])+        , Tasty.testCase "NonEmpty a" $ do+            Argo.fromValue (Argo.Array $ array [Argo.Boolean False]) @?= Just (False :| [])+        , Tasty.testCase "Map Text a" $ do+            Argo.fromValue (Argo.Object $ array [Argo.Pair "a" $ Argo.Boolean False]) @?= Just (Map.fromList [("a" :: Text.Text, False)])+        ]+    , Tasty.testGroup "toValue"+        [ Tasty.testCase "Value" $ do+            Argo.toValue Argo.Null @?= Argo.Null+        , Tasty.testCase "Bool" $ do+            Argo.toValue False @?= Argo.Boolean False+        , Tasty.testCase "Char" $ do+            Argo.toValue 'a' @?= Argo.String "a"+        , Tasty.testCase "Int" $ do+            Argo.toValue (0 :: Int) @?= Argo.Number 0 0+        , Tasty.testCase "Int8" $ do+            Argo.toValue (0 :: Int.Int8) @?= Argo.Number 0 0+        , Tasty.testCase "Int16" $ do+            Argo.toValue (0 :: Int.Int16) @?= Argo.Number 0 0+        , Tasty.testCase "Int32" $ do+            Argo.toValue (0 :: Int.Int32) @?= Argo.Number 0 0+        , Tasty.testCase "Int64" $ do+            Argo.toValue (0 :: Int.Int64) @?= Argo.Number 0 0+        , Tasty.testCase "Word" $ do+            Argo.toValue (0 :: Word) @?= Argo.Number 0 0+        , Tasty.testCase "Word8" $ do+            Argo.toValue (0 :: Word.Word8) @?= Argo.Number 0 0+        , Tasty.testCase "Word16" $ do+            Argo.toValue (0 :: Word.Word16) @?= Argo.Number 0 0+        , Tasty.testCase "Word32" $ do+            Argo.toValue (0 :: Word.Word32) @?= Argo.Number 0 0+        , Tasty.testCase "Word64" $ do+            Argo.toValue (0 :: Word.Word64) @?= Argo.Number 0 0+        , Tasty.testCase "Integer" $ do+            Argo.toValue (0 :: Integer) @?= Argo.Number 0 0+        , Tasty.testCase "Float" $ do+            Argo.toValue (0 :: Float) @?= Argo.Number 0 0+        , Tasty.testCase "Double" $ do+            Argo.toValue (0 :: Double) @?= Argo.Number 0 0+        , Tasty.testCase "String" $ do+            Argo.toValue ("" :: String) @?= Argo.String ""+        , Tasty.testCase "Text" $ do+            Argo.toValue ("" :: Text.Text) @?= Argo.String ""+        , Tasty.testCase "LazyText" $ do+            Argo.toValue ("" :: LazyText.Text) @?= Argo.String ""+        , Tasty.testCase "Maybe a" $ do+            Argo.toValue (Just False) @?= Argo.Boolean False+        , Tasty.testCase "()" $ do+            Argo.toValue () @?= Argo.Array (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 [])+        , Tasty.testCase "[a]" $ do+            Argo.toValue ([] :: [Bool]) @?= Argo.Array (array [])+        , Tasty.testCase "NonEmpty a" $ do+            Argo.toValue (False :| []) @?= Argo.Array (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])+        ]+    , Tasty.testGroup "quasi quoter"+        [ Tasty.testCase "Null" $ do+            [Argo.value| null |] @?= Argo.Null+        , Tasty.testCase "Boolean" $ do+            [Argo.value| false |] @?= Argo.Boolean False+        , Tasty.testCase "Number" $ do+            [Argo.value| 0 |] @?= Argo.Number 0 0+        , Tasty.testCase "String" $ do+            [Argo.value| "" |] @?= Argo.String ""+        , Tasty.testCase "Array" $ do+            [Argo.value| [] |] @?= Argo.Array (array [])+        , Tasty.testCase "Object" $ do+            [Argo.value| {} |] @?= Argo.Object (array [])+        ]     , Tasty.testGroup "property"-        [ Tasty.testProperty "round trip" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->+        [ Tasty.testProperty "decode . encode" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->             (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode y) === Just y+        , Tasty.testProperty "fromValue . toValue" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->+            Argo.fromValue (Argo.toValue y) === Just y         ]     ]