argo 0.2021.11.11 → 0.2021.11.13

raw patch · 14 files changed

+370/−440 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• argo.cabal +3/−1
• source/library/Argo.hs +4/−2
• source/library/Argo/Class/FromValue.hs +4/−158
• source/library/Argo/Class/HasCodec.hs +257/−0
• source/library/Argo/Class/ToValue.hs +4/−129
• source/library/Argo/Decode.hs +2/−1
• source/library/Argo/Encode.hs +3/−2
• source/library/Argo/Json/Member.hs +6/−0
• source/library/Argo/Json/Name.hs +1/−1
• source/library/Argo/Json/String.hs +1/−1
• source/library/Argo/Type/Codec.hs +21/−113
• source/library/Argo/Type/Decimal.hs +27/−2
• source/library/Argo/Vendor/Map.hs +7/−0
• source/test-suite/Main.hs +30/−30

@@ -1,7 +1,7 @@ cabal-version: 2.2  name: argo-version: 0.2021.11.11+version: 0.2021.11.13  build-type: Simple category: JSON@@ -68,6 +68,7 @@     exposed-modules:         Argo         Argo.Class.FromValue+        Argo.Class.HasCodec         Argo.Class.ToValue         Argo.Decode         Argo.Encode@@ -100,6 +101,7 @@         Argo.Vendor.Builder         Argo.Vendor.ByteString         Argo.Vendor.DeepSeq+        Argo.Vendor.Map         Argo.Vendor.TemplateHaskell         Argo.Vendor.Text         Argo.Vendor.Transformers

@@ -15,8 +15,9 @@     , Encode.encodeWith     , Indent.Indent(Spaces, Tab)     , Decode.decode-    , FromValue.FromValue(fromValue)-    , ToValue.ToValue(toValue)+    , FromValue.fromValue+    , ToValue.toValue+    , HasCodec.HasCodec(codec)     , QuasiQuoter.value     , QuasiQuoter.pointer     , Pointer.Pointer(Pointer)@@ -28,6 +29,7 @@     ) where  import qualified Argo.Class.FromValue as FromValue+import qualified Argo.Class.HasCodec as HasCodec import qualified Argo.Class.ToValue as ToValue import qualified Argo.Decode as Decode import qualified Argo.Encode as Encode

@@ -1,162 +1,8 @@-{-# LANGUAGE FlexibleInstances #-}- module Argo.Class.FromValue where -import qualified Argo.Json.Member as Member+import qualified Argo.Class.HasCodec as HasCodec import qualified Argo.Json.Value as Value-import qualified Argo.Pattern as Pattern-import qualified Argo.Pointer.Pointer as Pointer-import qualified Argo.Type.Decimal as Decimal-import qualified Argo.Type.Decoder as Decoder-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.Word as Word--class FromValue a where-    fromValue :: Value.Value -> Either String a--instance FromValue Value.Value where-    fromValue = Right--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-        _ -> Left $ "expected single character but got " <> show x--instance FromValue Int where-    fromValue = viaInteger--instance FromValue Int.Int8 where-    fromValue = viaInteger--instance FromValue Int.Int16 where-    fromValue = viaInteger--instance FromValue Int.Int32 where-    fromValue = viaInteger--instance FromValue Int.Int64 where-    fromValue = viaInteger--instance FromValue Word where-    fromValue = viaInteger--instance FromValue Word.Word8 where-    fromValue = viaInteger--instance FromValue Word.Word16 where-    fromValue = viaInteger--instance FromValue Word.Word32 where-    fromValue = viaInteger--instance FromValue Word.Word64 where-    fromValue = viaInteger--instance FromValue Integer where-    fromValue = withNumber "Integer" $ \x@(Decimal.Decimal s e) -> if e < 0-        then Left $ "expected integer but got " <> show x-        else pure $ s * 10 ^ e--instance FromValue Float where-    fromValue = withNumber "Float" $ pure . fromRational . Decimal.toRational--instance FromValue Double where-    fromValue = withNumber "Double" $ pure . fromRational . Decimal.toRational--instance {-# OVERLAPPING #-} FromValue String where-    fromValue = fmap Text.unpack . fromValue--instance FromValue Text.Text where-    fromValue = withString "Text" pure--instance FromValue Text.LazyText where-    fromValue = fmap Text.fromStrict . fromValue--instance FromValue a => FromValue (Maybe a) where-    fromValue x = case x of-        Pattern.Null -> pure Nothing-        _ -> Just <$> fromValue x--instance FromValue () where-    fromValue = withArray "()" $ \xs -> case xs of-        [] -> pure ()-        _ -> Left $ "expected empty list but got " <> show xs--instance (FromValue a, FromValue b) => FromValue (a, b) where-    fromValue = withArray "(a, b)" $ \xs -> case xs of-        [x, y] -> (,) <$> fromValue x <*> fromValue y-        _ -> Left $ "expected tuple but got " <> show xs--instance FromValue a => FromValue [a] where-    fromValue = withArray "[a]" $ traverse fromValue--instance FromValue a => FromValue (NonEmpty.NonEmpty a) where-    fromValue value = do-        list <- fromValue value-        case NonEmpty.nonEmpty list of-            Nothing -> Left "unexpected empty list"-            Just nonEmpty -> pure nonEmpty--instance FromValue a => FromValue (Map.Map Text.Text a) where-    fromValue = withObject "Map" $ fmap Map.fromList . traverse-        (\(Member.Member (Pattern.Name k) v) -> (,) k <$> fromValue v)--instance FromValue Pointer.Pointer where-    fromValue =-        withString "Pointer" $ Decoder.run Pointer.decode . Text.encodeUtf8--withBoolean-    :: String -> (Bool -> Either String a) -> Value.Value -> Either String a-withBoolean s f x = case x of-    Pattern.Boolean y -> f y-    _ -> Left $ "expected " <> s <> " but got " <> show x--withNumber-    :: String-    -> (Decimal.Decimal -> Either String a)-    -> Value.Value-    -> Either String a-withNumber s f x = case x of-    Pattern.Number y -> f y-    _ -> Left $ "expected " <> s <> " but got " <> show x--withString-    :: String-    -> (Text.Text -> Either String a)-    -> Value.Value-    -> Either String a-withString s f x = case x of-    Pattern.String y -> f y-    _ -> Left $ "expected " <> s <> " but got " <> show x--withArray-    :: String-    -> ([Value.Value] -> Either String a)-    -> Value.Value-    -> Either String a-withArray s f x = case x of-    Pattern.Array y -> f y-    _ -> Left $ "expected " <> s <> " but got " <> show x--withObject-    :: String-    -> ([Member.MemberOf Value.Value] -> Either String a)-    -> Value.Value-    -> Either String a-withObject s f x = case x of-    Pattern.Object y -> f y-    _ -> Left $ "expected " <> s <> " but got " <> show x+import qualified Argo.Type.Codec as Codec -viaInteger :: (Integral a, Bits.Bits a) => Value.Value -> Either String a-viaInteger value = do-    integer <- fromValue value-    case Bits.toIntegralSized (integer :: Integer) of-        Nothing -> Left $ "integer out of bounds " <> show integer-        Just x -> pure x+fromValue :: HasCodec.HasCodec a => Value.Value -> Either String a+fromValue = Codec.decodeWith HasCodec.codec

@@ -0,0 +1,257 @@+{-# LANGUAGE FlexibleInstances #-}++module Argo.Class.HasCodec where++import Control.Applicative ((<|>))++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.Pointer.Pointer as Pointer+import qualified Argo.Type.Codec as Codec+import qualified Argo.Type.Config as Config+import qualified Argo.Type.Decimal as Decimal+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder+import qualified Argo.Type.Permission as Permission+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.ByteString as ByteString+import qualified Argo.Vendor.Map as Map+import qualified Argo.Vendor.Text as Text+import qualified Argo.Vendor.Transformers as Trans+import qualified Data.Bits as Bits+import qualified Data.Functor.Identity as Identity+import qualified Data.Int as Int+import qualified Data.List.NonEmpty as NonEmpty+import qualified Data.Word as Word++class HasCodec a where+    codec :: Codec.ValueCodec a++instance HasCodec Value.Value where+    codec = Codec.Codec+        { Codec.decode = Trans.ask+        , Codec.encode = Codec.tap $ Trans.lift . Trans.put+        }++instance HasCodec Null.Null where+    codec = basicCodec "Null" Value.Null $ \ value -> case value of+        Value.Null null_ -> Just null_+        _ -> Nothing++instance HasCodec Boolean.Boolean where+    codec = basicCodec "Boolean" Value.Boolean $ \ value -> case value of+        Value.Boolean boolean -> Just boolean+        _ -> Nothing++instance HasCodec Number.Number where+    codec = basicCodec "Number" Value.Number $ \ value -> case value of+        Value.Number number -> Just number+        _ -> Nothing++instance HasCodec String.String where+    codec = basicCodec "String" Value.String $ \ value -> case value of+        Value.String string -> Just string+        _ -> Nothing++instance HasCodec a => HasCodec (Array.ArrayOf a) where+    codec = Codec.Codec+        { Codec.decode = do+            array <- castValue "Array" $ \ value -> case value of+                Value.Array array -> Just array+                _ -> Nothing+            either (Trans.lift . Trans.throwE) (pure . Array.fromList)+                . traverse (Codec.decodeWith codec)+                $ Array.toList array+        , Codec.encode = Codec.tap+            $ Trans.lift+            . Trans.put+            . Value.Array+            . Array.fromList+            . fmap (Codec.encodeWith codec)+            . Array.toList+        }++instance HasCodec a => HasCodec (Object.ObjectOf a) where+    codec = Codec.Codec+        { Codec.decode = do+            object <- castValue "Object" $ \ value -> case value of+                Value.Object object -> Just object+                _ -> Nothing+            either (Trans.lift . Trans.throwE) (pure . Object.fromList)+                . traverse (\ (Member.Member k v) -> Member.Member k <$> Codec.decodeWith codec v)+                $ Object.toList object+        , Codec.encode = Codec.tap+            $ Trans.lift+            . Trans.put+            . Value.Object+            . Object.fromList+            . fmap (\ (Member.Member k v) -> Member.Member k $ Codec.encodeWith codec v)+            . Object.toList+        }++instance HasCodec a => HasCodec (Maybe a) where+    codec = Codec.mapMaybe (Just . Just) id codec+        <|> Codec.dimap (const Nothing) (const $ Null.fromUnit ()) codec++instance (HasCodec a, HasCodec b) => HasCodec (Either a b) where+    codec = Codec.mapMaybe (Just . Left) (either Just $ const Nothing) (Codec.tagged "Left" codec)+        <|> Codec.mapMaybe (Just . Right) (either (const Nothing) Just) (Codec.tagged "Right" codec)++instance HasCodec () where+    codec = Codec.fromArrayCodec Permission.Forbid $ pure ()++instance (HasCodec a, HasCodec b) => HasCodec (a, b) where+    codec = Codec.fromArrayCodec Permission.Forbid $ (,)+        <$> Codec.project fst (Codec.element codec)+        <*> Codec.project snd (Codec.element codec)++instance HasCodec Bool where+    codec = Codec.dimap Boolean.toBool Boolean.fromBool codec++instance HasCodec Decimal.Decimal where+    codec = Codec.dimap Number.toDecimal Number.fromDecimal codec++instance HasCodec Text.Text where+    codec = Codec.dimap String.toText String.fromText codec++instance {-# OVERLAPPABLE #-} HasCodec a => HasCodec [a] where+    codec = Codec.dimap Array.toList Array.fromList codec++instance HasCodec a => HasCodec (Map.Map Name.Name a) where+    codec = Codec.dimap+        (Map.fromList . fmap Member.toTuple . Object.toList)+        (Object.fromList . fmap Member.fromTuple . Map.toList)+        codec++instance HasCodec String where+    codec = Codec.dimap Text.unpack Text.pack codec++instance HasCodec Char where+    codec = Codec.mapMaybe (\ x -> case Text.uncons x of+        Just (y, z) | Text.null z -> Just y+        _ -> Nothing) (Just . Text.singleton) codec++instance HasCodec Text.LazyText where+    codec = Codec.dimap Text.fromStrict Text.toStrict codec++instance HasCodec a => HasCodec (NonEmpty.NonEmpty a) where+    codec = Codec.mapMaybe NonEmpty.nonEmpty (Just . NonEmpty.toList) codec++instance HasCodec Integer where+    codec = Codec.mapMaybe Decimal.toInteger (Just . Decimal.fromInteger) codec++instance HasCodec Int where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Int+        into = fromIntegral :: Int -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Int.Int8 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Int.Int8+        into = fromIntegral :: Int.Int8 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Int.Int16 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Int.Int16+        into = fromIntegral :: Int.Int16 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Int.Int32 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Int.Int32+        into = fromIntegral :: Int.Int32 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Int.Int64 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Int.Int64+        into = fromIntegral :: Int.Int64 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Word where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Word+        into = fromIntegral :: Word -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Word.Word8 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Word.Word8+        into = fromIntegral :: Word.Word8 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Word.Word16 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Word.Word16+        into = fromIntegral :: Word.Word16 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Word.Word32 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Word.Word32+        into = fromIntegral :: Word.Word32 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Word.Word64 where+    codec = let+        from = Bits.toIntegralSized :: Integer -> Maybe Word.Word64+        into = fromIntegral :: Word.Word64 -> Integer+        in Codec.mapMaybe from (Just . into) codec++instance HasCodec Float where+    codec = Codec.mapMaybe (Just . Decimal.toRealFloat) Decimal.fromRealFloat codec++instance HasCodec Double where+    codec = Codec.mapMaybe (Just . Decimal.toRealFloat) Decimal.fromRealFloat codec++instance HasCodec Pointer.Pointer where+    codec = Codec.mapMaybe+        ( either (const Nothing) Just+        . Decoder.run Pointer.decode+        . Text.encodeUtf8+        )+        ( either (const Nothing) Just+        . Text.decodeUtf8'+        . ByteString.toStrict+        . Builder.toLazyByteString+        . Encoder.run Config.initial+        . Pointer.encode+        )+        codec++basicCodec :: String -> (a -> Value.Value) -> (Value.Value -> Maybe a) -> Codec.ValueCodec a+basicCodec expected toValue fromValue = Codec.Codec+    { Codec.decode = castValue expected fromValue+    , Codec.encode = Codec.tap $ Trans.lift . Trans.put . toValue+    }++castValue+    :: String+    -> (Value.Value -> Maybe a)+    -> Trans.ReaderT Value.Value (Trans.ExceptT String Identity.Identity) a+castValue expected fromValue = do+    value <- Trans.ask+    case fromValue value of+        Nothing -> Trans.lift . Trans.throwE $ typeMismatch expected value+        Just x -> pure x++typeMismatch :: String -> Value.Value -> String+typeMismatch expected value =+    let+        actual = case value of+            Value.Null _ -> "Null"+            Value.Boolean _ -> "Boolean"+            Value.Number _ -> "Number"+            Value.String _ -> "String"+            Value.Array _ -> "Array"+            Value.Object _ -> "Object"+    in "expected " <> expected <> " but got " <> actual

@@ -1,133 +1,8 @@-{-# LANGUAGE FlexibleInstances #-}- module Argo.Class.ToValue where -import qualified Argo.Json.Member as Member-import qualified Argo.Json.Number as Number+import qualified Argo.Class.HasCodec as HasCodec import qualified Argo.Json.Value as Value-import qualified Argo.Pattern as Pattern-import qualified Argo.Pointer.Pointer as Pointer-import qualified Argo.Type.Config as Config-import qualified Argo.Type.Decimal as Decimal-import qualified Argo.Type.Encoder as Encoder-import qualified Argo.Vendor.Builder as Builder-import qualified Argo.Vendor.ByteString as ByteString-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.Word as Word-import qualified Numeric--class ToValue a where-    toValue :: a -> Value.Value--instance ToValue Value.Value where-    toValue = id--instance ToValue Bool where-    toValue = Pattern.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 x = Pattern.Number $ Decimal.decimal x 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 = Pattern.String--instance ToValue Text.LazyText where-    toValue = toValue . Text.toStrict--instance ToValue a => ToValue (Maybe a) where-    toValue = maybe Pattern.Null toValue--instance ToValue () where-    toValue = const $ toValue ([] :: [Value.Value])--instance (ToValue a, ToValue b) => ToValue (a, b) where-    toValue (x, y) = toValue [toValue x, toValue y]--instance ToValue a => ToValue [a] where-    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 =-        Pattern.Object-            . fmap (\(k, v) -> Member.Member (Pattern.Name k) (toValue v))-            $ Map.toAscList x--instance ToValue Pointer.Pointer where-    toValue =-        either (error . mappend "Pointer.toValue: " . show) toValue-            . Text.decodeUtf8'-            . ByteString.toStrict-            . Builder.toLazyByteString-            . Encoder.run Config.initial-            . Pointer.encode--realFloatToValue :: RealFloat a => a -> Value.Value-realFloatToValue x-    | isNaN x-    = Pattern.Null-    | isInfinite x-    = Pattern.Null-    | otherwise-    = let isNegative = x < 0-      in-          Value.Number-          . Number.fromDecimal-          . (if isNegative then Decimal.negate else id)-          . uncurry digitsToDecimal-          . Numeric.floatToDigits 10-          $ abs x+import qualified Argo.Type.Codec as Codec -digitsToDecimal :: [Int] -> Int -> Decimal.Decimal-digitsToDecimal ds e = uncurry Decimal.decimal $ List.foldl'-    (\(a, n) d -> (a * 10 + toInteger d, n - 1))-    (0, toInteger e)-    ds+toValue :: HasCodec.HasCodec a => a -> Value.Value+toValue = Codec.encodeWith HasCodec.codec

@@ -1,12 +1,13 @@ module Argo.Decode where  import qualified Argo.Class.FromValue as FromValue+import qualified Argo.Class.HasCodec as HasCodec import qualified Argo.Json.Value as Value import qualified Argo.Pointer.Pointer as Pointer import qualified Argo.Type.Decoder as Decoder import qualified Argo.Vendor.ByteString as ByteString -decode :: FromValue.FromValue a => ByteString.ByteString -> Either String a+decode :: HasCodec.HasCodec a => ByteString.ByteString -> Either String a decode x = do     y <- Decoder.run (Decoder.spaces *> Value.decode) x     FromValue.fromValue y

@@ -1,5 +1,6 @@ module Argo.Encode where +import qualified Argo.Class.HasCodec as HasCodec import qualified Argo.Class.ToValue as ToValue import qualified Argo.Json.Value as Value import qualified Argo.Literal as Literal@@ -11,10 +12,10 @@ import qualified Argo.Vendor.Transformers as Trans import qualified Control.Monad as Monad -encode :: ToValue.ToValue a => a -> Builder.Builder+encode :: HasCodec.HasCodec a => a -> Builder.Builder encode = encodeWith $ Indent.Spaces 0 -encodeWith :: ToValue.ToValue a => Indent.Indent -> a -> Builder.Builder+encodeWith :: HasCodec.HasCodec a => Indent.Indent -> a -> Builder.Builder encodeWith i x =     let c = Config.initial { Config.indent = i }     in

@@ -19,6 +19,12 @@ data MemberOf value = Member Name.Name value     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +fromTuple :: (Name.Name, value) -> MemberOf value+fromTuple = uncurry Member++toTuple :: MemberOf value -> (Name.Name, value)+toTuple (Member k v) = (k, v)+ encode     :: (value -> Encoder.Encoder ()) -> MemberOf value -> Encoder.Encoder () encode f (Member x y) = do

@@ -14,7 +14,7 @@  newtype Name     = Name String.String-    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Ord, Show)  instance Data.String.IsString Name where     fromString = fromString . Data.String.fromString

@@ -21,7 +21,7 @@  newtype String     = String Text.Text-    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)+    deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Ord, Show)  instance String.IsString Argo.Json.String.String where     fromString = fromText . String.fromString

@@ -3,11 +3,9 @@ import Control.Applicative ((<|>))  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@@ -16,6 +14,7 @@ import qualified Control.Applicative as Applicative import qualified Control.Monad as Monad import qualified Data.Functor.Identity as Identity+import qualified Data.List as List import qualified Data.Text as Text  decodeWith :: ValueCodec a -> Value.Value -> Either String a@@ -67,81 +66,15 @@ dimap f g c =     Codec { decode = f <$> decode c, encode = fmap f . encode c . g } +tap :: Functor f => (a -> f b) -> a -> f a+tap f x = x <$ f x+ type ValueCodec a     = Codec           (Trans.ReaderT Value.Value (Trans.ExceptT String Identity.Identity))           (Trans.MaybeT (Trans.StateT Value.Value Identity.Identity))           a -valueCodec :: ValueCodec Value.Value-valueCodec = Codec-    { decode = Trans.ask-    , encode = \x -> do-        Trans.lift $ Trans.put x-        pure x-    }--nullCodec :: ValueCodec Null.Null-nullCodec = Codec-    { decode = do-        x <- Trans.ask-        case x of-            Value.Null y -> pure y-            _ ->-                Trans.lift . Trans.throwE $ "expected Null but got " <> show x-    , encode = \x -> do-        Trans.lift . Trans.put $ Value.Null x-        pure x-    }--booleanCodec :: ValueCodec Boolean.Boolean-booleanCodec = Codec-    { decode = do-        x <- Trans.ask-        case x of-            Value.Boolean y -> pure y-            _ ->-                Trans.lift-                    . Trans.throwE-                    $ "expected Boolean but got "-                    <> show x-    , encode = \x -> do-        Trans.lift . Trans.put $ Value.Boolean x-        pure x-    }--numberCodec :: ValueCodec Number.Number-numberCodec = Codec-    { decode = do-        x <- Trans.ask-        case x of-            Value.Number y -> pure y-            _ ->-                Trans.lift-                    . Trans.throwE-                    $ "expected Number but got "-                    <> show x-    , encode = \x -> do-        Trans.lift . Trans.put $ Value.Number x-        pure x-    }--stringCodec :: ValueCodec String.String-stringCodec = Codec-    { decode = do-        x <- Trans.ask-        case x of-            Value.String y -> pure y-            _ ->-                Trans.lift-                    . Trans.throwE-                    $ "expected String but got "-                    <> show x-    , encode = \x -> do-        Trans.lift . Trans.put $ Value.String x-        pure x-    }- arrayCodec :: ValueCodec (Array.ArrayOf Value.Value) arrayCodec = Codec     { decode = do@@ -171,35 +104,25 @@         pure x     } -boolCodec :: ValueCodec Bool-boolCodec = dimap Boolean.toBool Boolean.fromBool booleanCodec--textCodec :: ValueCodec Text.Text-textCodec = dimap String.toText String.fromText stringCodec--maybeCodec :: ValueCodec a -> ValueCodec (Maybe a)-maybeCodec c =-    mapBoth Just id c-        <|> dimap (const Nothing) (const $ Null.fromUnit ()) nullCodec--eitherCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (Either a b)-eitherCodec cx cy =-    mapBoth Left (either Just (const Nothing)) (tagged "Left" cx)-        <|> mapBoth Right (either (const Nothing) Just) (tagged "Right" cy)--mapBoth-    :: (Functor r, Applicative.Alternative w)-    => (o2 -> o1)+mapMaybe+    :: (Applicative.Alternative r, Applicative.Alternative w, Monad r, Monad w)+    => (o2 -> Maybe o1)     -> (i1 -> Maybe i2)     -> CodecOf r w i2 o2     -> CodecOf r w i1 o1-mapBoth f g c = Codec-    { decode = f <$> decode c-    , encode = \x -> case g x of-        Nothing -> Applicative.empty-        Just y -> f <$> encode c y+mapMaybe f g c = Codec+    { decode = do+        o2 <- decode c+        toAlternative $ f o2+    , encode = \ i1 -> do+        i2 <- toAlternative $ g i1+        o2 <- encode c i2+        toAlternative $ f o2     } +toAlternative :: Applicative.Alternative m => Maybe a -> m a+toAlternative = maybe Applicative.empty pure+ tagged :: String -> ValueCodec a -> ValueCodec a tagged t c =     dimap snd ((,) ())@@ -288,13 +211,6 @@         pure x     } -tupleCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (a, b)-tupleCodec cx cy =-    fromArrayCodec Permission.Forbid-        $ (,)-        <$> project fst (element cx)-        <*> project snd (element cy)- type ObjectCodec a = ListCodec (Member.MemberOf Value.Value) a  fromObjectCodec :: Permission.Permission -> ObjectCodec a -> ValueCodec a@@ -321,24 +237,16 @@ optional k c = Codec     { decode = do         xs <- Trans.get-        case detect (\(Member.Member j _) -> j == k) xs of-            Nothing -> pure Nothing-            Just (Member.Member _ x, ys) -> case decodeWith c x of+        case List.partition (\(Member.Member j _) -> j == k) xs of+            (Member.Member _ x : _, ys) -> case decodeWith c x of                 Left y -> Trans.lift $ Trans.throwE y                 Right y -> do                     Trans.put ys                     pure $ Just y+            _ -> pure Nothing     , encode = \x -> do         case x of             Nothing -> pure ()             Just y -> Trans.tell [Member.Member k $ encodeWith c y]         pure x     }--detect :: (a -> Bool) -> [a] -> Maybe (a, [a])-detect = detectWith id--detectWith :: ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])-detectWith f p xs = case xs of-    [] -> Nothing-    x : ys -> if p x then Just (x, f ys) else detectWith (f . (x :)) p ys

@@ -8,8 +8,10 @@  import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Data.List as List import qualified Data.Ratio as Ratio import qualified GHC.Generics as Generics+import qualified Numeric  data Decimal = Decimal Integer Integer     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)@@ -27,9 +29,32 @@         let (q, r) = quotRem s 10         in if r == 0 then normalize $ Decimal q (e + 1) else Decimal s e +fromInteger :: Integer -> Decimal+fromInteger = flip decimal 0++toInteger :: Decimal -> Maybe Integer+toInteger (Decimal s e) = if e < 0 then Nothing else Just $ s * 10 ^ e++fromRealFloat :: RealFloat a => a -> Maybe Decimal+fromRealFloat x = if isNaN x || isInfinite x then Nothing else+    Just+    . (if x < 0 then Argo.Type.Decimal.negate else id)+    . uncurry fromDigits+    . Numeric.floatToDigits 10+    $ abs x++toRealFloat :: RealFloat a => Decimal -> a+toRealFloat = Prelude.fromRational . Argo.Type.Decimal.toRational++fromDigits :: [Int] -> Int -> Decimal+fromDigits ds e = uncurry decimal $ List.foldl'+    (\(a, n) d -> (a * 10 + Prelude.toInteger d, n - 1))+    (0, Prelude.toInteger e)+    ds+ toRational :: Decimal -> Rational-toRational (Decimal s e) =-    if e < 0 then s % (10 ^ (-e)) else fromInteger $ s * 10 ^ e+toRational d@(Decimal s e) =+    maybe (s % (10 ^ (-e))) fromIntegral $ Argo.Type.Decimal.toInteger d  fromRational :: Rational -> Maybe Decimal fromRational r =

@@ -0,0 +1,7 @@+module Argo.Vendor.Map+    ( Map.Map+    , Map.fromList+    , Map.toList+    ) where++import qualified Data.Map as Map

@@ -341,8 +341,8 @@             Argo.fromValue (Argo.Array []) @?= Right ([] :: [Bool])         , Tasty.testCase "NonEmpty a" $ do             Argo.fromValue (Argo.Array [Argo.Boolean False]) @?= Right (False :| [])-        , Tasty.testCase "Map Text a" $ do-            Argo.fromValue (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]) @?= Right (Map.fromList [("a" :: Text.Text, False)])+        , Tasty.testCase "Map Name a" $ do+            Argo.fromValue (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]) @?= Right (Map.fromList [(Argo.Name "a", False)])         , Tasty.testCase "Pointer" $ do             Argo.fromValue (Argo.String "") @?= Right (Argo.Pointer [])         ]@@ -395,8 +395,8 @@             Argo.toValue ([] :: [Bool]) @?= Argo.Array []         , Tasty.testCase "NonEmpty a" $ do             Argo.toValue (False :| []) @?= Argo.Array [Argo.Boolean False]-        , Tasty.testCase "Map Text a" $ do-            Argo.toValue (Map.fromList [("a" :: Text.Text, False)]) @?= Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]+        , Tasty.testCase "Map Name a" $ do+            Argo.toValue (Map.fromList [(Argo.Name "a", False)]) @?= Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]         , Tasty.testCase "Pointer" $ do             Argo.toValue (Argo.Pointer []) @?= Argo.String ""         ]@@ -474,43 +474,43 @@                 Argo.fromValue (Argo.toValue x) === Right (x :: [Bool])             , property "NonEmpty a" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Right (x :: NonEmpty Bool)-            , property "Map Text a" $ \ x ->-                Argo.fromValue (Argo.toValue x) === Right (x :: Map.Map Text.Text Bool)+            , property "Map Name a" $ \ x ->+                Argo.fromValue (Argo.toValue x) === Right (x :: Map.Map Argo.Name Bool)             , property "Pointer" $ \ x ->                 Argo.fromValue (Argo.toValue x) === Right (x :: Argo.Pointer)             ]         ]     , Tasty.testGroup "Codec"         [ Tasty.testCase "encode text" $ do-            Codec.encodeWith Codec.textCodec "" @?= Argo.String ""+            Codec.encodeWith Argo.codec ("" :: Text.Text) @?= Argo.String ""         , Tasty.testCase "decode text" $ do-            Codec.decodeWith Codec.textCodec (Argo.String "") @?= Right ""+            Codec.decodeWith Argo.codec (Argo.String "") @?= Right ("" :: Text.Text)         , Tasty.testCase "encode bool" $ do-            Codec.encodeWith Codec.boolCodec False @?= Argo.Boolean False+            Codec.encodeWith Argo.codec False @?= Argo.Boolean False         , Tasty.testCase "decode bool" $ do-            Codec.decodeWith Codec.boolCodec (Argo.Boolean False) @?= Right False-        , Tasty.testCase "encode maybe text" $ do-            Codec.encodeWith (Codec.maybeCodec Codec.textCodec) Nothing @?= Argo.Null-            Codec.encodeWith (Codec.maybeCodec Codec.textCodec) (Just "") @?= Argo.String ""-        , Tasty.testCase "decode maybe text" $ do-            Codec.decodeWith (Codec.maybeCodec Codec.textCodec) Argo.Null @?= Right Nothing-            Codec.decodeWith (Codec.maybeCodec Codec.textCodec) (Argo.String "") @?= Right (Just "")+            Codec.decodeWith Argo.codec (Argo.Boolean False) @?= Right False+        , Tasty.testCase "encode maybe bool" $ do+            Codec.encodeWith Argo.codec (Nothing :: Maybe Bool) @?= Argo.Null+            Codec.encodeWith Argo.codec (Just False) @?= Argo.Boolean False+        , Tasty.testCase "decode maybe bool" $ do+            Codec.decodeWith Argo.codec Argo.Null @?= Right (Nothing :: Maybe Bool)+            Codec.decodeWith Argo.codec (Argo.Boolean False) @?= Right (Just False)         , Tasty.testCase "encode either text bool" $ do-            Codec.encodeWith (Codec.eitherCodec Codec.textCodec Codec.boolCodec) (Left "") @?= Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Left", Argo.Member (Argo.Name "value") $ Argo.String ""]-            Codec.encodeWith (Codec.eitherCodec Codec.textCodec Codec.boolCodec) (Right False) @?= Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Right", Argo.Member (Argo.Name "value") $ Argo.Boolean False]+            Codec.encodeWith Argo.codec (Left "" :: Either Text.Text Bool) @?= Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Left", Argo.Member (Argo.Name "value") $ Argo.String ""]+            Codec.encodeWith Argo.codec (Right False :: Either Text.Text Bool) @?= Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Right", Argo.Member (Argo.Name "value") $ Argo.Boolean False]         , Tasty.testCase "decode either text bool" $ do-            Codec.decodeWith (Codec.eitherCodec Codec.textCodec Codec.boolCodec) (Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Left", Argo.Member (Argo.Name "value") $ Argo.String ""]) @?= Right (Left "")-            Codec.decodeWith (Codec.eitherCodec Codec.textCodec Codec.boolCodec) (Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Right", Argo.Member (Argo.Name "value") $ Argo.Boolean False]) @?= Right (Right False)+            Codec.decodeWith Argo.codec (Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Left", Argo.Member (Argo.Name "value") $ Argo.String ""]) @?= Right (Left "" :: Either Text.Text Bool)+            Codec.decodeWith Argo.codec (Argo.Object [Argo.Member (Argo.Name "type") $ Argo.String "Right", Argo.Member (Argo.Name "value") $ Argo.Boolean False]) @?= Right (Right False :: Either Text.Text Bool)         , Tasty.testCase "encode tuple text bool" $ do-            Codec.encodeWith (Codec.tupleCodec Codec.textCodec Codec.boolCodec) ("", False) @?= Argo.Array [Argo.String "", Argo.Boolean False]+            Codec.encodeWith Argo.codec ("" :: Text.Text, False) @?= Argo.Array [Argo.String "", Argo.Boolean False]         , Tasty.testCase "decode tuple text bool" $ do-            Codec.decodeWith (Codec.tupleCodec Codec.textCodec Codec.boolCodec) (Argo.Array [Argo.String "", Argo.Boolean False]) @?= Right ("", False)+            Codec.decodeWith Argo.codec (Argo.Array [Argo.String "", Argo.Boolean False]) @?= Right ("" :: Text.Text, False)         , Tasty.testCase "encode record" $ do-            Codec.encodeWith recordCodec (Record False Nothing) @?= Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False]-            Codec.encodeWith recordCodec (Record False $ Just "") @?= Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False, Argo.Member (Argo.Name "text") $ Argo.String ""]+            Codec.encodeWith Argo.codec (Record False Nothing) @?= Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False]+            Codec.encodeWith Argo.codec (Record False $ Just "") @?= Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False, Argo.Member (Argo.Name "text") $ Argo.String ""]         , Tasty.testCase "decode record" $ do-            Codec.decodeWith recordCodec (Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False]) @?= Right (Record False Nothing)-            Codec.decodeWith recordCodec (Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False, Argo.Member (Argo.Name "text") $ Argo.String ""]) @?= Right (Record False $ Just "")+            Codec.decodeWith Argo.codec (Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False]) @?= Right (Record False Nothing)+            Codec.decodeWith Argo.codec (Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False, Argo.Member (Argo.Name "text") $ Argo.String ""]) @?= Right (Record False $ Just "")         ]     , Tasty.testGroup "Pointer"         $ let pointer = Argo.Pointer . fmap Argo.Token in@@ -578,10 +578,10 @@     , recordText :: Maybe Text.Text     } deriving (Eq, Show) -recordCodec :: Codec.ValueCodec Record-recordCodec = Codec.fromObjectCodec Permission.Allow $ Record-    <$> Codec.project recordBool (Codec.required (Argo.Name "bool") Codec.boolCodec)-    <*> Codec.project recordText (Codec.optional (Argo.Name "text") Codec.textCodec)+instance Argo.HasCodec Record where+    codec = Codec.fromObjectCodec Permission.Allow $ Record+        <$> Codec.project recordBool (Codec.required (Argo.Name "bool") Argo.codec)+        <*> Codec.project recordText (Codec.optional (Argo.Name "text") Argo.codec)  property     :: (Show t, Tasty.Testable prop, Tasty.Arbitrary t)