argo 0.2021.11.7 → 0.2021.11.11
raw patch · 37 files changed
+1273/−1095 lines, 37 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Argo: Failure :: String -> Result a
- Argo: Success :: a -> Result a
- Argo: data Result a
- Argo: pattern Member :: Name -> Value -> Member
- Argo: type Array = [Value]
- Argo: type Member = MemberOf Value
- Argo: type Object = [Member]
- Argo.Class.ToValue: digitsToNumber :: [Int] -> Int -> Number
- Argo.Class.ToValue: negateNumber :: Number -> Number
- Argo.Codec: Allow :: Permission
- Argo.Codec: Codec :: r o -> (i -> w o) -> CodecOf r w i o
- Argo.Codec: Forbid :: Permission
- Argo.Codec: [decode] :: CodecOf r w i o -> r o
- Argo.Codec: [encode] :: CodecOf r w i o -> i -> w o
- Argo.Codec: arrayCodec :: ValueCodec (ArrayOf Value)
- Argo.Codec: boolCodec :: ValueCodec Bool
- Argo.Codec: booleanCodec :: ValueCodec Boolean
- Argo.Codec: data CodecOf r w i o
- Argo.Codec: data Permission
- Argo.Codec: decodeWith :: ValueCodec a -> Value -> Result a
- Argo.Codec: detect :: (a -> Bool) -> [a] -> Maybe (a, [a])
- Argo.Codec: detectWith :: ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
- Argo.Codec: dimap :: (Functor r, Functor w) => (a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
- Argo.Codec: eitherCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (Either a b)
- Argo.Codec: element :: ValueCodec a -> ArrayCodec a
- Argo.Codec: encodeWith :: ValueCodec a -> a -> Value
- Argo.Codec: fromArrayCodec :: Permission -> ArrayCodec a -> ValueCodec a
- Argo.Codec: fromListCodec :: ValueCodec [e] -> Permission -> ListCodec e a -> ValueCodec a
- Argo.Codec: fromObjectCodec :: Permission -> ObjectCodec a -> ValueCodec a
- Argo.Codec: instance (GHC.Base.Alternative r, GHC.Base.Alternative w) => GHC.Base.Alternative (Argo.Codec.CodecOf r w i)
- Argo.Codec: instance (GHC.Base.Applicative r, GHC.Base.Applicative w) => GHC.Base.Applicative (Argo.Codec.CodecOf r w i)
- Argo.Codec: instance (GHC.Base.Functor r, GHC.Base.Functor w) => GHC.Base.Functor (Argo.Codec.CodecOf r w i)
- Argo.Codec: instance GHC.Classes.Eq Argo.Codec.Permission
- Argo.Codec: instance GHC.Show.Show Argo.Codec.Permission
- Argo.Codec: literalCodec :: Value -> ValueCodec ()
- Argo.Codec: mapBoth :: (Functor r, Alternative w) => (o2 -> o1) -> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
- Argo.Codec: maybeCodec :: ValueCodec a -> ValueCodec (Maybe a)
- Argo.Codec: nullCodec :: ValueCodec Null
- Argo.Codec: numberCodec :: ValueCodec Number
- Argo.Codec: objectCodec :: ValueCodec (ObjectOf Value)
- Argo.Codec: optional :: Name -> ValueCodec a -> ObjectCodec (Maybe a)
- Argo.Codec: project :: (i -> f) -> CodecOf r w f o -> CodecOf r w i o
- Argo.Codec: required :: Name -> ValueCodec a -> ObjectCodec a
- Argo.Codec: stringCodec :: ValueCodec String
- Argo.Codec: tagged :: String -> ValueCodec a -> ValueCodec a
- Argo.Codec: textCodec :: ValueCodec Text
- Argo.Codec: tupleCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (a, b)
- Argo.Codec: type ArrayCodec a = ListCodec Value a
- Argo.Codec: type Codec r w a = CodecOf r w a a
- Argo.Codec: type ListCodec e a = Codec (StateT [e] (ExceptT String Identity)) (WriterT [e] Identity) a
- Argo.Codec: type ObjectCodec a = ListCodec (MemberOf Value) a
- Argo.Codec: type ValueCodec a = Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) a
- Argo.Codec: valueCodec :: ValueCodec Value
- Argo.Decoder: Decoder :: (ByteString -> Result (ByteString, a)) -> Decoder a
- Argo.Decoder: [run] :: Decoder a -> ByteString -> Result (ByteString, a)
- Argo.Decoder: byteString :: ByteString -> Decoder ()
- Argo.Decoder: dropWhile :: (Word8 -> Bool) -> Decoder ()
- Argo.Decoder: eof :: Decoder ()
- Argo.Decoder: get :: Decoder ByteString
- Argo.Decoder: instance Control.Monad.Fail.MonadFail Argo.Decoder.Decoder
- Argo.Decoder: instance GHC.Base.Alternative Argo.Decoder.Decoder
- Argo.Decoder: instance GHC.Base.Applicative Argo.Decoder.Decoder
- Argo.Decoder: instance GHC.Base.Functor Argo.Decoder.Decoder
- Argo.Decoder: instance GHC.Base.Monad Argo.Decoder.Decoder
- Argo.Decoder: isDigit :: Word8 -> Bool
- Argo.Decoder: isSpace :: Word8 -> Bool
- Argo.Decoder: list :: Decoder a -> Decoder [a]
- Argo.Decoder: listWith :: Decoder a -> [a] -> Decoder [a]
- Argo.Decoder: newtype Decoder a
- Argo.Decoder: put :: ByteString -> Decoder ()
- Argo.Decoder: satisfy :: (Word8 -> Bool) -> Decoder Word8
- Argo.Decoder: spaces :: Decoder ()
- Argo.Decoder: takeWhile :: (Word8 -> Bool) -> Decoder ByteString
- Argo.Decoder: takeWhile1 :: (Word8 -> Bool) -> Decoder ByteString
- Argo.Decoder: word8 :: Word8 -> Decoder ()
- Argo.Encoder: Config :: Indent -> Int -> Config
- Argo.Encoder: Spaces :: Int -> Indent
- Argo.Encoder: Tab :: Indent
- Argo.Encoder: [indent] :: Config -> Indent
- Argo.Encoder: [level] :: Config -> Int
- Argo.Encoder: data Config
- Argo.Encoder: data Indent
- Argo.Encoder: defaultConfig :: Config
- Argo.Encoder: hasIndent :: Config -> Bool
- Argo.Encoder: increaseLevel :: Config -> Config
- Argo.Encoder: instance GHC.Classes.Eq Argo.Encoder.Config
- Argo.Encoder: instance GHC.Classes.Eq Argo.Encoder.Indent
- Argo.Encoder: instance GHC.Show.Show Argo.Encoder.Config
- Argo.Encoder: instance GHC.Show.Show Argo.Encoder.Indent
- Argo.Encoder: list :: Encoder () -> Encoder () -> Encoder () -> (a -> Encoder ()) -> [a] -> Encoder ()
- Argo.Encoder: makeIndent :: Config -> Builder
- Argo.Encoder: run :: Config -> Encoder a -> (a, Builder)
- Argo.Encoder: type Encoder = ReaderT Config (WriterT Builder Identity)
- Argo.Json.Number: data Number
- Argo.Json.Number: factor :: (Num a, Integral b) => b -> a -> b -> (a, b)
- Argo.Json.Number: fromRational :: Rational -> Maybe Number
- Argo.Json.Number: normalize :: Number -> Number
- Argo.Json.Number: number :: Integer -> Integer -> Number
- Argo.Json.Number: toRational :: Number -> Rational
- Argo.Main: Config :: Bool -> Indent -> Bool -> Config
- Argo.Main: FlagHelp :: Flag
- Argo.Main: FlagSpaces :: String -> Flag
- Argo.Main: FlagTab :: Flag
- Argo.Main: FlagVersion :: Flag
- Argo.Main: [configHelp] :: Config -> Bool
- Argo.Main: [configIndent] :: Config -> Indent
- Argo.Main: [configVersion] :: Config -> Bool
- Argo.Main: applyFlag :: Config -> Flag -> Either String Config
- Argo.Main: data Config
- Argo.Main: data Flag
- Argo.Main: defaultConfig :: Config
- Argo.Main: instance GHC.Classes.Eq Argo.Main.Config
- Argo.Main: instance GHC.Classes.Eq Argo.Main.Flag
- Argo.Main: instance GHC.Show.Show Argo.Main.Config
- Argo.Main: instance GHC.Show.Show Argo.Main.Flag
- Argo.Pattern: pattern Member :: Name -> Value -> Member
- Argo.Pattern: type Array = [Value]
- Argo.Pattern: type Member = MemberOf Value
- Argo.Pattern: type Object = [Member]
- Argo.Pointer.Token: unescapeString :: String -> Maybe String
- Argo.Pointer.Token: unescapeText :: Text -> Maybe Text
- Argo.Result: Failure :: String -> Result a
- Argo.Result: Success :: a -> Result a
- Argo.Result: data Result a
- Argo.Result: instance Control.DeepSeq.NFData a => Control.DeepSeq.NFData (Argo.Result.Result a)
- Argo.Result: instance Control.Monad.Fail.MonadFail Argo.Result.Result
- Argo.Result: instance GHC.Base.Alternative Argo.Result.Result
- Argo.Result: instance GHC.Base.Applicative Argo.Result.Result
- Argo.Result: instance GHC.Base.Functor Argo.Result.Result
- Argo.Result: instance GHC.Base.Monad Argo.Result.Result
- Argo.Result: instance GHC.Classes.Eq a => GHC.Classes.Eq (Argo.Result.Result a)
- Argo.Result: instance GHC.Generics.Generic (Argo.Result.Result a)
- Argo.Result: instance GHC.Show.Show a => GHC.Show.Show (Argo.Result.Result a)
- Argo.Result: result :: (String -> b) -> (a -> b) -> Result a -> b
+ Argo: Member :: Name -> value -> MemberOf value
+ Argo: data Decimal
+ Argo: data MemberOf value
+ Argo: pattern Decimal :: Integer -> Integer -> Decimal
+ Argo.Class.ToValue: digitsToDecimal :: [Int] -> Int -> Decimal
+ Argo.Json.Name: instance Data.String.IsString Argo.Json.Name.Name
+ Argo.Json.Number: fromDecimal :: Decimal -> Number
+ Argo.Json.Number: newtype Number
+ Argo.Json.Number: toDecimal :: Number -> Decimal
+ Argo.Json.String: instance Data.String.IsString Argo.Json.String.String
+ Argo.Json.Value: instance Data.String.IsString Argo.Json.Value.Value
+ Argo.Main: getFlags :: [String] -> (([String], [String]), [Flag])
+ Argo.Main: mainWith :: String -> [String] -> IO ()
+ Argo.Main: withSettings :: String -> [Flag] -> (Settings -> IO ()) -> IO ()
+ Argo.Pattern: pattern Decimal :: Integer -> Integer -> Decimal
+ Argo.Pointer.Token: instance Data.String.IsString Argo.Pointer.Token.Token
+ Argo.Pointer.Token: unescape :: ByteString -> Either String ByteString
+ Argo.Pointer.Token: unescapeHelper :: [Word8] -> Either String [Word8]
+ Argo.QuasiQuoter: defaultQuasiQuoter :: QuasiQuoter
+ Argo.Type.Codec: Codec :: r o -> (i -> w o) -> CodecOf r w i o
+ Argo.Type.Codec: [decode] :: CodecOf r w i o -> r o
+ Argo.Type.Codec: [encode] :: CodecOf r w i o -> i -> w o
+ Argo.Type.Codec: arrayCodec :: ValueCodec (ArrayOf Value)
+ Argo.Type.Codec: boolCodec :: ValueCodec Bool
+ Argo.Type.Codec: booleanCodec :: ValueCodec Boolean
+ Argo.Type.Codec: data CodecOf r w i o
+ Argo.Type.Codec: decodeWith :: ValueCodec a -> Value -> Either String a
+ Argo.Type.Codec: detect :: (a -> Bool) -> [a] -> Maybe (a, [a])
+ Argo.Type.Codec: detectWith :: ([a] -> [a]) -> (a -> Bool) -> [a] -> Maybe (a, [a])
+ Argo.Type.Codec: dimap :: (Functor r, Functor w) => (a -> b) -> (b -> a) -> Codec r w a -> Codec r w b
+ Argo.Type.Codec: eitherCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (Either a b)
+ Argo.Type.Codec: element :: ValueCodec a -> ArrayCodec a
+ Argo.Type.Codec: encodeWith :: ValueCodec a -> a -> Value
+ Argo.Type.Codec: fromArrayCodec :: Permission -> ArrayCodec a -> ValueCodec a
+ Argo.Type.Codec: fromListCodec :: ValueCodec [e] -> Permission -> ListCodec e a -> ValueCodec a
+ Argo.Type.Codec: fromObjectCodec :: Permission -> ObjectCodec a -> ValueCodec a
+ Argo.Type.Codec: instance (GHC.Base.Alternative r, GHC.Base.Alternative w) => GHC.Base.Alternative (Argo.Type.Codec.CodecOf r w i)
+ Argo.Type.Codec: instance (GHC.Base.Applicative r, GHC.Base.Applicative w) => GHC.Base.Applicative (Argo.Type.Codec.CodecOf r w i)
+ Argo.Type.Codec: instance (GHC.Base.Functor r, GHC.Base.Functor w) => GHC.Base.Functor (Argo.Type.Codec.CodecOf r w i)
+ Argo.Type.Codec: literalCodec :: Value -> ValueCodec ()
+ Argo.Type.Codec: mapBoth :: (Functor r, Alternative w) => (o2 -> o1) -> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1
+ Argo.Type.Codec: maybeCodec :: ValueCodec a -> ValueCodec (Maybe a)
+ Argo.Type.Codec: nullCodec :: ValueCodec Null
+ Argo.Type.Codec: numberCodec :: ValueCodec Number
+ Argo.Type.Codec: objectCodec :: ValueCodec (ObjectOf Value)
+ Argo.Type.Codec: optional :: Name -> ValueCodec a -> ObjectCodec (Maybe a)
+ Argo.Type.Codec: project :: (i -> f) -> CodecOf r w f o -> CodecOf r w i o
+ Argo.Type.Codec: required :: Name -> ValueCodec a -> ObjectCodec a
+ Argo.Type.Codec: stringCodec :: ValueCodec String
+ Argo.Type.Codec: tagged :: String -> ValueCodec a -> ValueCodec a
+ Argo.Type.Codec: textCodec :: ValueCodec Text
+ Argo.Type.Codec: tupleCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (a, b)
+ Argo.Type.Codec: type ArrayCodec a = ListCodec Value a
+ Argo.Type.Codec: type Codec r w a = CodecOf r w a a
+ Argo.Type.Codec: type ListCodec e a = Codec (StateT [e] (ExceptT String Identity)) (WriterT [e] Identity) a
+ Argo.Type.Codec: type ObjectCodec a = ListCodec (MemberOf Value) a
+ Argo.Type.Codec: type ValueCodec a = Codec (ReaderT Value (ExceptT String Identity)) (MaybeT (StateT Value Identity)) a
+ Argo.Type.Codec: valueCodec :: ValueCodec Value
+ Argo.Type.Config: Config :: Indent -> Int -> Config
+ Argo.Type.Config: [indent] :: Config -> Indent
+ Argo.Type.Config: [level] :: Config -> Int
+ Argo.Type.Config: data Config
+ Argo.Type.Config: hasIndent :: Config -> Bool
+ Argo.Type.Config: increaseLevel :: Config -> Config
+ Argo.Type.Config: initial :: Config
+ Argo.Type.Config: instance GHC.Classes.Eq Argo.Type.Config.Config
+ Argo.Type.Config: instance GHC.Show.Show Argo.Type.Config.Config
+ Argo.Type.Decimal: Decimal :: Integer -> Integer -> Decimal
+ Argo.Type.Decimal: data Decimal
+ Argo.Type.Decimal: decimal :: Integer -> Integer -> Decimal
+ Argo.Type.Decimal: factor :: (Num a, Integral b) => b -> a -> b -> (a, b)
+ Argo.Type.Decimal: fromRational :: Rational -> Maybe Decimal
+ Argo.Type.Decimal: instance Control.DeepSeq.NFData Argo.Type.Decimal.Decimal
+ Argo.Type.Decimal: instance GHC.Classes.Eq Argo.Type.Decimal.Decimal
+ Argo.Type.Decimal: instance GHC.Generics.Generic Argo.Type.Decimal.Decimal
+ Argo.Type.Decimal: instance GHC.Show.Show Argo.Type.Decimal.Decimal
+ Argo.Type.Decimal: instance Language.Haskell.TH.Syntax.Lift Argo.Type.Decimal.Decimal
+ Argo.Type.Decimal: negate :: Decimal -> Decimal
+ Argo.Type.Decimal: normalize :: Decimal -> Decimal
+ Argo.Type.Decimal: toRational :: Decimal -> Rational
+ Argo.Type.Decoder: byteString :: ByteString -> Decoder ()
+ Argo.Type.Decoder: dropWhile :: (Word8 -> Bool) -> Decoder ()
+ Argo.Type.Decoder: eof :: Decoder ()
+ Argo.Type.Decoder: isDigit :: Word8 -> Bool
+ Argo.Type.Decoder: isSpace :: Word8 -> Bool
+ Argo.Type.Decoder: list :: Decoder a -> Decoder [a]
+ Argo.Type.Decoder: listWith :: Decoder a -> [a] -> Decoder [a]
+ Argo.Type.Decoder: run :: Decoder a -> ByteString -> Either String a
+ Argo.Type.Decoder: satisfy :: (Word8 -> Bool) -> Decoder Word8
+ Argo.Type.Decoder: spaces :: Decoder ()
+ Argo.Type.Decoder: takeWhile :: (Word8 -> Bool) -> Decoder ByteString
+ Argo.Type.Decoder: takeWhile1 :: (Word8 -> Bool) -> Decoder ByteString
+ Argo.Type.Decoder: type Decoder = StateT ByteString (ExceptT String Identity)
+ Argo.Type.Decoder: unwrap :: Decoder a -> ByteString -> Either String (a, ByteString)
+ Argo.Type.Decoder: word8 :: Word8 -> Decoder ()
+ Argo.Type.Encoder: list :: Encoder () -> Encoder () -> Encoder () -> (a -> Encoder ()) -> [a] -> Encoder ()
+ Argo.Type.Encoder: makeIndent :: Config -> Maybe Builder
+ Argo.Type.Encoder: run :: Config -> Encoder a -> Builder
+ Argo.Type.Encoder: type Encoder = ReaderT Config (WriterT Builder Identity)
+ Argo.Type.Encoder: unwrap :: Config -> Encoder a -> (a, Builder)
+ Argo.Type.Encoder: withNewLine :: Maybe Builder -> Encoder ()
+ Argo.Type.Flag: Help :: Flag
+ Argo.Type.Flag: Spaces :: String -> Flag
+ Argo.Type.Flag: Tab :: Flag
+ Argo.Type.Flag: Version :: Flag
+ Argo.Type.Flag: data Flag
+ Argo.Type.Flag: instance GHC.Classes.Eq Argo.Type.Flag.Flag
+ Argo.Type.Flag: instance GHC.Show.Show Argo.Type.Flag.Flag
+ Argo.Type.Indent: Spaces :: Int -> Indent
+ Argo.Type.Indent: Tab :: Indent
+ Argo.Type.Indent: data Indent
+ Argo.Type.Indent: instance GHC.Classes.Eq Argo.Type.Indent.Indent
+ Argo.Type.Indent: instance GHC.Show.Show Argo.Type.Indent.Indent
+ Argo.Type.Permission: Allow :: Permission
+ Argo.Type.Permission: Forbid :: Permission
+ Argo.Type.Permission: data Permission
+ Argo.Type.Permission: instance GHC.Classes.Eq Argo.Type.Permission.Permission
+ Argo.Type.Permission: instance GHC.Show.Show Argo.Type.Permission.Permission
+ Argo.Type.Settings: Settings :: Bool -> Indent -> Bool -> Settings
+ Argo.Type.Settings: [help] :: Settings -> Bool
+ Argo.Type.Settings: [indent] :: Settings -> Indent
+ Argo.Type.Settings: [version] :: Settings -> Bool
+ Argo.Type.Settings: applyFlag :: Settings -> Flag -> Either String Settings
+ Argo.Type.Settings: data Settings
+ Argo.Type.Settings: initial :: Settings
+ Argo.Type.Settings: instance GHC.Classes.Eq Argo.Type.Settings.Settings
+ Argo.Type.Settings: instance GHC.Show.Show Argo.Type.Settings.Settings
- Argo: decode :: FromValue a => ByteString -> Result a
+ Argo: decode :: FromValue a => ByteString -> Either String a
- Argo: decodePointer :: ByteString -> Result Pointer
+ Argo: decodePointer :: ByteString -> Either String Pointer
- Argo: evaluate :: Pointer -> Value -> Result Value
+ Argo: evaluate :: Pointer -> Value -> Either String Value
- Argo: fromValue :: FromValue a => Value -> Result a
+ Argo: fromValue :: FromValue a => Value -> Either String a
- Argo: pattern Array :: Array -> Value
+ Argo: pattern Array :: [Value] -> Value
- Argo: pattern Number :: Integer -> Integer -> Value
+ Argo: pattern Number :: Decimal -> Value
- Argo: pattern Object :: Object -> Value
+ Argo: pattern Object :: [MemberOf Value] -> Value
- Argo.Class.FromValue: fromValue :: FromValue a => Value -> Result a
+ Argo.Class.FromValue: fromValue :: FromValue a => Value -> Either String a
- Argo.Class.FromValue: viaInteger :: (Integral a, Bits a) => Value -> Result a
+ Argo.Class.FromValue: viaInteger :: (Integral a, Bits a) => Value -> Either String a
- Argo.Class.FromValue: withArray :: String -> (Array -> Result a) -> Value -> Result a
+ Argo.Class.FromValue: withArray :: String -> ([Value] -> Either String a) -> Value -> Either String a
- Argo.Class.FromValue: withBoolean :: String -> (Bool -> Result a) -> Value -> Result a
+ Argo.Class.FromValue: withBoolean :: String -> (Bool -> Either String a) -> Value -> Either String a
- Argo.Class.FromValue: withNumber :: String -> (Integer -> Integer -> Result a) -> Value -> Result a
+ Argo.Class.FromValue: withNumber :: String -> (Decimal -> Either String a) -> Value -> Either String a
- Argo.Class.FromValue: withObject :: String -> (Object -> Result a) -> Value -> Result a
+ Argo.Class.FromValue: withObject :: String -> ([MemberOf Value] -> Either String a) -> Value -> Either String a
- Argo.Class.FromValue: withString :: String -> (Text -> Result a) -> Value -> Result a
+ Argo.Class.FromValue: withString :: String -> (Text -> Either String a) -> Value -> Either String a
- Argo.Decode: decode :: FromValue a => ByteString -> Result a
+ Argo.Decode: decode :: FromValue a => ByteString -> Either String a
- Argo.Decode: decodePointer :: ByteString -> Result Pointer
+ Argo.Decode: decodePointer :: ByteString -> Either String Pointer
- Argo.Json.Number: Number :: Integer -> Integer -> Number
+ Argo.Json.Number: Number :: Decimal -> Number
- Argo.Json.String: unescapeString :: String -> Maybe String
+ Argo.Json.String: unescapeString :: String -> Either String String
- Argo.Json.String: unescapeText :: Text -> Maybe Text
+ Argo.Json.String: unescapeText :: Text -> Either String Text
- Argo.Pattern: pattern Array :: Array -> Value
+ Argo.Pattern: pattern Array :: [Value] -> Value
- Argo.Pattern: pattern Number :: Integer -> Integer -> Value
+ Argo.Pattern: pattern Number :: Decimal -> Value
- Argo.Pattern: pattern Object :: Object -> Value
+ Argo.Pattern: pattern Object :: [MemberOf Value] -> Value
- Argo.Pointer.Pointer: atIndex :: Token -> ArrayOf value -> Result value
+ Argo.Pointer.Pointer: atIndex :: Token -> ArrayOf value -> Either String value
- Argo.Pointer.Pointer: atKey :: Token -> ObjectOf value -> Result value
+ Argo.Pointer.Pointer: atKey :: Token -> ObjectOf value -> Either String value
- Argo.Pointer.Pointer: evaluate :: Pointer -> Value -> Result Value
+ Argo.Pointer.Pointer: evaluate :: Pointer -> Value -> Either String Value
- Argo.Pointer.Pointer: tokenToIndex :: Token -> Result Int
+ Argo.Pointer.Pointer: tokenToIndex :: Token -> Either String Int
Files
- argo.cabal +12/−6
- source/benchmark/Main.hs +2/−2
- source/library/Argo.hs +10/−13
- source/library/Argo/Class/FromValue.hs +51/−40
- source/library/Argo/Class/ToValue.hs +32/−27
- source/library/Argo/Codec.hs +0/−303
- source/library/Argo/Decode.hs +5/−8
- source/library/Argo/Decoder.hs +0/−114
- source/library/Argo/Encode.hs +14/−13
- source/library/Argo/Encoder.hs +0/−66
- source/library/Argo/Json/Array.hs +10/−8
- source/library/Argo/Json/Boolean.hs +9/−8
- source/library/Argo/Json/Member.hs +13/−9
- source/library/Argo/Json/Name.hs +6/−2
- source/library/Argo/Json/Null.hs +2/−2
- source/library/Argo/Json/Number.hs +45/−62
- source/library/Argo/Json/Object.hs +16/−10
- source/library/Argo/Json/String.hs +73/−43
- source/library/Argo/Json/Value.hs +12/−8
- source/library/Argo/Main.hs +58/−53
- source/library/Argo/Pattern.hs +11/−16
- source/library/Argo/Pointer/Pointer.hs +21/−19
- source/library/Argo/Pointer/Token.hs +34/−29
- source/library/Argo/QuasiQuoter.hs +20/−11
- source/library/Argo/Result.hs +0/−44
- source/library/Argo/Type/Codec.hs +344/−0
- source/library/Argo/Type/Config.hs +20/−0
- source/library/Argo/Type/Decimal.hs +50/−0
- source/library/Argo/Type/Decoder.hs +92/−0
- source/library/Argo/Type/Encoder.hs +61/−0
- source/library/Argo/Type/Flag.hs +8/−0
- source/library/Argo/Type/Indent.hs +6/−0
- source/library/Argo/Type/Permission.hs +6/−0
- source/library/Argo/Type/Settings.hs +24/−0
- source/library/Argo/Vendor/ByteString.hs +1/−0
- source/test-suite/Argo/Orphanage.hs +67/−0
- source/test-suite/Main.hs +138/−179
argo.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2 name: argo-version: 0.2021.11.7+version: 0.2021.11.11 build-type: Simple category: JSON@@ -69,11 +69,8 @@ Argo Argo.Class.FromValue Argo.Class.ToValue- Argo.Codec Argo.Decode- Argo.Decoder Argo.Encode- Argo.Encoder Argo.Json.Array Argo.Json.Boolean Argo.Json.Member@@ -89,11 +86,19 @@ Argo.Pointer.Pointer Argo.Pointer.Token Argo.QuasiQuoter- Argo.Result+ Argo.Type.Codec+ Argo.Type.Config+ Argo.Type.Decimal+ Argo.Type.Decoder+ Argo.Type.Encoder+ Argo.Type.Flag+ Argo.Type.Indent+ Argo.Type.Permission+ Argo.Type.Settings hs-source-dirs: source/library other-modules:- Argo.Vendor.ByteString Argo.Vendor.Builder+ Argo.Vendor.ByteString Argo.Vendor.DeepSeq Argo.Vendor.TemplateHaskell Argo.Vendor.Text@@ -115,6 +120,7 @@ , tasty-quickcheck >= 0.10.1 && < 0.11 hs-source-dirs: source/test-suite main-is: Main.hs+ other-modules: Argo.Orphanage type: exitcode-stdio-1.0 benchmark argo-benchmark
source/benchmark/Main.hs view
@@ -17,7 +17,7 @@ [ Tasty.bench "false" . Tasty.nf encode $ Argo.Boolean False ] , Tasty.bgroup "Number"- [ Tasty.bench "zero" . Tasty.nf encode $ Argo.Number 0 0+ [ Tasty.bench "zero" . Tasty.nf encode . Argo.Number $ Argo.Decimal 0 0 ] , Tasty.bgroup "String" [ Tasty.bench "empty" . Tasty.nf encode $ Argo.String ""@@ -44,7 +44,7 @@ , Tasty.bench "10000 elements" . Tasty.nf encode . Argo.Object . replicate 10000 $ Argo.Member (Argo.Name "") Argo.Null ] ]- , Tasty.bgroup "decode" $ let decode = Argo.decode :: ByteString.ByteString -> Argo.Result Argo.Value in+ , Tasty.bgroup "decode" $ let decode = Argo.decode :: ByteString.ByteString -> Either String Argo.Value in [ Tasty.bgroup "Null" [ Tasty.bench "null" $ Tasty.nf decode "null" ]
source/library/Argo.hs view
@@ -9,37 +9,34 @@ , Pattern.Array , Pattern.Object )- , Pattern.Array- , Name.Name- , pattern Pattern.Name- , Pattern.Member- , pattern Pattern.Member- , Pattern.Object+ , Name.Name(Pattern.Name)+ , Member.MemberOf(Member) , Encode.encode , Encode.encodeWith- , Encoder.Indent(Spaces, Tab)+ , Indent.Indent(Spaces, Tab) , Decode.decode , FromValue.FromValue(fromValue) , ToValue.ToValue(toValue) , QuasiQuoter.value , QuasiQuoter.pointer- , Result.Result(Failure, Success)- , Pointer.Pointer(Pointer.Pointer)- , Token.Token(Token.Token)+ , Pointer.Pointer(Pointer)+ , Token.Token(Token) , Pointer.evaluate , Encode.encodePointer , Decode.decodePointer+ , Decimal.Decimal(Pattern.Decimal) ) where import qualified Argo.Class.FromValue as FromValue import qualified Argo.Class.ToValue as ToValue import qualified Argo.Decode as Decode import qualified Argo.Encode as Encode-import qualified Argo.Encoder as Encoder+import qualified Argo.Json.Member as Member import qualified Argo.Json.Name as Name import qualified Argo.Json.Value as Value+import qualified Argo.Pattern as Pattern import qualified Argo.Pointer.Pointer as Pointer import qualified Argo.Pointer.Token as Token-import qualified Argo.Pattern as Pattern import qualified Argo.QuasiQuoter as QuasiQuoter-import qualified Argo.Result as Result+import qualified Argo.Type.Decimal as Decimal+import qualified Argo.Type.Indent as Indent
source/library/Argo/Class/FromValue.hs view
@@ -2,12 +2,12 @@ module Argo.Class.FromValue where -import qualified Argo.Decoder as Decoder-import qualified Argo.Json.Number as Number+import qualified Argo.Json.Member as Member import qualified Argo.Json.Value as Value import qualified Argo.Pattern as Pattern import qualified Argo.Pointer.Pointer as Pointer-import qualified Argo.Result as Result+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@@ -16,18 +16,18 @@ import qualified Data.Word as Word class FromValue a where- fromValue :: Value.Value -> Result.Result a+ fromValue :: Value.Value -> Either String a instance FromValue Value.Value where- fromValue = Result.Success+ fromValue = Right instance FromValue Bool where fromValue = withBoolean "Bool" pure instance FromValue Char where- fromValue = withString "Char" $ \ x -> case Text.uncons x of+ fromValue = withString "Char" $ \x -> case Text.uncons x of Just (y, z) | Text.null z -> pure y- _ -> fail $ "expected single character but got " <> show x+ _ -> Left $ "expected single character but got " <> show x instance FromValue Int where fromValue = viaInteger@@ -60,18 +60,15 @@ fromValue = viaInteger instance FromValue Integer where- fromValue = withNumber "Integer" $ \ x y ->- if y < 0- then fail $ "expected integer but got " <> show (Pattern.Number x y)- else pure $ x * 10 ^ y+ 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" $ \ x y ->- pure . fromRational . Number.toRational $ Number.Number x y+ fromValue = withNumber "Float" $ pure . fromRational . Decimal.toRational instance FromValue Double where- fromValue = withNumber "Double" $ \ x y ->- pure . fromRational . Number.toRational $ Number.Number x y+ fromValue = withNumber "Double" $ pure . fromRational . Decimal.toRational instance {-# OVERLAPPING #-} FromValue String where fromValue = fmap Text.unpack . fromValue@@ -88,14 +85,14 @@ _ -> Just <$> fromValue x instance FromValue () where- fromValue = withArray "()" $ \ xs -> case xs of+ fromValue = withArray "()" $ \xs -> case xs of [] -> pure ()- _ -> fail $ "expected empty list but got " <> show xs+ _ -> 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+ fromValue = withArray "(a, b)" $ \xs -> case xs of [x, y] -> (,) <$> fromValue x <*> fromValue y- _ -> fail $ "expected tuple but got " <> show xs+ _ -> Left $ "expected tuple but got " <> show xs instance FromValue a => FromValue [a] where fromValue = withArray "[a]" $ traverse fromValue@@ -104,48 +101,62 @@ fromValue value = do list <- fromValue value case NonEmpty.nonEmpty list of- Nothing -> fail "unexpected empty list"+ 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 (\ (Pattern.Member (Pattern.Name k) v) -> (,) k <$> fromValue v)+ fromValue = withObject "Map" $ fmap Map.fromList . traverse+ (\(Member.Member (Pattern.Name k) v) -> (,) k <$> fromValue v) instance FromValue Pointer.Pointer where- fromValue = withString "Pointer"- $ fmap snd- . Decoder.run (Pointer.decode <* Decoder.eof)- . Text.encodeUtf8+ fromValue =+ withString "Pointer" $ Decoder.run Pointer.decode . Text.encodeUtf8 -withBoolean :: String -> (Bool -> Result.Result a) -> Value.Value -> Result.Result a+withBoolean+ :: String -> (Bool -> Either String a) -> Value.Value -> Either String a withBoolean s f x = case x of Pattern.Boolean y -> f y- _ -> fail $ "expected " <> s <> " but got " <> show x+ _ -> Left $ "expected " <> s <> " but got " <> show x -withNumber :: String -> (Integer -> Integer -> Result.Result a) -> Value.Value -> Result.Result a+withNumber+ :: String+ -> (Decimal.Decimal -> Either String a)+ -> Value.Value+ -> Either String a withNumber s f x = case x of- Pattern.Number y z -> f y z- _ -> fail $ "expected " <> s <> " but got " <> show x+ Pattern.Number y -> f y+ _ -> Left $ "expected " <> s <> " but got " <> show x -withString :: String -> (Text.Text -> Result.Result a) -> Value.Value -> Result.Result a+withString+ :: String+ -> (Text.Text -> Either String a)+ -> Value.Value+ -> Either String a withString s f x = case x of Pattern.String y -> f y- _ -> fail $ "expected " <> s <> " but got " <> show x+ _ -> Left $ "expected " <> s <> " but got " <> show x -withArray :: String -> (Pattern.Array -> Result.Result a) -> Value.Value -> Result.Result a+withArray+ :: String+ -> ([Value.Value] -> Either String a)+ -> Value.Value+ -> Either String a withArray s f x = case x of Pattern.Array y -> f y- _ -> fail $ "expected " <> s <> " but got " <> show x+ _ -> Left $ "expected " <> s <> " but got " <> show x -withObject :: String -> (Pattern.Object -> Result.Result a) -> Value.Value -> Result.Result a+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- _ -> fail $ "expected " <> s <> " but got " <> show x+ _ -> Left $ "expected " <> s <> " but got " <> show x -viaInteger :: (Integral a, Bits.Bits a) => Value.Value -> Result.Result a+viaInteger :: (Integral a, Bits.Bits a) => Value.Value -> Either String a viaInteger value = do integer <- fromValue value case Bits.toIntegralSized (integer :: Integer) of- Nothing -> fail $ "integer out of bounds " <> show integer+ Nothing -> Left $ "integer out of bounds " <> show integer Just x -> pure x
source/library/Argo/Class/ToValue.hs view
@@ -2,11 +2,14 @@ module Argo.Class.ToValue where -import qualified Argo.Encoder as Encoder+import qualified Argo.Json.Member as Member import qualified Argo.Json.Number as Number 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@@ -60,7 +63,7 @@ toValue = toValue . toInteger instance ToValue Integer where- toValue = flip Pattern.Number 0+ toValue x = Pattern.Number $ Decimal.decimal x 0 instance ToValue Float where toValue = realFloatToValue@@ -93,36 +96,38 @@ toValue = toValue . NonEmpty.toList instance ToValue a => ToValue (Map.Map Text.Text a) where- toValue x = Pattern.Object- . fmap (\ (k, v) -> Pattern.Member (Pattern.Name k) (toValue v))- $ Map.toAscList x+ 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- . snd- . Encoder.run Encoder.defaultConfig- . Pointer.encode+ 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- . (if isNegative then negateNumber else id)- . uncurry digitsToNumber- . Numeric.floatToDigits 10- $ abs x--negateNumber :: Number.Number -> Number.Number-negateNumber (Number.Number x y) = Number.Number (-x) y+ | 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 -digitsToNumber :: [Int] -> Int -> Number.Number-digitsToNumber ds e = uncurry Number.number $ List.foldl'- (\ (a, n) d -> (a * 10 + toInteger d, n - 1))+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
− source/library/Argo/Codec.hs
@@ -1,303 +0,0 @@-module Argo.Codec 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.Result as Result-import qualified Argo.Vendor.Transformers as Trans-import qualified Control.Applicative as Applicative-import qualified Control.Monad as Monad-import qualified Data.Functor.Identity as Identity-import qualified Data.Text as Text--decodeWith :: ValueCodec a -> Value.Value -> Result.Result a-decodeWith c = either fail pure- . Identity.runIdentity- . Trans.runExceptT- . Trans.runReaderT (decode c)--encodeWith :: ValueCodec a -> a -> Value.Value-encodeWith c x = snd- . Identity.runIdentity- . Trans.runStateT (Trans.runMaybeT $ encode c x)- . Value.Null- $ Null.fromUnit ()--project :: (i -> f) -> CodecOf r w f o -> CodecOf r w i o-project f c = c { encode = encode c . f }--data CodecOf r w i o = Codec- { decode :: r o- , encode :: i -> w o- }--instance (Functor r, Functor w) => Functor (CodecOf r w i) where- fmap f c = Codec- { decode = fmap f $ decode c- , encode = fmap f . encode c- }--instance (Applicative r, Applicative w) => Applicative (CodecOf r w i) where- pure x = Codec- { decode = pure x- , encode = const $ pure x- }- cf <*> cx = Codec- { decode = decode cf <*> decode cx- , encode = \ i -> encode cf i <*> encode cx i- }--instance (Applicative.Alternative r, Applicative.Alternative w) => Applicative.Alternative (CodecOf r w i) where- empty = Codec- { decode = Applicative.empty- , encode = const Applicative.empty- }- cx <|> cy = Codec- { decode = decode cx <|> decode cy- , encode = \ i -> encode cx i <|> encode cy i- }--type Codec r w a = CodecOf r w a a--dimap :: (Functor r, Functor w) => (a -> b) -> (b -> a) -> Codec r w a -> Codec r w b-dimap f g c = Codec- { decode = fmap f $ decode c- , encode = fmap f . encode c . g- }--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- x <- Trans.ask- case x of- Value.Array y -> pure y- _ -> Trans.lift . Trans.throwE $ "expected Array but got " <> show x- , encode = \ x -> do- Trans.lift . Trans.put $ Value.Array x- pure x- }--objectCodec :: ValueCodec (Object.ObjectOf Value.Value)-objectCodec = Codec- { decode = do- x <- Trans.ask- case x of- Value.Object y -> pure y- _ -> Trans.lift . Trans.throwE $ "expected Object but got " <> show x- , encode = \ x -> do- Trans.lift . Trans.put $ Value.Object x- 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) -> (i1 -> Maybe i2) -> CodecOf r w i2 o2 -> CodecOf r w i1 o1-mapBoth f g c = Codec- { decode = fmap f $ decode c- , encode = \ x -> case g x of- Nothing -> Applicative.empty- Just y -> fmap f $ encode c y- }--tagged :: String -> ValueCodec a -> ValueCodec a-tagged t c = dimap snd ((,) ()) . fromObjectCodec Allow $ (,)- <$> project fst (required (Name.fromString . String.fromText $ Text.pack "type") (literalCodec (Value.String . String.fromText $ Text.pack t)))- <*> project snd (required (Name.fromString . String.fromText $ Text.pack "value") c)--literalCodec :: Value.Value -> ValueCodec ()-literalCodec expected = Codec- { decode = do- actual <- Trans.ask- Monad.when (actual /= expected)- . Trans.lift- . Trans.throwE- $ "expected " <> show expected <> " but got " <> show actual- , encode = const . Trans.lift $ Trans.put expected- }--data Permission- = Allow- | Forbid- deriving (Eq, Show)--type ListCodec e a = Codec- (Trans.StateT [e] (Trans.ExceptT String Identity.Identity))- (Trans.WriterT [e] Identity.Identity)- a--fromListCodec :: ValueCodec [e] -> Permission -> ListCodec e a -> ValueCodec a-fromListCodec ce p ca = Codec- { decode = do- xs <- decode ce- case Identity.runIdentity . Trans.runExceptT $ Trans.runStateT (decode ca) xs of- Left x -> Trans.lift $ Trans.throwE x- Right (x, ys) -> do- case (p, ys) of- (Forbid, _ : _) -> Trans.lift $ Trans.throwE "leftover elements"- _ -> pure ()- pure x- , encode = \ x -> do- Monad.void- . encode ce- . snd- . Identity.runIdentity- . Trans.runWriterT- $ encode ca x- pure x- }--type ArrayCodec a = ListCodec Value.Value a--fromArrayCodec :: Permission -> ArrayCodec a -> ValueCodec a-fromArrayCodec = fromListCodec $ dimap Array.toList Array.fromList arrayCodec--element :: ValueCodec a -> ArrayCodec a-element c = Codec- { decode = do- l <- Trans.get- case l of- [] -> Trans.lift $ Trans.throwE "unexpected empty list"- h : t -> case decodeWith c h of- Result.Failure y -> Trans.lift $ Trans.throwE y- Result.Success y -> do- Trans.put t- pure y- , encode = \ x -> do- Trans.tell [encodeWith c x]- pure x- }--tupleCodec :: ValueCodec a -> ValueCodec b -> ValueCodec (a, b)-tupleCodec cx cy = fromArrayCodec Forbid $ (,)- <$> project fst (element cx)- <*> project snd (element cy)--type ObjectCodec a = ListCodec (Member.MemberOf Value.Value) a--fromObjectCodec :: Permission -> ObjectCodec a -> ValueCodec a-fromObjectCodec = fromListCodec $ dimap Object.toList Object.fromList objectCodec--required :: Name.Name -> ValueCodec a -> ObjectCodec a-required k c = Codec- { decode = do- m <- decode (optional k c)- case m of- Nothing -> Trans.lift . Trans.throwE $ "missing required member: " <> show k- Just x -> pure x- , encode = \ x -> do- Monad.void . encode (optional k c) $ Just x- pure x- }--optional :: Name.Name -> ValueCodec a -> ObjectCodec (Maybe a)-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- Result.Failure y -> Trans.lift $ Trans.throwE y- Result.Success y -> do- Trans.put ys- pure $ Just y- , 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
source/library/Argo/Decode.hs view
@@ -1,18 +1,15 @@ module Argo.Decode where import qualified Argo.Class.FromValue as FromValue-import qualified Argo.Decoder as Decoder import qualified Argo.Json.Value as Value import qualified Argo.Pointer.Pointer as Pointer-import qualified Argo.Result as Result+import qualified Argo.Type.Decoder as Decoder import qualified Argo.Vendor.ByteString as ByteString -decode :: FromValue.FromValue a => ByteString.ByteString -> Result.Result a+decode :: FromValue.FromValue a => ByteString.ByteString -> Either String a decode x = do- (_, y) <- Decoder.run (Decoder.spaces *> Value.decode <* Decoder.eof) x+ y <- Decoder.run (Decoder.spaces *> Value.decode) x FromValue.fromValue y -decodePointer :: ByteString.ByteString -> Result.Result Pointer.Pointer-decodePointer =- let d = Pointer.decode <* Decoder.eof- in fmap snd . Decoder.run d+decodePointer :: ByteString.ByteString -> Either String Pointer.Pointer+decodePointer = Decoder.run Pointer.decode
− source/library/Argo/Decoder.hs
@@ -1,114 +0,0 @@-module Argo.Decoder where--import qualified Argo.Literal as Literal-import qualified Argo.Result as Result-import qualified Argo.Vendor.ByteString as ByteString-import qualified Control.Applicative as Applicative-import qualified Control.Monad as Monad-import qualified Data.Word as Word--newtype Decoder a = Decoder- { run :: ByteString.ByteString -> Result.Result (ByteString.ByteString, a)- }--instance Functor Decoder where- fmap f d = Decoder $ \ b1 -> case run d b1 of- Result.Failure e -> Result.Failure e- Result.Success (b2, x) -> Result.Success (b2, f x)--instance Applicative Decoder where- pure x = Decoder $ \ b -> Result.Success (b, x)- df <*> dx = Decoder $ \ b1 -> case run df b1 of- Result.Failure e -> Result.Failure e- Result.Success (b2, f) -> case run dx b2 of- Result.Failure e -> Result.Failure e- Result.Success (b3, x) -> Result.Success (b3, f x)--instance Monad Decoder where- d >>= f = Decoder $ \ b1 -> case run d b1 of- Result.Failure e -> Result.Failure e- Result.Success (b2, x) -> run (f x) b2--instance MonadFail Decoder where- fail = Decoder . const . Result.Failure--instance Applicative.Alternative Decoder where- empty = fail "empty"- dx <|> dy = Decoder $ \ b1 -> case run dx b1 of- Result.Failure _ -> run dy b1- Result.Success (b2, x) -> Result.Success (b2, x)--list :: Decoder a -> Decoder [a]-list f = listWith f []--listWith :: Decoder a -> [a] -> Decoder [a]-listWith f xs = do- m <- Applicative.optional $ do- Monad.unless (null xs) $ do- word8 Literal.comma- spaces- f- case m of- Nothing -> pure $ reverse xs- Just x -> listWith f $ 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 -> Result.Success (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 $ \ _ -> Result.Success (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/Encode.hs view
@@ -1,28 +1,29 @@ module Argo.Encode where import qualified Argo.Class.ToValue as ToValue-import qualified Argo.Encoder as Encoder import qualified Argo.Json.Value as Value import qualified Argo.Literal as Literal import qualified Argo.Pointer.Pointer as Pointer+import qualified Argo.Type.Config as Config+import qualified Argo.Type.Encoder as Encoder+import qualified Argo.Type.Indent as Indent import qualified Argo.Vendor.Builder as Builder import qualified Argo.Vendor.Transformers as Trans import qualified Control.Monad as Monad encode :: ToValue.ToValue a => a -> Builder.Builder-encode = encodeWith $ Encoder.Spaces 0+encode = encodeWith $ Indent.Spaces 0 -encodeWith :: ToValue.ToValue a => Encoder.Indent -> a -> Builder.Builder+encodeWith :: ToValue.ToValue a => Indent.Indent -> a -> Builder.Builder encodeWith i x =- let c = Encoder.defaultConfig { Encoder.indent = i }- in snd . Encoder.run c $ do- Value.encode $ ToValue.toValue x- Monad.when (Encoder.hasIndent c)- . Trans.lift- . Trans.tell- $ Builder.word8 Literal.newLine+ let c = Config.initial { Config.indent = i }+ in+ Encoder.run c $ do+ Value.encode $ ToValue.toValue x+ Monad.when (Config.hasIndent c)+ . Trans.lift+ . Trans.tell+ $ Builder.word8 Literal.newLine encodePointer :: Pointer.Pointer -> Builder.Builder-encodePointer =- let c = Encoder.defaultConfig- in snd . Encoder.run c . Pointer.encode+encodePointer = Encoder.run Config.initial . Pointer.encode
− source/library/Argo/Encoder.hs
@@ -1,66 +0,0 @@-module Argo.Encoder where--import qualified Argo.Literal as Literal-import qualified Argo.Vendor.Builder as Builder-import qualified Argo.Vendor.Transformers as Trans-import qualified Control.Monad as Monad-import qualified Data.Functor.Identity as Identity-import qualified Data.Semigroup as Semigroup--type Encoder = Trans.ReaderT Config (Trans.WriterT Builder.Builder Identity.Identity)--run :: Config -> Encoder a -> (a, Builder.Builder)-run c = Identity.runIdentity . Trans.runWriterT . flip Trans.runReaderT c--data Config = Config- { indent :: Indent- , level :: Int- } deriving (Eq, Show)--defaultConfig :: Config-defaultConfig = Config- { indent = Spaces 0- , level = 0- }--data Indent- = Spaces Int- | Tab- deriving (Eq, Show)--hasIndent :: Config -> Bool-hasIndent x = case indent x of- Spaces y -> y > 0- Tab -> True--increaseLevel :: Config -> Config-increaseLevel x = x { level = level x + 1 }--list :: Encoder () -> Encoder () -> Encoder () -> (a -> Encoder ()) -> [a] -> Encoder ()-list l r s f xs = case xs of- [] -> do- l- r- x : ys -> do- l- c <- Trans.ask- let newLine = if hasIndent c then Builder.word8 Literal.newLine else mempty- Trans.local increaseLevel $ do- i <- makeIndent <$> Trans.ask- Trans.lift . Trans.tell $ newLine <> i- f x- Monad.forM_ ys $ \ y -> do- s- Trans.lift . Trans.tell $ newLine <> i- f y- Trans.lift . Trans.tell $ newLine <> makeIndent c- r--makeIndent :: Config -> Builder.Builder-makeIndent x = case indent x of- Spaces y -> if y <= 0 then mempty else- Semigroup.stimesMonoid (level x)- . Semigroup.stimes y- $ Builder.word8 Literal.space- Tab -> Semigroup.stimesMonoid (level x)- $ Builder.word8 Literal.horizontalTabulation
source/library/Argo/Json/Array.hs view
@@ -4,9 +4,9 @@ module Argo.Json.Array where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Literal as Literal+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.Builder as Builder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH@@ -24,12 +24,14 @@ toList (Array x) = x encode :: (value -> Encoder.Encoder ()) -> ArrayOf value -> Encoder.Encoder ()-encode f = Encoder.list- (Trans.lift . Trans.tell $ Builder.word8 Literal.leftSquareBracket)- (Trans.lift . Trans.tell $ Builder.word8 Literal.rightSquareBracket)- (Trans.lift . Trans.tell $ Builder.word8 Literal.comma)- f- . toList+encode f =+ Encoder.list+ (Trans.lift . Trans.tell $ Builder.word8 Literal.leftSquareBracket)+ (Trans.lift . Trans.tell $ Builder.word8 Literal.rightSquareBracket+ )+ (Trans.lift . Trans.tell $ Builder.word8 Literal.comma)+ f+ . toList decode :: Decoder.Decoder value -> Decoder.Decoder (ArrayOf value) decode f = do
source/library/Argo/Json/Boolean.hs view
@@ -6,9 +6,9 @@ import Control.Applicative ((<|>)) -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Literal as Literal+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.Builder as Builder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH@@ -26,16 +26,17 @@ toBool (Boolean x) = x encode :: Boolean -> Encoder.Encoder ()-encode x = Trans.lift- . Trans.tell- . Builder.byteString- $ if toBool x then Literal.true else Literal.false+encode x = Trans.lift . Trans.tell . Builder.byteString $ if toBool x+ then Literal.true+ else Literal.false decode :: Decoder.Decoder Boolean decode = decodeFalse <|> decodeTrue decodeFalse :: Decoder.Decoder Boolean-decodeFalse = fromBool False <$ Decoder.byteString Literal.false <* Decoder.spaces+decodeFalse =+ fromBool False <$ Decoder.byteString Literal.false <* Decoder.spaces decodeTrue :: Decoder.Decoder Boolean-decodeTrue = fromBool True <$ Decoder.byteString Literal.true <* Decoder.spaces+decodeTrue =+ fromBool True <$ Decoder.byteString Literal.true <* Decoder.spaces
source/library/Argo/Json/Member.hs view
@@ -4,10 +4,11 @@ module Argo.Json.Member where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Json.Name as Name import qualified Argo.Literal as Literal+import qualified Argo.Type.Config as Config+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.Builder as Builder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH@@ -15,22 +16,25 @@ import qualified Control.Monad as Monad import qualified GHC.Generics as Generics -data MemberOf value- = Member Name.Name value+data MemberOf value = Member Name.Name value deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) -encode :: (value -> Encoder.Encoder ()) -> MemberOf value -> Encoder.Encoder ()+encode+ :: (value -> Encoder.Encoder ()) -> MemberOf value -> Encoder.Encoder () encode f (Member x y) = do Name.encode x Trans.lift . Trans.tell $ Builder.word8 Literal.colon config <- Trans.ask- Monad.when (Encoder.hasIndent config)+ Monad.when (Config.hasIndent config) . Trans.lift . Trans.tell $ Builder.word8 Literal.space f y decode :: Decoder.Decoder value -> Decoder.Decoder (MemberOf value)-decode g = Member- <$> Name.decode <* Decoder.word8 Literal.colon <* Decoder.spaces- <*> g+decode g =+ Member+ <$> Name.decode+ <* Decoder.word8 Literal.colon+ <* Decoder.spaces+ <*> g
source/library/Argo/Json/Name.hs view
@@ -4,16 +4,20 @@ module Argo.Json.Name where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Json.String as String+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Data.String import qualified GHC.Generics as Generics newtype Name = Name String.String deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++instance Data.String.IsString Name where+ fromString = fromString . Data.String.fromString fromString :: String.String -> Name fromString = Name
source/library/Argo/Json/Null.hs view
@@ -4,9 +4,9 @@ module Argo.Json.Null where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Literal as Literal+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.Builder as Builder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH
source/library/Argo/Json/Number.hs view
@@ -4,11 +4,10 @@ module Argo.Json.Number where -import Data.Ratio ((%))--import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Literal as Literal+import qualified Argo.Type.Decimal as Decimal+import qualified Argo.Type.Decoder as Decoder+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.DeepSeq as DeepSeq@@ -18,92 +17,76 @@ import qualified Control.Monad as Monad import qualified Data.Bool as Bool import qualified Data.Maybe as Maybe-import qualified Data.Ratio as Ratio import qualified Data.Word as Word import qualified GHC.Generics as Generics -data Number- = Number Integer Integer+newtype Number+ = Number Decimal.Decimal deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) -number :: Integer -> Integer -> Number-number x = normalize . Number x+fromDecimal :: Decimal.Decimal -> Number+fromDecimal = Number -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+toDecimal :: Number -> Decimal.Decimal+toDecimal (Number x) = x encode :: Number -> Encoder.Encoder ()-encode (Number x y) = do- Trans.lift . Trans.tell $ Builder.integerDec x- Monad.when (y /= 0)+encode x = do+ let Decimal.Decimal s e = toDecimal x+ Trans.lift . Trans.tell $ Builder.integerDec s+ Monad.when (e /= 0) . Trans.lift . Trans.tell $ Builder.word8 Literal.latinSmallLetterE- <> Builder.integerDec y+ <> Builder.integerDec e decode :: Decoder.Decoder Number decode = do- ni <- fmap Maybe.isJust . Applicative.optional $ Decoder.word8 Literal.hyphenMinus+ 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"+ Monad.when+ (ByteString.length i+ > 1+ && ByteString.elemIndex Literal.digitZero i+ == Just 0+ )+ . Trans.lift+ $ Trans.throwE "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)+ (ne, e) <-+ fmap (Maybe.fromMaybe (False, ByteString.empty))+ . Applicative.optional+ $ do+ Monad.void+ . Decoder.satisfy+ $ \x ->+ (x == Literal.latinSmallLetterE)+ || (x == Literal.latinCapitalLetterE)+ ne <-+ fmap (== Just Literal.hyphenMinus)+ . Applicative.optional+ . Decoder.satisfy+ $ \x -> x == Literal.hyphenMinus || x == Literal.plusSign+ e <- Decoder.takeWhile1 Decoder.isDigit+ pure (ne, e) Decoder.spaces- pure $ number- (negateIf ni $ (fromDigits i * 10 ^ ByteString.length f) + fromDigits f)+ pure . fromDecimal $ Decimal.decimal+ (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+fromDigits =+ ByteString.foldl' (\a e -> (a * 10) + word8ToInteger (e - 0x30)) 0 intToInteger :: Int -> Integer intToInteger = fromIntegral word8ToInteger :: Word.Word8 -> Integer word8ToInteger = fromIntegral--toRational :: Number -> Rational-toRational (Number x y) =- if y < 0- then x % (10 ^ (-y))- else fromInteger $ x * 10 ^ y--fromRational :: Rational -> Maybe Number-fromRational r =- let- n = Ratio.numerator r- d1 = Ratio.denominator r- (t, d2) = factor 2 (0 :: Integer) d1- (f, d3) = factor 5 (0 :: Integer) d2- p = max t f- in if d3 == 1- then Just $ number (n * 2 ^ (p - t) * 5 ^ (p - f)) (-p)- else Nothing---- factor d 0 x = (p, y) <=> x = (d ^ p) * y-factor :: (Num a, Integral b) => b -> a -> b -> (a, b)-factor d n x =- let (q, r) = quotRem x d- in if x /= 0 && r == 0- then factor d (n + 1) q- else (n, x)
source/library/Argo/Json/Object.hs view
@@ -4,10 +4,10 @@ module Argo.Json.Object where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Json.Member as Member import qualified Argo.Literal as Literal+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.Builder as Builder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH@@ -25,15 +25,21 @@ toList :: ObjectOf value -> [Member.MemberOf value] toList (Object x) = x -encode :: (value -> Encoder.Encoder ()) -> ObjectOf value -> Encoder.Encoder ()-encode f = Encoder.list- (Trans.lift . Trans.tell $ Builder.word8 Literal.leftCurlyBracket)- (Trans.lift . Trans.tell $ Builder.word8 Literal.rightCurlyBracket)- (Trans.lift . Trans.tell $ Builder.word8 Literal.comma)- (Member.encode f)- . toList+encode+ :: (value -> Encoder.Encoder ()) -> ObjectOf value -> Encoder.Encoder ()+encode f =+ Encoder.list+ (Trans.lift . Trans.tell $ Builder.word8 Literal.leftCurlyBracket)+ (Trans.lift . Trans.tell $ Builder.word8 Literal.rightCurlyBracket)+ (Trans.lift . Trans.tell $ Builder.word8 Literal.comma)+ (Member.encode f)+ . toList -encodeElement :: (value -> Encoder.Encoder ()) -> Int -> Member.MemberOf value -> Encoder.Encoder ()+encodeElement+ :: (value -> Encoder.Encoder ())+ -> Int+ -> Member.MemberOf value+ -> Encoder.Encoder () encodeElement f i x = do Monad.when (i > 0) . Trans.lift . Trans.tell $ Builder.word8 Literal.comma Member.encode f x
source/library/Argo/Json/String.hs view
@@ -4,9 +4,9 @@ module Argo.Json.String where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Literal as Literal+import qualified Argo.Type.Decoder as Decoder+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.DeepSeq as DeepSeq@@ -15,6 +15,7 @@ import qualified Argo.Vendor.Transformers as Trans import qualified Control.Monad as Monad import qualified Data.Char as Char+import qualified Data.String as String import qualified Data.Word as Word import qualified GHC.Generics as Generics @@ -22,6 +23,9 @@ = String Text.Text deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +instance String.IsString Argo.Json.String.String where+ fromString = fromText . String.fromString+ fromText :: Text.Text -> Argo.Json.String.String fromText = String @@ -29,36 +33,57 @@ toText (String x) = x encode :: Argo.Json.String.String -> Encoder.Encoder ()-encode x = Trans.lift- . Trans.tell- $ Builder.word8 Literal.quotationMark- <> Text.encodeUtf8BuilderEscaped encodeChar (toText x)- <> Builder.word8 Literal.quotationMark+encode x =+ Trans.lift+ . Trans.tell+ $ Builder.word8 Literal.quotationMark+ <> Text.encodeUtf8BuilderEscaped encodeChar (toText x)+ <> Builder.word8 Literal.quotationMark encodeChar :: Builder.BoundedPrim Word.Word8 encodeChar =- Builder.condB (== Literal.quotationMark) (encodeShortEscape Literal.quotationMark)- . Builder.condB (== Literal.reverseSolidus) (encodeShortEscape Literal.reverseSolidus)- . Builder.condB (== Literal.backspace) (encodeShortEscape Literal.latinSmallLetterB)- . Builder.condB (== Literal.formFeed) (encodeShortEscape Literal.latinSmallLetterF)- . Builder.condB (== Literal.newLine) (encodeShortEscape Literal.latinSmallLetterN)- . Builder.condB (== Literal.carriageReturn) (encodeShortEscape Literal.latinSmallLetterR)- . Builder.condB (== Literal.horizontalTabulation) (encodeShortEscape Literal.latinSmallLetterT)- . Builder.condB (< Literal.space) encodeLongEscape- $ Builder.liftFixedToBounded Builder.word8F+ Builder.condB+ (== Literal.quotationMark)+ (encodeShortEscape Literal.quotationMark)+ . Builder.condB+ (== Literal.reverseSolidus)+ (encodeShortEscape Literal.reverseSolidus)+ . Builder.condB+ (== Literal.backspace)+ (encodeShortEscape Literal.latinSmallLetterB)+ . Builder.condB+ (== Literal.formFeed)+ (encodeShortEscape Literal.latinSmallLetterF)+ . Builder.condB+ (== Literal.newLine)+ (encodeShortEscape Literal.latinSmallLetterN)+ . Builder.condB+ (== Literal.carriageReturn)+ (encodeShortEscape Literal.latinSmallLetterR)+ . Builder.condB+ (== Literal.horizontalTabulation)+ (encodeShortEscape Literal.latinSmallLetterT)+ . Builder.condB (< Literal.space) encodeLongEscape+ $ Builder.liftFixedToBounded Builder.word8F encodeShortEscape :: Word.Word8 -> Builder.BoundedPrim a-encodeShortEscape x = Builder.liftFixedToBounded- $ const (Literal.reverseSolidus, x)- Builder.>$< Builder.word8F- Builder.>*< Builder.word8F+encodeShortEscape x =+ Builder.liftFixedToBounded+ $ const (Literal.reverseSolidus, x)+ Builder.>$< Builder.word8F+ Builder.>*< Builder.word8F encodeLongEscape :: Builder.BoundedPrim Word.Word8-encodeLongEscape = Builder.liftFixedToBounded- $ (\ x -> (Literal.reverseSolidus, (Literal.latinSmallLetterU, word8ToWord16 x)))- Builder.>$< Builder.word8F- Builder.>*< Builder.word8F- Builder.>*< Builder.word16HexFixed+encodeLongEscape =+ Builder.liftFixedToBounded+ $ (\x ->+ ( Literal.reverseSolidus+ , (Literal.latinSmallLetterU, word8ToWord16 x)+ )+ )+ Builder.>$< Builder.word8F+ Builder.>*< Builder.word8F+ Builder.>*< Builder.word16HexFixed word8ToWord16 :: Word.Word8 -> Word.Word16 word8ToWord16 = fromIntegral@@ -66,26 +91,29 @@ decode :: Decoder.Decoder Argo.Json.String.String decode = do Decoder.word8 Literal.quotationMark- b1 <- Decoder.get+ b1 <- Trans.get i <- case getClose b1 0 of- Nothing -> fail "unterminated string"+ Nothing -> Trans.lift $ Trans.throwE "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+ Monad.when (ByteString.any (< Literal.space) xs)+ . Trans.lift+ $ Trans.throwE "unescaped control character"+ Trans.put b2 Decoder.word8 Literal.quotationMark Decoder.spaces case Text.decodeUtf8' xs of- Left e -> fail $ show e+ Left e -> Trans.lift . Trans.throwE $ show e Right x -> case unescapeText x of- Nothing -> fail "invalid escape"- Just y -> pure $ fromText y+ Left e -> Trans.lift $ Trans.throwE e+ Right y -> pure $ fromText 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+countConsecutive x i =+ ByteString.length . ByteString.takeWhileEnd (== x) . ByteString.take i getClose :: ByteString.ByteString -> Int -> Maybe Int getClose b i = do@@ -93,8 +121,9 @@ 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+unescapeText :: Text.Text -> Either Prelude.String Text.Text+unescapeText =+ fmap (Text.pack . combineSurrogatePairs) . unescapeString . Text.unpack combineSurrogatePairs :: Prelude.String -> Prelude.String combineSurrogatePairs xs = case xs of@@ -104,10 +133,11 @@ x : ys -> x : combineSurrogatePairs ys combineSurrogatePair :: Char -> Char -> Char-combineSurrogatePair hi lo = Char.chr- $ 0x10000- + ((Char.ord hi - 0xd800) * 0x400)- + (Char.ord lo - 0xdc00)+combineSurrogatePair hi lo =+ Char.chr+ $ 0x10000+ + ((Char.ord hi - 0xd800) * 0x400)+ + (Char.ord lo - 0xdc00) isHighSurrogate :: Char -> Bool isHighSurrogate x = '\xd800' <= x && x <= '\xdbff'@@ -115,11 +145,11 @@ isLowSurrogate :: Char -> Bool isLowSurrogate x = '\xdc00' <= x && x <= '\xdfff' -unescapeString :: Prelude.String -> Maybe Prelude.String+unescapeString :: Prelude.String -> Either Prelude.String Prelude.String unescapeString xs = case xs of "" -> pure xs '\\' : ys -> case ys of- "" -> fail "empty escape"+ "" -> Left "empty escape" x : zs -> case x of '"' -> ('"' :) <$> unescapeString zs '\\' -> ('\\' :) <$> unescapeString zs@@ -132,8 +162,8 @@ '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"+ _ -> Left "invalid long escape"+ _ -> Left "invalid short escape" x : ys -> (x :) <$> unescapeString ys fromLongEscape :: Char -> Char -> Char -> Char -> Maybe Char
source/library/Argo/Json/Value.hs view
@@ -6,16 +6,17 @@ import Control.Applicative ((<|>)) -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Json.Array as Array import qualified Argo.Json.Boolean as Boolean import qualified Argo.Json.Null as Null import qualified Argo.Json.Number as Number import qualified Argo.Json.Object as Object import qualified Argo.Json.String as String+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Data.String import qualified GHC.Generics as Generics -- | A JSON (JavaScript Object Notation) value, as described by RFC 8259.@@ -29,6 +30,9 @@ | Object (Object.ObjectOf Value) deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +instance Data.String.IsString Value where+ fromString = String . Data.String.fromString+ encode :: Value -> Encoder.Encoder () encode x = case x of Null y -> Null.encode y@@ -40,9 +44,9 @@ 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+ (Null <$> Null.decode)+ <|> (Boolean <$> Boolean.decode)+ <|> (Number <$> Number.decode)+ <|> (String <$> String.decode)+ <|> (Array <$> Array.decode decode)+ <|> (Object <$> Object.decode decode)
source/library/Argo/Main.hs view
@@ -1,7 +1,8 @@ module Argo.Main where import qualified Argo-import qualified Argo.Encoder as Encoder+import qualified Argo.Type.Flag as Flag+import qualified Argo.Type.Settings as Settings import qualified Control.Monad as Monad import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as Builder@@ -11,71 +12,75 @@ import qualified System.Environment as Environment import qualified System.Exit as Exit import qualified System.IO as IO-import qualified Text.Read as Read main :: IO () main = do name <- Environment.getProgName arguments <- Environment.getArgs- let (flags, as, os, es) = Console.getOpt' Console.Permute options arguments- mapM_ (IO.hPutStrLn IO.stderr . mappend "unknown argument " . quote) as- mapM_ (IO.hPutStrLn IO.stderr . mappend "unknown option " . quote) os- mapM_ (IO.hPutStr IO.stderr) es- Monad.unless (null es) Exit.exitFailure+ mainWith name arguments - config <- either fail pure $ Monad.foldM applyFlag defaultConfig flags- Monad.when (configHelp config) $ do- putStr $ Console.usageInfo (name <> " version " <> version) options- Exit.exitSuccess- Monad.when (configVersion config) $ do- putStrLn version- Exit.exitSuccess+mainWith :: String -> [String] -> IO ()+mainWith name arguments = do+ let ((warnings, errors), flags) = getFlags arguments+ mapM_ (IO.hPutStrLn IO.stderr) warnings+ mapM_ (IO.hPutStr IO.stderr) errors+ Monad.unless (null errors) Exit.exitFailure - contents <- ByteString.getContents- case Argo.decode contents of- Argo.Failure e -> fail e- Argo.Success value -> Builder.hPutBuilder IO.stdout- $ Argo.encodeWith (configIndent config) (value :: Argo.Value)+ withSettings name flags $ \settings -> do+ contents <- ByteString.getContents+ value <- case Argo.decode contents of+ Left e -> fail e+ Right x -> pure (x :: Argo.Value)+ Builder.hPutBuilder IO.stdout+ $ Argo.encodeWith (Settings.indent settings) value +getFlags :: [String] -> (([String], [String]), [Flag.Flag])+getFlags arguments =+ let+ (flags, xs, ys, errors) =+ Console.getOpt' Console.Permute options arguments+ warnings =+ fmap (mappend "unknown argument " . quote) xs+ <> fmap (mappend "unknown option " . quote) ys+ in ((warnings, errors), flags)++withSettings :: String -> [Flag.Flag] -> (Settings.Settings -> IO ()) -> IO ()+withSettings name flags callback = do+ settings <- either fail pure+ $ Monad.foldM Settings.applyFlag Settings.initial flags+ if Settings.help settings+ then putStr+ $ Console.usageInfo (name <> " version " <> version) options+ else if Settings.version settings+ then putStrLn version+ else callback settings+ quote :: String -> String quote x = "`" <> x <> "'" version :: String version = Version.showVersion This.version -data Flag- = FlagHelp- | FlagSpaces String- | FlagTab- | FlagVersion- deriving (Eq, Show)--options :: [Console.OptDescr Flag]+options :: [Console.OptDescr Flag.Flag] options =- [ Console.Option ['h', '?'] ["help"] (Console.NoArg FlagHelp) "shows this help message and exits"- , Console.Option ['v'] ["version"] (Console.NoArg FlagVersion) "shows the version number and exits"- , Console.Option ['s'] ["spaces"] (Console.ReqArg FlagSpaces "INT") "pretty-prints the output using INT sapces"- , Console.Option ['t'] ["tab"] (Console.NoArg FlagTab) "pretty-prints the output using tabs"+ [ Console.Option+ ['h', '?']+ ["help"]+ (Console.NoArg Flag.Help)+ "shows this help message and exits"+ , Console.Option+ ['v']+ ["version"]+ (Console.NoArg Flag.Version)+ "shows the version number and exits"+ , Console.Option+ ['s']+ ["spaces"]+ (Console.ReqArg Flag.Spaces "INT")+ "pretty-prints the output using INT sapces"+ , Console.Option+ ['t']+ ["tab"]+ (Console.NoArg Flag.Tab)+ "pretty-prints the output using tabs" ]--data Config = Config- { configHelp :: Bool- , configIndent :: Encoder.Indent- , configVersion :: Bool- } deriving (Eq, Show)--defaultConfig :: Config-defaultConfig = Config- { configHelp = False- , configIndent = Encoder.Spaces 0- , configVersion = False- }--applyFlag :: Config -> Flag -> Either String Config-applyFlag config flag = case flag of- FlagHelp -> pure config { configHelp = True }- FlagSpaces string -> do- int <- Read.readEither string- pure config { configIndent = Encoder.Spaces int }- FlagTab -> pure config { configIndent = Encoder.Tab }- FlagVersion -> pure config { configVersion = True }
source/library/Argo/Pattern.hs view
@@ -11,6 +11,7 @@ import qualified Argo.Json.Object as Object import qualified Argo.Json.String as String import qualified Argo.Json.Value as Value+import qualified Argo.Type.Decimal as Decimal import qualified Argo.Vendor.Text as Text pattern Null :: Value.Value@@ -19,33 +20,27 @@ pattern Boolean :: Bool -> Value.Value pattern Boolean x = Value.Boolean (Boolean.Boolean x) -pattern Number :: Integer -> Integer -> Value.Value-pattern Number x y <- Value.Number (Number.Number x y) where- Number x y = Value.Number $ Number.number x y+pattern Number :: Decimal.Decimal -> Value.Value+pattern Number x = Value.Number (Number.Number x) pattern String :: Text.Text -> Value.Value pattern String x = Value.String (String.String x) -type Array = [Value.Value]--pattern Array :: Array -> Value.Value+pattern Array :: [Value.Value] -> Value.Value pattern Array x = Value.Array (Array.Array x) -type Object = [Member]--pattern Object :: Object -> Value.Value+pattern Object :: [Member.MemberOf Value.Value] -> Value.Value pattern Object x = Value.Object (Object.Object x) {-# COMPLETE Null, Boolean, Number, String, Array, Object #-} -type Member = Member.MemberOf Value.Value--pattern Member :: Name.Name -> Value.Value -> Member-pattern Member k v = Member.Member k v--{-# COMPLETE Member #-}- pattern Name :: Text.Text -> Name.Name pattern Name x = Name.Name (String.String x) {-# COMPLETE Name #-}++pattern Decimal :: Integer -> Integer -> Decimal.Decimal+pattern Decimal s e <- Decimal.Decimal s e where+ Decimal s e = Decimal.decimal s e++{-# COMPLETE Decimal #-}
source/library/Argo/Pointer/Pointer.hs view
@@ -4,22 +4,21 @@ module Argo.Pointer.Pointer where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder-import qualified Argo.Json.Value as Value-import qualified Argo.Json.Object as Object import qualified Argo.Json.Array as Array import qualified Argo.Json.Member as Member import qualified Argo.Json.Name as Name+import qualified Argo.Json.Object as Object import qualified Argo.Json.String as String+import qualified Argo.Json.Value as Value import qualified Argo.Literal as Literal import qualified Argo.Pointer.Token as Token-import qualified Argo.Result as Result+import qualified Argo.Type.Decoder as Decoder+import qualified Argo.Type.Encoder as Encoder import qualified Argo.Vendor.Builder as Builder import qualified Argo.Vendor.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH-import qualified Argo.Vendor.Transformers as Trans import qualified Argo.Vendor.Text as Text+import qualified Argo.Vendor.Transformers as Trans import qualified Control.Applicative as Applicative import qualified Data.List as List import qualified GHC.Generics as Generics@@ -53,33 +52,36 @@ Trans.lift . Trans.tell $ Builder.word8 Literal.solidus Token.encode x -evaluate :: Pointer -> Value.Value -> Result.Result Value.Value+evaluate :: Pointer -> Value.Value -> Either String Value.Value evaluate p v = case toList p of [] -> pure v t : ts -> do w <- case v of Value.Array a -> atIndex t a Value.Object o -> atKey t o- _ -> fail "not indexable"+ _ -> Left "not indexable" evaluate (fromList ts) w -atIndex :: Token.Token -> Array.ArrayOf value -> Result.Result value+atIndex :: Token.Token -> Array.ArrayOf value -> Either String value atIndex t a = do i <- tokenToIndex t case drop i $ Array.toList a of- [] -> fail $ "missing index: " <> show t+ [] -> Left $ "missing index: " <> show t e : _ -> pure e -tokenToIndex :: Token.Token -> Result.Result Int+tokenToIndex :: Token.Token -> Either String Int tokenToIndex token = do- let- text = Token.toText token+ let text = Token.toText token invalid = "invalid index: " <> show token case Text.uncons text of- Just ('0', rest) -> if Text.null rest then pure 0 else fail invalid- _ -> maybe (fail invalid) pure . Read.readMaybe $ Text.unpack text+ Just ('0', rest) -> if Text.null rest then pure 0 else Left invalid+ _ -> maybe (Left invalid) pure . Read.readMaybe $ Text.unpack text -atKey :: Token.Token -> Object.ObjectOf value -> Result.Result value-atKey t = maybe (fail $ "missing key: " <> show t) (\ (Member.Member _ v) -> pure v)- . List.find (\ (Member.Member k _) -> String.toText (Name.toString k) == Token.toText t)- . Object.toList+atKey :: Token.Token -> Object.ObjectOf value -> Either String value+atKey t =+ maybe (Left $ "missing key: " <> show t) (\(Member.Member _ v) -> pure v)+ . List.find+ (\(Member.Member k _) ->+ String.toText (Name.toString k) == Token.toText t+ )+ . Object.toList
source/library/Argo/Pointer/Token.hs view
@@ -4,14 +4,16 @@ module Argo.Pointer.Token where -import qualified Argo.Decoder as Decoder-import qualified Argo.Encoder as Encoder import qualified Argo.Literal as Literal+import qualified Argo.Type.Decoder as Decoder+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.DeepSeq as DeepSeq import qualified Argo.Vendor.TemplateHaskell as TH import qualified Argo.Vendor.Text as Text import qualified Argo.Vendor.Transformers as Trans+import qualified Data.String as String import qualified Data.Word as Word import qualified GHC.Generics as Generics @@ -19,6 +21,9 @@ = Token Text.Text deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +instance String.IsString Token where+ fromString = fromText . String.fromString+ fromText :: Text.Text -> Token fromText = Token @@ -28,40 +33,40 @@ decode :: Decoder.Decoder Token decode = do x <- Decoder.takeWhile $ (/=) Literal.solidus- y <- case Text.decodeUtf8' x of- Left e -> fail $ show e- Right y -> pure y- case unescapeText y of- Nothing -> fail "invalid escape"- Just z -> pure $ fromText z+ y <- either (Trans.lift . Trans.throwE) pure $ unescape x+ case Text.decodeUtf8' y of+ Left e -> Trans.lift . Trans.throwE $ show e+ Right z -> pure $ fromText z -unescapeText :: Text.Text -> Maybe Text.Text-unescapeText = fmap Text.pack . unescapeString . Text.unpack+unescape :: ByteString.ByteString -> Either String ByteString.ByteString+unescape = fmap ByteString.pack . unescapeHelper . ByteString.unpack -unescapeString :: String -> Maybe String-unescapeString xs = case xs of- "" -> pure xs- x : ys -> case x of- '~' -> case ys of- '0' : zs -> ('~' :) <$> unescapeString zs- '1' : zs -> ('/' :) <$> unescapeString zs- _ -> fail "invalid escape"- _ -> (x :) <$> unescapeString ys+unescapeHelper :: [Word.Word8] -> Either String [Word.Word8]+unescapeHelper xs = case xs of+ [] -> pure xs+ x : ys -> if x == Literal.tilde+ then case ys of+ y : zs+ | y == Literal.digitZero+ -> (:) Literal.tilde <$> unescapeHelper zs+ | y == Literal.digitOne+ -> (:) Literal.solidus <$> unescapeHelper zs+ _ -> Left "invalid escape"+ else (:) x <$> unescapeHelper ys encode :: Token -> Encoder.Encoder ()-encode = Trans.lift- . Trans.tell- . Text.encodeUtf8BuilderEscaped encodeChar- . toText+encode =+ Trans.lift . Trans.tell . Text.encodeUtf8BuilderEscaped encodeChar . toText encodeChar :: Builder.BoundedPrim Word.Word8 encodeChar = Builder.condB (== Literal.tilde) (encodeEscape Literal.digitZero)- . Builder.condB (== Literal.solidus) (encodeEscape Literal.digitOne)- $ Builder.liftFixedToBounded Builder.word8F+ . Builder.condB (== Literal.solidus) (encodeEscape Literal.digitOne)+ $ Builder.liftFixedToBounded Builder.word8F encodeEscape :: Word.Word8 -> Builder.BoundedPrim a-encodeEscape x = Builder.liftFixedToBounded- $ const (Literal.tilde, x)- Builder.>$< Builder.word8F- Builder.>*< Builder.word8F+encodeEscape x =+ Builder.liftFixedToBounded+ $ const (Literal.tilde, x)+ Builder.>$< Builder.word8F+ Builder.>*< Builder.word8F
source/library/Argo/QuasiQuoter.hs view
@@ -2,25 +2,34 @@ import qualified Argo.Decode as Decode import qualified Argo.Json.Value as Value-import qualified Argo.Result as Result import qualified Argo.Vendor.TemplateHaskell as TH import qualified Argo.Vendor.Text as Text pointer :: TH.QuasiQuoter-pointer = TH.QuasiQuoter- { TH.quoteDec = const $ fail "cannot be used as a declaration"- , TH.quoteExp = Result.result fail TH.lift . Decode.decodePointer . Text.encodeUtf8 . Text.pack- , TH.quotePat = const $ fail "cannot be used as a pattern"- , TH.quoteType = const $ fail "cannot be used as a type"+pointer = defaultQuasiQuoter+ { TH.quoteExp =+ either fail TH.lift+ . Decode.decodePointer+ . Text.encodeUtf8+ . Text.pack } value :: TH.QuasiQuoter-value = TH.QuasiQuoter- { TH.quoteDec = const $ fail "cannot be used as a declaration"- , TH.quoteExp = Result.result fail TH.lift . fmap asValue . Decode.decode . Text.encodeUtf8 . Text.pack- , TH.quotePat = const $ fail "cannot be used as a pattern"- , TH.quoteType = const $ fail "cannot be used as a type"+value = defaultQuasiQuoter+ { TH.quoteExp =+ either fail (TH.lift . asValue)+ . Decode.decode+ . Text.encodeUtf8+ . Text.pack } asValue :: Value.Value -> Value.Value asValue = id++defaultQuasiQuoter :: TH.QuasiQuoter+defaultQuasiQuoter = TH.QuasiQuoter+ { TH.quoteDec = const $ fail "cannot be used as a declaration"+ , TH.quoteExp = const $ fail "cannot be used as an expression"+ , TH.quotePat = const $ fail "cannot be used as a pattern"+ , TH.quoteType = const $ fail "cannot be used as a type"+ }
− source/library/Argo/Result.hs
@@ -1,44 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}--module Argo.Result where--import qualified Argo.Vendor.DeepSeq as DeepSeq-import qualified Control.Applicative as Applicative-import qualified GHC.Generics as Generics--data Result a- = Failure String- | Success a- deriving (Eq, Generics.Generic, DeepSeq.NFData, Show)--instance Functor Result where- fmap f r = case r of- Failure e -> Failure e- Success x -> Success $ f x--instance Applicative Result where- pure = Success- rf <*> rx = case (rf, rx) of- (Failure e, _) -> Failure e- (_, Failure e) -> Failure e- (Success f, Success x) -> Success $ f x--instance Monad Result where- r >>= f = case r of- Failure e -> Failure e- Success x -> f x--instance MonadFail Result where- fail = Failure--instance Applicative.Alternative Result where- empty = fail "empty"- rx <|> ry = case rx of- Failure _ -> ry- Success _ -> rx--result :: (String -> b) -> (a -> b) -> Result a -> b-result f g r = case r of- Failure e -> f e- Success x -> g x
+ source/library/Argo/Type/Codec.hs view
@@ -0,0 +1,344 @@+module Argo.Type.Codec 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.Type.Permission as Permission+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Applicative as Applicative+import qualified Control.Monad as Monad+import qualified Data.Functor.Identity as Identity+import qualified Data.Text as Text++decodeWith :: ValueCodec a -> Value.Value -> Either String a+decodeWith c =+ Identity.runIdentity . Trans.runExceptT . Trans.runReaderT (decode c)++encodeWith :: ValueCodec a -> a -> Value.Value+encodeWith c x =+ snd+ . Identity.runIdentity+ . Trans.runStateT (Trans.runMaybeT $ encode c x)+ . Value.Null+ $ Null.fromUnit ()++project :: (i -> f) -> CodecOf r w f o -> CodecOf r w i o+project f c = c { encode = encode c . f }++data CodecOf r w i o = Codec+ { decode :: r o+ , encode :: i -> w o+ }++instance (Functor r, Functor w) => Functor (CodecOf r w i) where+ fmap f c = Codec { decode = f <$> decode c, encode = fmap f . encode c }++instance (Applicative r, Applicative w) => Applicative (CodecOf r w i) where+ pure x = Codec { decode = pure x, encode = const $ pure x }+ cf <*> cx = Codec+ { decode = decode cf <*> decode cx+ , encode = \i -> encode cf i <*> encode cx i+ }++instance (Applicative.Alternative r, Applicative.Alternative w) => Applicative.Alternative (CodecOf r w i) where+ empty =+ Codec { decode = Applicative.empty, encode = const Applicative.empty }+ cx <|> cy = Codec+ { decode = decode cx <|> decode cy+ , encode = \i -> encode cx i <|> encode cy i+ }++type Codec r w a = CodecOf r w a a++dimap+ :: (Functor r, Functor w)+ => (a -> b)+ -> (b -> a)+ -> Codec r w a+ -> Codec r w b+dimap f g c =+ Codec { decode = f <$> decode c, encode = fmap f . encode c . g }++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+ x <- Trans.ask+ case x of+ Value.Array y -> pure y+ _ ->+ Trans.lift . Trans.throwE $ "expected Array but got " <> show x+ , encode = \x -> do+ Trans.lift . Trans.put $ Value.Array x+ pure x+ }++objectCodec :: ValueCodec (Object.ObjectOf Value.Value)+objectCodec = Codec+ { decode = do+ x <- Trans.ask+ case x of+ Value.Object y -> pure y+ _ ->+ Trans.lift+ . Trans.throwE+ $ "expected Object but got "+ <> show x+ , encode = \x -> do+ Trans.lift . Trans.put $ Value.Object x+ 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)+ -> (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+ }++tagged :: String -> ValueCodec a -> ValueCodec a+tagged t c =+ dimap snd ((,) ())+ . fromObjectCodec Permission.Allow+ $ (,)+ <$> project+ fst+ (required+ (Name.fromString . String.fromText $ Text.pack "type")+ (literalCodec+ (Value.String . String.fromText $ Text.pack t)+ )+ )+ <*> project+ snd+ (required+ (Name.fromString . String.fromText $ Text.pack "value")+ c+ )++literalCodec :: Value.Value -> ValueCodec ()+literalCodec expected = Codec+ { decode = do+ actual <- Trans.ask+ Monad.when (actual /= expected)+ . Trans.lift+ . Trans.throwE+ $ "expected "+ <> show expected+ <> " but got "+ <> show actual+ , encode = const . Trans.lift $ Trans.put expected+ }++type ListCodec e a+ = Codec+ (Trans.StateT [e] (Trans.ExceptT String Identity.Identity))+ (Trans.WriterT [e] Identity.Identity)+ a++fromListCodec+ :: ValueCodec [e] -> Permission.Permission -> ListCodec e a -> ValueCodec a+fromListCodec ce p ca = Codec+ { decode = do+ xs <- decode ce+ case+ Identity.runIdentity . Trans.runExceptT $ Trans.runStateT+ (decode ca)+ xs+ of+ Left x -> Trans.lift $ Trans.throwE x+ Right (x, ys) -> do+ case (p, ys) of+ (Permission.Forbid, _ : _) ->+ Trans.lift $ Trans.throwE "leftover elements"+ _ -> pure ()+ pure x+ , encode = \x -> do+ Monad.void+ . encode ce+ . snd+ . Identity.runIdentity+ . Trans.runWriterT+ $ encode ca x+ pure x+ }++type ArrayCodec a = ListCodec Value.Value a++fromArrayCodec :: Permission.Permission -> ArrayCodec a -> ValueCodec a+fromArrayCodec = fromListCodec $ dimap Array.toList Array.fromList arrayCodec++element :: ValueCodec a -> ArrayCodec a+element c = Codec+ { decode = do+ l <- Trans.get+ case l of+ [] -> Trans.lift $ Trans.throwE "unexpected empty list"+ h : t -> case decodeWith c h of+ Left y -> Trans.lift $ Trans.throwE y+ Right y -> do+ Trans.put t+ pure y+ , encode = \x -> do+ Trans.tell [encodeWith c x]+ 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+fromObjectCodec =+ fromListCodec $ dimap Object.toList Object.fromList objectCodec++required :: Name.Name -> ValueCodec a -> ObjectCodec a+required k c = Codec+ { decode = do+ m <- decode (optional k c)+ case m of+ Nothing ->+ Trans.lift+ . Trans.throwE+ $ "missing required member: "+ <> show k+ Just x -> pure x+ , encode = \x -> do+ Monad.void . encode (optional k c) $ Just x+ pure x+ }++optional :: Name.Name -> ValueCodec a -> ObjectCodec (Maybe a)+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+ Left y -> Trans.lift $ Trans.throwE y+ Right y -> do+ Trans.put ys+ pure $ Just y+ , 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
+ source/library/Argo/Type/Config.hs view
@@ -0,0 +1,20 @@+module Argo.Type.Config where++import qualified Argo.Type.Indent as Indent++data Config = Config+ { indent :: Indent.Indent+ , level :: Int+ }+ deriving (Eq, Show)++initial :: Config+initial = Config { indent = Indent.Spaces 0, level = 0 }++hasIndent :: Config -> Bool+hasIndent x = case indent x of+ Indent.Spaces y -> y > 0+ Indent.Tab -> True++increaseLevel :: Config -> Config+increaseLevel x = x { level = level x + 1 }
+ source/library/Argo/Type/Decimal.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-}++module Argo.Type.Decimal where++import Data.Ratio ((%))++import qualified Argo.Vendor.DeepSeq as DeepSeq+import qualified Argo.Vendor.TemplateHaskell as TH+import qualified Data.Ratio as Ratio+import qualified GHC.Generics as Generics++data Decimal = Decimal Integer Integer+ deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show)++negate :: Decimal -> Decimal+negate (Decimal s e) = Decimal (-s) e++decimal :: Integer -> Integer -> Decimal+decimal s = normalize . Decimal s++normalize :: Decimal -> Decimal+normalize (Decimal s e) = if s == 0+ then Decimal 0 0+ else+ let (q, r) = quotRem s 10+ in if r == 0 then normalize $ Decimal q (e + 1) else Decimal s e++toRational :: Decimal -> Rational+toRational (Decimal s e) =+ if e < 0 then s % (10 ^ (-e)) else fromInteger $ s * 10 ^ e++fromRational :: Rational -> Maybe Decimal+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 $ decimal (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)
+ source/library/Argo/Type/Decoder.hs view
@@ -0,0 +1,92 @@+module Argo.Type.Decoder where++import qualified Argo.Literal as Literal+import qualified Argo.Vendor.ByteString as ByteString+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Applicative as Applicative+import qualified Control.Monad as Monad+import qualified Data.Functor.Identity as Identity+import qualified Data.Word as Word++type Decoder+ = Trans.StateT+ ByteString.ByteString+ (Trans.ExceptT String Identity.Identity)++unwrap+ :: Decoder a+ -> ByteString.ByteString+ -> Either String (a, ByteString.ByteString)+unwrap d = Identity.runIdentity . Trans.runExceptT . Trans.runStateT d++run :: Decoder a -> ByteString.ByteString -> Either String a+run d = fmap fst . unwrap (d <* eof)++list :: Decoder a -> Decoder [a]+list f = listWith f []++listWith :: Decoder a -> [a] -> Decoder [a]+listWith f xs = do+ m <- Applicative.optional $ do+ Monad.unless (null xs) $ do+ word8 Literal.comma+ spaces+ f+ case m of+ Nothing -> pure $ reverse xs+ Just x -> listWith f $ x : xs++byteString :: ByteString.ByteString -> Decoder ()+byteString x = do+ b1 <- Trans.get+ case ByteString.stripPrefix x b1 of+ Nothing -> Trans.lift . Trans.throwE $ "byteString: " <> show x+ Just b2 -> Trans.put b2++dropWhile :: (Word.Word8 -> Bool) -> Decoder ()+dropWhile f = do+ b <- Trans.get+ Trans.put $ ByteString.dropWhile f b++eof :: Decoder ()+eof = do+ b <- Trans.get+ Monad.unless (ByteString.null b) . Trans.lift $ Trans.throwE "eof"++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)++satisfy :: (Word.Word8 -> Bool) -> Decoder Word.Word8+satisfy f = do+ b1 <- Trans.get+ case ByteString.uncons b1 of+ Just (x, b2) | f x -> do+ Trans.put b2+ pure x+ _ -> Trans.lift $ Trans.throwE "satisfy"++spaces :: Decoder ()+spaces = Argo.Type.Decoder.dropWhile isSpace++takeWhile :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString+takeWhile f = do+ b1 <- Trans.get+ let (x, b2) = ByteString.span f b1+ Trans.put b2+ pure x++takeWhile1 :: (Word.Word8 -> Bool) -> Decoder ByteString.ByteString+takeWhile1 f = do+ x <- Argo.Type.Decoder.takeWhile f+ Monad.when (ByteString.null x) . Trans.lift $ Trans.throwE "takeWhile1"+ pure x++word8 :: Word.Word8 -> Decoder ()+word8 = Monad.void . satisfy . (==)
+ source/library/Argo/Type/Encoder.hs view
@@ -0,0 +1,61 @@+module Argo.Type.Encoder where++import qualified Argo.Literal as Literal+import qualified Argo.Type.Config as Config+import qualified Argo.Type.Indent as Indent+import qualified Argo.Vendor.Builder as Builder+import qualified Argo.Vendor.Transformers as Trans+import qualified Control.Monad as Monad+import qualified Data.Functor.Identity as Identity+import qualified Data.Semigroup as Semigroup++type Encoder+ = Trans.ReaderT+ Config.Config+ (Trans.WriterT Builder.Builder Identity.Identity)++unwrap :: Config.Config -> Encoder a -> (a, Builder.Builder)+unwrap c = Identity.runIdentity . Trans.runWriterT . flip Trans.runReaderT c++run :: Config.Config -> Encoder a -> Builder.Builder+run c = snd . unwrap c++list+ :: Encoder ()+ -> Encoder ()+ -> Encoder ()+ -> (a -> Encoder ())+ -> [a]+ -> Encoder ()+list left right separator encode xs = do+ left+ case xs of+ [] -> pure ()+ x : ys -> do+ Trans.local Config.increaseLevel $ do+ maybeIndent <- makeIndent <$> Trans.ask+ withNewLine maybeIndent+ encode x+ Monad.forM_ ys $ \y -> do+ separator+ withNewLine maybeIndent+ encode y+ maybeIndent <- makeIndent <$> Trans.ask+ withNewLine maybeIndent+ right++makeIndent :: Config.Config -> Maybe Builder.Builder+makeIndent config = case Config.indent config of+ Indent.Spaces spaces -> if spaces <= 0+ then Nothing+ else+ Just+ . Semigroup.stimesMonoid (Config.level config * spaces)+ $ Builder.word8 Literal.space+ Indent.Tab ->+ Just . Semigroup.stimesMonoid (Config.level config) $ Builder.word8+ Literal.horizontalTabulation++withNewLine :: Maybe Builder.Builder -> Encoder ()+withNewLine = maybe (pure ()) $ Trans.lift . Trans.tell . mappend+ (Builder.word8 Literal.newLine)
+ source/library/Argo/Type/Flag.hs view
@@ -0,0 +1,8 @@+module Argo.Type.Flag where++data Flag+ = Help+ | Spaces String+ | Tab+ | Version+ deriving (Eq, Show)
+ source/library/Argo/Type/Indent.hs view
@@ -0,0 +1,6 @@+module Argo.Type.Indent where++data Indent+ = Spaces Int+ | Tab+ deriving (Eq, Show)
+ source/library/Argo/Type/Permission.hs view
@@ -0,0 +1,6 @@+module Argo.Type.Permission where++data Permission+ = Allow+ | Forbid+ deriving (Eq, Show)
+ source/library/Argo/Type/Settings.hs view
@@ -0,0 +1,24 @@+module Argo.Type.Settings where++import qualified Argo.Type.Flag as Flag+import qualified Argo.Type.Indent as Indent+import qualified Text.Read as Read++data Settings = Settings+ { help :: Bool+ , indent :: Indent.Indent+ , version :: Bool+ }+ deriving (Eq, Show)++initial :: Settings+initial = Settings { help = False, indent = Indent.Spaces 0, version = False }++applyFlag :: Settings -> Flag.Flag -> Either String Settings+applyFlag settings flag = case flag of+ Flag.Help -> pure settings { help = True }+ Flag.Spaces string -> do+ int <- Read.readEither string+ pure settings { indent = Indent.Spaces int }+ Flag.Tab -> pure settings { indent = Indent.Tab }+ Flag.Version -> pure settings { version = True }
source/library/Argo/Vendor/ByteString.hs view
@@ -16,6 +16,7 @@ , ByteString.takeWhileEnd , LazyByteString.toStrict , ByteString.uncons+ , ByteString.unpack ) where import qualified Data.ByteString as ByteString
+ source/test-suite/Argo/Orphanage.hs view
@@ -0,0 +1,67 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Argo.Orphanage where++import Data.List.NonEmpty (NonEmpty((:|)))++import qualified Argo+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified Test.Tasty.QuickCheck as Tasty++instance Tasty.Arbitrary Argo.Name where+ arbitrary = Argo.Name <$> Tasty.arbitrary+ shrink (Argo.Name x) = Argo.Name <$> Tasty.shrink x++instance Tasty.Arbitrary value => Tasty.Arbitrary (Argo.MemberOf value) where+ arbitrary = Argo.Member <$> Tasty.arbitrary <*> Tasty.arbitrary+ shrink (Argo.Member k v) = uncurry Argo.Member <$> Tasty.shrink (k, v)++instance Tasty.Arbitrary Argo.Value where+ arbitrary = Tasty.sized genValueSized+ shrink x = case x of+ Argo.Null -> []+ Argo.Boolean y -> Argo.Boolean <$> Tasty.shrink y+ Argo.Number y -> Argo.Number <$> Tasty.shrink y+ Argo.String y -> Argo.String <$> Tasty.shrink y+ Argo.Array y -> Argo.Array <$> Tasty.shrink y+ Argo.Object y -> Argo.Object <$> Tasty.shrink y++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+ , Argo.String <$> Tasty.arbitrary+ , Argo.Array <$> Tasty.vectorOf size (genValueSized newSize)+ , Argo.Object <$> Tasty.vectorOf+ size+ (Argo.Member <$> Tasty.arbitrary <*> genValueSized newSize)+ ]++instance Tasty.Arbitrary Argo.Decimal where+ arbitrary = Argo.Decimal <$> Tasty.arbitrary <*> Tasty.arbitrary+ shrink (Argo.Decimal s e) = uncurry Argo.Decimal <$> Tasty.shrink (s, e)++instance Tasty.Arbitrary Text.Text where+ arbitrary = Text.pack <$> Tasty.arbitrary+ shrink = Tasty.shrinkMap Text.pack Text.unpack++instance Tasty.Arbitrary LazyText.Text where+ arbitrary = LazyText.pack <$> Tasty.arbitrary+ shrink = Tasty.shrinkMap LazyText.pack LazyText.unpack++instance Tasty.Arbitrary a => Tasty.Arbitrary (NonEmpty a) where+ arbitrary = (:|) <$> Tasty.arbitrary <*> Tasty.arbitrary+ shrink (x :| xs) = uncurry (:|) <$> Tasty.shrink (x, xs)++instance Tasty.Arbitrary Argo.Pointer where+ arbitrary = Argo.Pointer <$> Tasty.arbitrary+ shrink (Argo.Pointer x) = Argo.Pointer <$> Tasty.shrink x++instance Tasty.Arbitrary Argo.Token where+ arbitrary = Argo.Token <$> Tasty.arbitrary+ shrink (Argo.Token x) = Argo.Token <$> Tasty.shrink x
source/test-suite/Main.hs view
@@ -1,15 +1,15 @@-{-# OPTIONS_GHC -Wno-orphans #-}--{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +import Argo.Orphanage () import Data.List.NonEmpty (NonEmpty((:|))) import Test.Tasty.HUnit ((@?=)) import Test.Tasty.QuickCheck ((===)) import qualified Argo-import qualified Argo.Codec as Codec+import qualified Argo.Type.Codec as Codec+import qualified Argo.Type.Permission as Permission+import qualified Argo.Json.String as String import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LazyByteString@@ -37,19 +37,19 @@ ] , Tasty.testGroup "Number" [ Tasty.testCase "zero" $ do- encode (Argo.Number 0 0) @?= "0"+ encode (number 0 0) @?= "0" , Tasty.testCase "positive integer" $ do- encode (Argo.Number 1 0) @?= "1"+ encode (number 1 0) @?= "1" , Tasty.testCase "negative integer" $ do- encode (Argo.Number (-1) 0) @?= "-1"+ encode (number (-1) 0) @?= "-1" , Tasty.testCase "positive exponent" $ do- encode (Argo.Number 1 1) @?= "1e1"+ encode (number 1 1) @?= "1e1" , Tasty.testCase "negative exponent" $ do- encode (Argo.Number 1 (-1)) @?= "1e-1"+ encode (number 1 (-1)) @?= "1e-1" , Tasty.testCase "multiple integer digits" $ do- encode (Argo.Number 12 0) @?= "12"+ encode (number 12 0) @?= "12" , Tasty.testCase "multiple exponent digits" $ do- encode (Argo.Number 1 12) @?= "1e12"+ encode (number 1 12) @?= "1e12" ] , Tasty.testGroup "String" [ Tasty.testCase "empty" $ do@@ -89,20 +89,20 @@ [ Tasty.testCase "empty" $ do encode (Argo.Array []) @?= "[]" , Tasty.testCase "one element" $ do- encode (Argo.Array [Argo.Number 1 0]) @?= "[1]"+ encode (Argo.Array [number 1 0]) @?= "[1]" , Tasty.testCase "two elements" $ do- encode (Argo.Array [Argo.Number 1 0, Argo.Number 2 0]) @?= "[1,2]"+ encode (Argo.Array [number 1 0, number 2 0]) @?= "[1,2]" ] , Tasty.testGroup "Object" [ Tasty.testCase "empty" $ do encode (Argo.Object []) @?= "{}" , Tasty.testCase "one element" $ do- encode (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0]) @?= "{\"a\":1}"+ encode (Argo.Object [Argo.Member (Argo.Name "a") $ number 1 0]) @?= "{\"a\":1}" , Tasty.testCase "two elements" $ do- encode (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0, Argo.Member (Argo.Name "b") $ Argo.Number 2 0]) @?= "{\"a\":1,\"b\":2}"+ encode (Argo.Object [Argo.Member (Argo.Name "a") $ number 1 0, Argo.Member (Argo.Name "b") $ number 2 0]) @?= "{\"a\":1,\"b\":2}" ] ]- , Tasty.testGroup "decode" $ let decode = resultToMaybe . Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in+ , Tasty.testGroup "decode" $ let decode = hush . Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in [ Tasty.testGroup "Null" [ Tasty.testCase "null" $ do decode "null" @?= Just Argo.Null@@ -125,37 +125,37 @@ ] , Tasty.testGroup "Number" [ Tasty.testCase "zero" $ do- decode "0" @?= Just (Argo.Number 0 0)+ decode "0" @?= Just (number 0 0) , Tasty.testCase "negative zero" $ do- decode "-0" @?= Just (Argo.Number 0 0)+ decode "-0" @?= Just (number 0 0) , Tasty.testCase "positive integer" $ do- decode "1" @?= Just (Argo.Number 1 0)+ decode "1" @?= Just (number 1 0) , Tasty.testCase "multiple integer digits" $ do- decode "12" @?= Just (Argo.Number 12 0)+ decode "12" @?= Just (number 12 0) , Tasty.testCase "negative integer" $ do- decode "-1" @?= Just (Argo.Number (-1) 0)+ decode "-1" @?= Just (number (-1) 0) , Tasty.testCase "fraction" $ do- decode "0.1" @?= Just (Argo.Number 1 (-1))+ decode "0.1" @?= Just (number 1 (-1)) , Tasty.testCase "multiple fraction digits" $ do- decode "0.12" @?= Just (Argo.Number 12 (-2))+ decode "0.12" @?= Just (number 12 (-2)) , Tasty.testCase "leading zero fraction" $ do- decode "0.01" @?= Just (Argo.Number 1 (-2))+ decode "0.01" @?= Just (number 1 (-2)) , Tasty.testCase "positive exponent" $ do- decode "1e1" @?= Just (Argo.Number 1 1)+ decode "1e1" @?= Just (number 1 1) , Tasty.testCase "capital exponent" $ do- decode "1E1" @?= Just (Argo.Number 1 1)+ decode "1E1" @?= Just (number 1 1) , Tasty.testCase "leading zero exponent" $ do- decode "1e01" @?= Just (Argo.Number 1 1)+ decode "1e01" @?= Just (number 1 1) , Tasty.testCase "explicit positive exponent" $ do- decode "1e+1" @?= Just (Argo.Number 1 1)+ decode "1e+1" @?= Just (number 1 1) , Tasty.testCase "negative exponent" $ do- decode "1e-1" @?= Just (Argo.Number 1 (-1))+ decode "1e-1" @?= Just (number 1 (-1)) , Tasty.testCase "multiple exponent digits" $ do- decode "1e12" @?= Just (Argo.Number 1 12)+ decode "1e12" @?= Just (number 1 12) , Tasty.testCase "kitchen sink" $ do- decode "12.34e56" @?= Just (Argo.Number 1234 54)+ decode "12.34e56" @?= Just (number 1234 54) , Tasty.testCase "normalized" $ do- decode "10" @?= Just (Argo.Number 1 1)+ decode "10" @?= Just (number 1 1) , Tasty.testCase "leading zero" $ do decode "01" @?= Nothing , Tasty.testCase "trailing fraction" $ do@@ -241,11 +241,11 @@ [ Tasty.testCase "empty" $ do decode "[]" @?= Just (Argo.Array []) , Tasty.testCase "one element" $ do- decode "[1]" @?= Just (Argo.Array [Argo.Number 1 0])+ decode "[1]" @?= Just (Argo.Array [number 1 0]) , Tasty.testCase "two elements" $ do- decode "[1,2]" @?= Just (Argo.Array [Argo.Number 1 0, Argo.Number 2 0])+ decode "[1,2]" @?= Just (Argo.Array [number 1 0, number 2 0]) , Tasty.testCase "nested" $ do- decode "[1,[2]]" @?= Just (Argo.Array [Argo.Number 1 0, Argo.Array [Argo.Number 2 0]])+ decode "[1,[2]]" @?= Just (Argo.Array [number 1 0, Argo.Array [number 2 0]]) , Tasty.testCase "not closed" $ do decode "[" @?= Nothing , Tasty.testCase "not opened" $ do@@ -263,11 +263,11 @@ [ Tasty.testCase "empty" $ do decode "{}" @?= Just (Argo.Object []) , Tasty.testCase "one element" $ do- decode "{\"a\":1}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0])+ decode "{\"a\":1}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ number 1 0]) , Tasty.testCase "two elements" $ do- decode "{\"a\":1,\"b\":2}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Number 1 0, Argo.Member (Argo.Name "b") $ Argo.Number 2 0])+ decode "{\"a\":1,\"b\":2}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ number 1 0, Argo.Member (Argo.Name "b") $ number 2 0]) , Tasty.testCase "nested" $ do- decode "{\"a\":{\"b\":2}}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Object [Argo.Member (Argo.Name "b") $ Argo.Number 2 0]])+ decode "{\"a\":{\"b\":2}}" @?= Just (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Object [Argo.Member (Argo.Name "b") $ number 2 0]]) , Tasty.testCase "not closed" $ do decode "{" @?= Nothing , Tasty.testCase "not opened" $ do@@ -292,63 +292,59 @@ decode "{1:2}" @?= Nothing ] ]- , Tasty.testGroup "fromValue" $- let- fromValue :: Argo.FromValue a => Argo.Value -> Maybe a- fromValue = resultToMaybe . Argo.fromValue- in+ , Tasty.testGroup "fromValue" [ Tasty.testCase "Value" $ do- fromValue Argo.Null @?= Just Argo.Null+ Argo.fromValue Argo.Null @?= Right Argo.Null , Tasty.testCase "Bool" $ do- fromValue (Argo.Boolean False) @?= Just False+ Argo.fromValue (Argo.Boolean False) @?= Right False , Tasty.testCase "Char" $ do- fromValue (Argo.String "a") @?= Just 'a'+ Argo.fromValue (Argo.String "a") @?= Right 'a' , Tasty.testCase "Int" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Int)+ Argo.fromValue (number 0 0) @?= Right (0 :: Int) , Tasty.testCase "Int8" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int8)+ Argo.fromValue (number 0 0) @?= Right (0 :: Int.Int8) , Tasty.testCase "Int16" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int16)+ Argo.fromValue (number 0 0) @?= Right (0 :: Int.Int16) , Tasty.testCase "Int32" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int32)+ Argo.fromValue (number 0 0) @?= Right (0 :: Int.Int32) , Tasty.testCase "Int64" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int64)+ Argo.fromValue (number 0 0) @?= Right (0 :: Int.Int64) , Tasty.testCase "Word" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Word)+ Argo.fromValue (number 0 0) @?= Right (0 :: Word) , Tasty.testCase "Word8" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word8)+ Argo.fromValue (number 0 0) @?= Right (0 :: Word.Word8) , Tasty.testCase "Word16" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word16)+ Argo.fromValue (number 0 0) @?= Right (0 :: Word.Word16) , Tasty.testCase "Word32" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word32)+ Argo.fromValue (number 0 0) @?= Right (0 :: Word.Word32) , Tasty.testCase "Word64" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word64)+ Argo.fromValue (number 0 0) @?= Right (0 :: Word.Word64) , Tasty.testCase "Integer" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Integer)+ Argo.fromValue (number 0 0) @?= Right (0 :: Integer) , Tasty.testCase "Float" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Float)+ Argo.fromValue (number 0 0) @?= Right (0 :: Float) , Tasty.testCase "Double" $ do- fromValue (Argo.Number 0 0) @?= Just (0 :: Double)+ Argo.fromValue (number 0 0) @?= Right (0 :: Double) , Tasty.testCase "String" $ do- fromValue (Argo.String "") @?= Just ("" :: String)+ Argo.fromValue (Argo.String "") @?= Right ("" :: String) , Tasty.testCase "Text" $ do- fromValue (Argo.String "") @?= Just ("" :: Text.Text)+ Argo.fromValue (Argo.String "") @?= Right ("" :: Text.Text) , Tasty.testCase "LazyText" $ do- fromValue (Argo.String "") @?= Just ("" :: LazyText.Text)+ Argo.fromValue (Argo.String "") @?= Right ("" :: LazyText.Text) , Tasty.testCase "Maybe a" $ do- fromValue (Argo.Boolean False) @?= Just (Just False)+ Argo.fromValue (Argo.Boolean False) @?= Right (Just False) , Tasty.testCase "()" $ do- fromValue (Argo.Array []) @?= Just ()+ Argo.fromValue (Argo.Array []) @?= Right () , Tasty.testCase "(a, b)" $ do- fromValue (Argo.Array [Argo.Boolean False, Argo.String "a"]) @?= Just (False, 'a')+ Argo.fromValue (Argo.Array [Argo.Boolean False, Argo.String "a"]) @?= Right (False, 'a') , Tasty.testCase "[a]" $ do- fromValue (Argo.Array []) @?= Just ([] :: [Bool])+ Argo.fromValue (Argo.Array []) @?= Right ([] :: [Bool]) , Tasty.testCase "NonEmpty a" $ do- fromValue (Argo.Array [Argo.Boolean False]) @?= Just (False :| [])+ Argo.fromValue (Argo.Array [Argo.Boolean False]) @?= Right (False :| []) , Tasty.testCase "Map Text a" $ do- fromValue (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]) @?= Just (Map.fromList [("a" :: Text.Text, False)])+ Argo.fromValue (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Boolean False]) @?= Right (Map.fromList [("a" :: Text.Text, False)]) , Tasty.testCase "Pointer" $ do- fromValue (Argo.String "") @?= Just (Argo.Pointer [])+ Argo.fromValue (Argo.String "") @?= Right (Argo.Pointer []) ] , Tasty.testGroup "toValue" [ Tasty.testCase "Value" $ do@@ -358,31 +354,31 @@ , Tasty.testCase "Char" $ do Argo.toValue 'a' @?= Argo.String "a" , Tasty.testCase "Int" $ do- Argo.toValue (0 :: Int) @?= Argo.Number 0 0+ Argo.toValue (0 :: Int) @?= number 0 0 , Tasty.testCase "Int8" $ do- Argo.toValue (0 :: Int.Int8) @?= Argo.Number 0 0+ Argo.toValue (0 :: Int.Int8) @?= number 0 0 , Tasty.testCase "Int16" $ do- Argo.toValue (0 :: Int.Int16) @?= Argo.Number 0 0+ Argo.toValue (0 :: Int.Int16) @?= number 0 0 , Tasty.testCase "Int32" $ do- Argo.toValue (0 :: Int.Int32) @?= Argo.Number 0 0+ Argo.toValue (0 :: Int.Int32) @?= number 0 0 , Tasty.testCase "Int64" $ do- Argo.toValue (0 :: Int.Int64) @?= Argo.Number 0 0+ Argo.toValue (0 :: Int.Int64) @?= number 0 0 , Tasty.testCase "Word" $ do- Argo.toValue (0 :: Word) @?= Argo.Number 0 0+ Argo.toValue (0 :: Word) @?= number 0 0 , Tasty.testCase "Word8" $ do- Argo.toValue (0 :: Word.Word8) @?= Argo.Number 0 0+ Argo.toValue (0 :: Word.Word8) @?= number 0 0 , Tasty.testCase "Word16" $ do- Argo.toValue (0 :: Word.Word16) @?= Argo.Number 0 0+ Argo.toValue (0 :: Word.Word16) @?= number 0 0 , Tasty.testCase "Word32" $ do- Argo.toValue (0 :: Word.Word32) @?= Argo.Number 0 0+ Argo.toValue (0 :: Word.Word32) @?= number 0 0 , Tasty.testCase "Word64" $ do- Argo.toValue (0 :: Word.Word64) @?= Argo.Number 0 0+ Argo.toValue (0 :: Word.Word64) @?= number 0 0 , Tasty.testCase "Integer" $ do- Argo.toValue (0 :: Integer) @?= Argo.Number 0 0+ Argo.toValue (0 :: Integer) @?= number 0 0 , Tasty.testCase "Float" $ do- Argo.toValue (0 :: Float) @?= Argo.Number 0 0+ Argo.toValue (0 :: Float) @?= number 0 0 , Tasty.testCase "Double" $ do- Argo.toValue (0 :: Double) @?= Argo.Number 0 0+ Argo.toValue (0 :: Double) @?= number 0 0 , Tasty.testCase "String" $ do Argo.toValue ("" :: String) @?= Argo.String "" , Tasty.testCase "Text" $ do@@ -410,7 +406,7 @@ , Tasty.testCase "Boolean" $ do [Argo.value| false |] @?= Argo.Boolean False , Tasty.testCase "Number" $ do- [Argo.value| 0 |] @?= Argo.Number 0 0+ [Argo.value| 0 |] @?= number 0 0 , Tasty.testCase "String" $ do [Argo.value| "" |] @?= Argo.String "" , Tasty.testCase "Array" $ do@@ -420,106 +416,106 @@ ] , Tasty.testGroup "property" [ property "decode . encode" $ \ x ->- (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode x) === Argo.Success (x :: Argo.Value)+ (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode x) === Right (x :: Argo.Value) , property "decode . encodeWith" $ \ x ->- (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encodeWith Argo.Tab x) === Argo.Success (x :: Argo.Value)+ (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encodeWith Argo.Tab x) === Right (x :: Argo.Value) , Tasty.testGroup "fromValue . toValue" [ property "Value" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Argo.Value)+ Argo.fromValue (Argo.toValue x) === Right (x :: Argo.Value) , property "Bool" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Bool)+ Argo.fromValue (Argo.toValue x) === Right (x :: Bool) , property "Char" $ \ x -> Argo.fromValue (Argo.toValue x) === if '\xd800' <= x && x <= '\xdfff'- then Argo.Success '\xfffd'- else Argo.Success x+ then Right '\xfffd'+ else Right x , property "Int" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int)+ Argo.fromValue (Argo.toValue x) === Right (x :: Int) , property "Int8" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int8)+ Argo.fromValue (Argo.toValue x) === Right (x :: Int.Int8) , property "Int16" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int16)+ Argo.fromValue (Argo.toValue x) === Right (x :: Int.Int16) , property "Int32" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int32)+ Argo.fromValue (Argo.toValue x) === Right (x :: Int.Int32) , property "Int64" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Int.Int64)+ Argo.fromValue (Argo.toValue x) === Right (x :: Int.Int64) , property "Word" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word)+ Argo.fromValue (Argo.toValue x) === Right (x :: Word) , property "Word8" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word8)+ Argo.fromValue (Argo.toValue x) === Right (x :: Word.Word8) , property "Word16" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word16)+ Argo.fromValue (Argo.toValue x) === Right (x :: Word.Word16) , property "Word32" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word32)+ Argo.fromValue (Argo.toValue x) === Right (x :: Word.Word32) , property "Word64" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Word.Word64)+ Argo.fromValue (Argo.toValue x) === Right (x :: Word.Word64) , property "Integer" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Integer)+ Argo.fromValue (Argo.toValue x) === Right (x :: Integer) , property "Float" $ \ x -> Argo.fromValue (Argo.toValue x) === if isNaN x || isInfinite x- then Argo.Failure "expected Float but got Null (Null ())"- else Argo.Success (x :: Float)+ then Left "expected Float but got Null (Null ())"+ else Right (x :: Float) , property "Double" $ \ x -> Argo.fromValue (Argo.toValue x) === if isNaN x || isInfinite x- then Argo.Failure "expected Double but got Null (Null ())"- else Argo.Success (x :: Double)+ then Left "expected Double but got Null (Null ())"+ else Right (x :: Double) , property "String" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (Text.unpack $ Text.pack x)+ Argo.fromValue (Argo.toValue x) === Right (Text.unpack $ Text.pack x) , property "Text" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Text.Text)+ Argo.fromValue (Argo.toValue x) === Right (x :: Text.Text) , property "LazyText" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: LazyText.Text)+ Argo.fromValue (Argo.toValue x) === Right (x :: LazyText.Text) , property "Maybe a" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Maybe Bool)+ Argo.fromValue (Argo.toValue x) === Right (x :: Maybe Bool) , property "()" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: ())+ Argo.fromValue (Argo.toValue x) === Right (x :: ()) , property "(a, b)" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: (Bool, Int.Int8))+ Argo.fromValue (Argo.toValue x) === Right (x :: (Bool, Int.Int8)) , property "[a]" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: [Bool])+ Argo.fromValue (Argo.toValue x) === Right (x :: [Bool]) , property "NonEmpty a" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: NonEmpty Bool)+ Argo.fromValue (Argo.toValue x) === Right (x :: NonEmpty Bool) , property "Map Text a" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Map.Map Text.Text Bool)+ Argo.fromValue (Argo.toValue x) === Right (x :: Map.Map Text.Text Bool) , property "Pointer" $ \ x ->- Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Argo.Pointer)+ Argo.fromValue (Argo.toValue x) === Right (x :: Argo.Pointer) ] ] , Tasty.testGroup "Codec" [ Tasty.testCase "encode text" $ do Codec.encodeWith Codec.textCodec "" @?= Argo.String "" , Tasty.testCase "decode text" $ do- Codec.decodeWith Codec.textCodec (Argo.String "") @?= Argo.Success ""+ Codec.decodeWith Codec.textCodec (Argo.String "") @?= Right "" , Tasty.testCase "encode bool" $ do Codec.encodeWith Codec.boolCodec False @?= Argo.Boolean False , Tasty.testCase "decode bool" $ do- Codec.decodeWith Codec.boolCodec (Argo.Boolean False) @?= Argo.Success False+ 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 @?= Argo.Success Nothing- Codec.decodeWith (Codec.maybeCodec Codec.textCodec) (Argo.String "") @?= Argo.Success (Just "")+ Codec.decodeWith (Codec.maybeCodec Codec.textCodec) Argo.Null @?= Right Nothing+ Codec.decodeWith (Codec.maybeCodec Codec.textCodec) (Argo.String "") @?= Right (Just "") , 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] , 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 ""]) @?= Argo.Success (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]) @?= Argo.Success (Right False)+ 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) , Tasty.testCase "encode tuple text bool" $ do Codec.encodeWith (Codec.tupleCodec Codec.textCodec Codec.boolCodec) ("", 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]) @?= Argo.Success ("", False)+ Codec.decodeWith (Codec.tupleCodec Codec.textCodec Codec.boolCodec) (Argo.Array [Argo.String "", Argo.Boolean False]) @?= Right ("", 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 ""] , Tasty.testCase "decode record" $ do- Codec.decodeWith recordCodec (Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False]) @?= Argo.Success (Record False Nothing)- Codec.decodeWith recordCodec (Argo.Object [Argo.Member (Argo.Name "bool") $ Argo.Boolean False, Argo.Member (Argo.Name "text") $ Argo.String ""]) @?= Argo.Success (Record False $ Just "")+ 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 "") ] , Tasty.testGroup "Pointer" $ let pointer = Argo.Pointer . fmap Argo.Token in [ Tasty.testCase "decode" $ do- let decode = resultToMaybe . Argo.decodePointer+ let decode = hush . Argo.decodePointer decode "" @?= Just (pointer []) decode "/" @?= Just (pointer [""]) decode "/a" @?= Just (pointer ["a"])@@ -541,14 +537,14 @@ encode (pointer ["/"]) @?= "/~1" encode (pointer ["~1"]) @?= "/~01" , property "decode . encode" $ \ x ->- (Argo.decodePointer . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encodePointer x) === Argo.Success (x :: Argo.Pointer)+ (Argo.decodePointer . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encodePointer x) === Right (x :: Argo.Pointer) , Tasty.testCase "quasi-quoter" $ do [Argo.pointer||] @?= pointer [] [Argo.pointer|/|] @?= pointer [""] [Argo.pointer|/a|] @?= pointer ["a"] [Argo.pointer|/a/b|] @?= pointer ["a", "b"] , Tasty.testCase "evaluate" $ do- let evaluate p = resultToMaybe . Argo.evaluate p+ let evaluate p = hush . Argo.evaluate p evaluate (pointer []) Argo.Null @?= Just Argo.Null evaluate (pointer ["a"]) (Argo.Object [Argo.Member (Argo.Name "a") Argo.Null]) @?= Just Argo.Null evaluate (pointer ["a", "b"]) (Argo.Object [Argo.Member (Argo.Name "a") $ Argo.Object [Argo.Member (Argo.Name "b") Argo.Null]]) @?= Just Argo.Null@@ -562,15 +558,28 @@ evaluate (pointer ["-"]) (Argo.Array []) @?= Nothing evaluate (pointer ["00"]) (Argo.Array [Argo.Null]) @?= Nothing ]+ , Tasty.testGroup "OverloadedStrings"+ [ Tasty.testCase "Value" $ do+ "" @?= Argo.String ""+ , Tasty.testCase "String" $ do+ "" @?= String.String ""+ , Tasty.testCase "Name" $ do+ "" @?= Argo.Name ""+ , Tasty.testCase "Token" $ do+ "" @?= Argo.Token ""+ ] ] +number :: Integer -> Integer -> Argo.Value+number s = Argo.Number . Argo.Decimal s+ data Record = Record { recordBool :: Bool , recordText :: Maybe Text.Text } deriving (Eq, Show) recordCodec :: Codec.ValueCodec Record-recordCodec = Codec.fromObjectCodec Codec.Allow $ 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) @@ -592,55 +601,5 @@ . Tasty.forAll g $ \ x -> Tasty.shrinking s x f -instance Tasty.Arbitrary Argo.Name where- arbitrary = Argo.Name <$> Tasty.arbitrary- shrink (Argo.Name x) = Argo.Name <$> Tasty.shrink x--instance Tasty.Arbitrary Argo.Member where- arbitrary = Argo.Member <$> Tasty.arbitrary <*> Tasty.arbitrary- shrink (Argo.Member k v) = uncurry Argo.Member <$> Tasty.shrink (k, v)--instance Tasty.Arbitrary Argo.Value where- arbitrary = Tasty.sized genValueSized- shrink x = case x of- Argo.Null -> []- Argo.Boolean y -> Argo.Boolean <$> Tasty.shrink y- Argo.Number y z -> uncurry Argo.Number <$> Tasty.shrink (y, z)- Argo.String y -> Argo.String <$> Tasty.shrink y- Argo.Array y -> Argo.Array <$> Tasty.shrink y- Argo.Object y -> Argo.Object <$> Tasty.shrink y--genValueSized :: Int -> Tasty.Gen Argo.Value-genValueSized size = let newSize = div size 3 in Tasty.oneof- [ pure Argo.Null- , Argo.Boolean <$> Tasty.arbitrary- , Argo.Number <$> Tasty.arbitrary <*> Tasty.arbitrary- , Argo.String <$> Tasty.arbitrary- , Argo.Array <$> Tasty.vectorOf size (genValueSized newSize)- , Argo.Object <$> Tasty.vectorOf size (Argo.Member <$> Tasty.arbitrary <*> genValueSized newSize)- ]--resultToMaybe :: Argo.Result a -> Maybe a-resultToMaybe r = case r of- Argo.Failure _ -> Nothing- Argo.Success x -> Just x--instance Tasty.Arbitrary Text.Text where- arbitrary = Text.pack <$> Tasty.arbitrary- shrink = Tasty.shrinkMap Text.pack Text.unpack--instance Tasty.Arbitrary LazyText.Text where- arbitrary = LazyText.pack <$> Tasty.arbitrary- shrink = Tasty.shrinkMap LazyText.pack LazyText.unpack--instance Tasty.Arbitrary a => Tasty.Arbitrary (NonEmpty a) where- arbitrary = (:|) <$> Tasty.arbitrary <*> Tasty.arbitrary- shrink (x :| xs) = uncurry (:|) <$> Tasty.shrink (x, xs)--instance Tasty.Arbitrary Argo.Pointer where- arbitrary = Argo.Pointer <$> Tasty.arbitrary- shrink (Argo.Pointer x) = Argo.Pointer <$> Tasty.shrink x--instance Tasty.Arbitrary Argo.Token where- arbitrary = Argo.Token <$> Tasty.arbitrary- shrink (Argo.Token x) = Argo.Token <$> Tasty.shrink x+hush :: Either String a -> Maybe a+hush = either (const Nothing) Just