argo 0.2021.10.17 → 0.2021.10.18

raw patch · 10 files changed

+157/−127 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• argo.cabal +3/−1
• source/benchmark/Main.hs +6/−1
• source/executable/Main.hs +2/−2
• source/library/Argo.hs +2/−0
• source/library/Argo/Class/FromValue.hs +41/−69
• source/library/Argo/Decode.hs +7/−5
• source/library/Argo/Decoder.hs +16/−15
• source/library/Argo/QuasiQuoter.hs +7/−4
• source/library/Argo/Result.hs +34/−0
• source/test-suite/Main.hs +39/−30

@@ -1,7 +1,7 @@ cabal-version: 2.2  name: argo-version: 0.2021.10.17+version: 0.2021.10.18  build-type: Simple category: JSON@@ -17,6 +17,7 @@  flag pedantic     default: False+    description: Enables @-Werror@, which turns warnings into errors.     manual: True  common library@@ -66,6 +67,7 @@         Argo.Literal         Argo.Pattern         Argo.QuasiQuoter+        Argo.Result         Argo.Type         Argo.Type.Array         Argo.Type.Boolean

@@ -45,7 +45,7 @@             , Tasty.bench "10000 elements" . Tasty.nf encode . Argo.Object . array . replicate 10000 $ Argo.Pair "" Argo.Null             ]         ]-    , Tasty.bgroup "decode" $ let decode = Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in+    , Tasty.bgroup "decode" $ let decode = resultToMaybe . Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in         [ Tasty.bgroup "Null"             [ Tasty.bench "null" $ Tasty.nf decode "null"             ]@@ -76,3 +76,8 @@  array :: [a] -> Data.Array.Array Int a array xs = Data.Array.listArray (0, length xs - 1) xs++resultToMaybe :: Argo.Result a -> Maybe a+resultToMaybe r = case r of+    Argo.Failure _ -> Nothing+    Argo.Success x -> Just x

@@ -7,5 +7,5 @@ main = do     contents <- ByteString.getContents     case Argo.decode contents of-        Nothing -> fail "invalid JSON"-        Just value -> Builder.hPutBuilder IO.stdout $ Argo.encode (value :: Argo.Value)+        Argo.Failure e -> fail e+        Argo.Success value -> Builder.hPutBuilder IO.stdout $ Argo.encode (value :: Argo.Value)

@@ -17,6 +17,7 @@     , FromValue.FromValue(fromValue)     , ToValue.ToValue(toValue)     , QuasiQuoter.value+    , Result.Result(Failure, Success)     ) where  import qualified Argo.Class.FromValue as FromValue@@ -25,4 +26,5 @@ import qualified Argo.Encode as Encode import qualified Argo.Pattern as Pattern import qualified Argo.QuasiQuoter as QuasiQuoter+import qualified Argo.Result as Result import qualified Argo.Type as Type

@@ -2,8 +2,7 @@  module Argo.Class.FromValue where -import Control.Monad ((<=<))-+import qualified Argo.Result as Result import qualified Argo.Type as Type import qualified Argo.Type.Array as Array import qualified Argo.Type.Boolean as Boolean@@ -22,10 +21,10 @@ import qualified Data.Word as Word  class FromValue a where-    fromValue :: Type.Value -> Maybe a+    fromValue :: Type.Value -> Result.Result a  instance FromValue Type.Value where-    fromValue = Just+    fromValue = Result.Success  instance FromValue Bool where     fromValue = withBoolean "Bool" pure@@ -33,81 +32,43 @@ instance FromValue Char where     fromValue = withString "Char" $ \ x -> case Text.uncons x of         Just (y, z) | Text.null z -> pure y-        _ -> fail "not singleton"+        _ -> fail $ "expected single character but got " <> show x  instance FromValue Int where-    fromValue =-        let-            integerToInt :: Integer -> Maybe Int-            integerToInt = Bits.toIntegralSized-        in integerToInt <=< fromValue+    fromValue = viaInteger  instance FromValue Int.Int8 where-    fromValue =-        let-            integerToInt8 :: Integer -> Maybe Int.Int8-            integerToInt8 = Bits.toIntegralSized-        in integerToInt8 <=< fromValue+    fromValue = viaInteger  instance FromValue Int.Int16 where-    fromValue =-        let-            integerToInt16 :: Integer -> Maybe Int.Int16-            integerToInt16 = Bits.toIntegralSized-        in integerToInt16 <=< fromValue+    fromValue = viaInteger  instance FromValue Int.Int32 where-    fromValue =-        let-            integerToInt32 :: Integer -> Maybe Int.Int32-            integerToInt32 = Bits.toIntegralSized-        in integerToInt32 <=< fromValue+    fromValue = viaInteger  instance FromValue Int.Int64 where-    fromValue =-        let-            integerToInt64 :: Integer -> Maybe Int.Int64-            integerToInt64 = Bits.toIntegralSized-        in integerToInt64 <=< fromValue+    fromValue = viaInteger  instance FromValue Word where-    fromValue =-        let-            integerToWord :: Integer -> Maybe Word-            integerToWord = Bits.toIntegralSized-        in integerToWord <=< fromValue+    fromValue = viaInteger  instance FromValue Word.Word8 where-    fromValue =-        let-            integerToWord8 :: Integer -> Maybe Word.Word8-            integerToWord8 = Bits.toIntegralSized-        in integerToWord8 <=< fromValue+    fromValue = viaInteger  instance FromValue Word.Word16 where-    fromValue =-        let-            integerToWord16 :: Integer -> Maybe Word.Word16-            integerToWord16 = Bits.toIntegralSized-        in integerToWord16 <=< fromValue+    fromValue = viaInteger  instance FromValue Word.Word32 where-    fromValue =-        let-            integerToWord32 :: Integer -> Maybe Word.Word32-            integerToWord32 = Bits.toIntegralSized-        in integerToWord32 <=< fromValue+    fromValue = viaInteger  instance FromValue Word.Word64 where-    fromValue =-        let-            integerToWord64 :: Integer -> Maybe Word.Word64-            integerToWord64 = Bits.toIntegralSized-        in integerToWord64 <=< fromValue+    fromValue = viaInteger  instance FromValue Integer where     fromValue = withNumber "Integer" $ \ x y ->-        if y < 0 then fail "fractional" else pure $ x * 10 ^ y+        if y < 0+        then fail $ "expected integer but got " <> show (Number.number x y)+        else pure $ x * 10 ^ y  instance FromValue Float where     fromValue = withNumber "Float" $ \ x y ->@@ -133,7 +94,7 @@  instance FromValue () where     fromValue x = do-        [] <- fromValue x :: Maybe [Type.Value]+        [] <- fromValue x :: Result.Result [Type.Value]         pure ()  instance (FromValue a, FromValue b) => FromValue (a, b) where@@ -151,8 +112,12 @@             arrayToList = Data.Array.elems         in fmap arrayToList . fromValue -instance FromValue a => FromValue (NonEmpty.NonEmpty a) where-    fromValue = NonEmpty.nonEmpty <=< fromValue+instance (FromValue a, Show a) => FromValue (NonEmpty.NonEmpty a) where+    fromValue value = do+        list <- fromValue value+        case NonEmpty.nonEmpty list of+            Nothing -> fail $ "expected non-empty list but got " <> show list+            Just nonEmpty -> pure nonEmpty  instance FromValue a => FromValue (Map.Map Text.Text a) where     fromValue = withObject "Map"@@ -160,27 +125,34 @@         . traverse (\ (Pair.Pair (String.String k, v)) -> (,) k <$> fromValue v)         . Data.Array.elems -withBoolean :: String -> (Bool -> Maybe a) -> Type.Value -> Maybe a+withBoolean :: String -> (Bool -> Result.Result a) -> Type.Value -> Result.Result a withBoolean s f x = case x of     Value.Boolean (Boolean.Boolean y) -> f y-    _ -> fail s+    _ -> fail $ "expected " <> s <> " but got " <> show x -withNumber :: String -> (Integer -> Integer -> Maybe a) -> Type.Value -> Maybe a+withNumber :: String -> (Integer -> Integer -> Result.Result a) -> Type.Value -> Result.Result a withNumber s f x = case x of     Value.Number (Number.Number y z) -> f y z-    _ -> fail s+    _ -> fail $ "expected " <> s <> " but got " <> show x -withString :: String -> (Text.Text -> Maybe a) -> Type.Value -> Maybe a+withString :: String -> (Text.Text -> Result.Result a) -> Type.Value -> Result.Result a withString s f x = case x of     Value.String (String.String y) -> f y-    _ -> fail s+    _ -> fail $ "expected " <> s <> " but got " <> show x -withArray :: String -> (Data.Array.Array Int Type.Value -> Maybe a) -> Type.Value -> Maybe a+withArray :: String -> (Data.Array.Array Int Type.Value -> Result.Result a) -> Type.Value -> Result.Result a withArray s f x = case x of     Value.Array (Array.Array y) -> f y-    _ -> fail s+    _ -> fail $ "expected " <> s <> " but got " <> show x -withObject :: String -> (Data.Array.Array Int (Pair.Pair String.String Type.Value) -> Maybe a) -> Type.Value -> Maybe a+withObject :: String -> (Data.Array.Array Int (Pair.Pair String.String Type.Value) -> Result.Result a) -> Type.Value -> Result.Result a withObject s f x = case x of     Value.Object (Object.Object y) -> f y-    _ -> fail s+    _ -> fail $ "expected " <> s <> " but got " <> show x++viaInteger :: (Integral a, Bits.Bits a) => Type.Value -> Result.Result a+viaInteger value = do+    integer <- fromValue value+    case Bits.toIntegralSized (integer :: Integer) of+        Nothing -> fail $ "integer out of bounds " <> show integer+        Just x -> pure x

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

@@ -1,6 +1,7 @@ module Argo.Decoder where  import qualified Argo.Literal as Literal+import qualified Argo.Result as Result import qualified Control.Applicative as Applicative import qualified Control.Monad as Monad import qualified Data.Array as Array@@ -8,35 +9,35 @@ import qualified Data.Word as Word  newtype Decoder a = Decoder-    { run :: ByteString.ByteString -> Maybe (ByteString.ByteString, a)+    { run :: ByteString.ByteString -> Result.Result (ByteString.ByteString, a)     }  instance Functor Decoder where     fmap f d = Decoder $ \ b1 -> case run d b1 of-        Nothing -> Nothing-        Just (b2, x) -> Just (b2, f x)+        Result.Failure e -> Result.Failure e+        Result.Success (b2, x) -> Result.Success (b2, f x)  instance Applicative Decoder where-    pure x = Decoder $ \ b -> Just (b, x)+    pure x = Decoder $ \ b -> Result.Success (b, x)     df <*> dx = Decoder $ \ b1 -> case run df b1 of-        Nothing -> Nothing-        Just (b2, f) -> case run dx b2 of-            Nothing -> Nothing-            Just (b3, x) -> Just (b3, f x)+        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-        Nothing -> Nothing-        Just (b2, x) -> run (f x) b2+        Result.Failure e -> Result.Failure e+        Result.Success (b2, x) -> run (f x) b2  instance MonadFail Decoder where-    fail _ = Decoder $ const Nothing+    fail = Decoder . const . Result.Failure  instance Applicative.Alternative Decoder where     empty = fail "empty"     dx <|> dy = Decoder $ \ b1 -> case run dx b1 of-        Nothing -> run dy b1-        Just (b2, x) -> Just (b2, x)+        Result.Failure _ -> run dy b1+        Result.Success (b2, x) -> Result.Success (b2, x)  array :: Decoder a -> Decoder (Array.Array Int a) array f = arrayWith f 0 []@@ -70,7 +71,7 @@     Monad.unless (ByteString.null b) $ fail "eof"  get :: Decoder ByteString.ByteString-get = Decoder $ \ b -> Just (b, b)+get = Decoder $ \ b -> Result.Success (b, b)  isDigit :: Word.Word8 -> Bool isDigit x = Literal.digitZero <= x && x <= Literal.digitNine@@ -83,7 +84,7 @@     || x == Literal.carriageReturn  put :: ByteString.ByteString -> Decoder ()-put b = Decoder $ \ _ -> Just (b, ())+put b = Decoder $ \ _ -> Result.Success (b, ())  satisfy :: (Word.Word8 -> Bool) -> Decoder Word.Word8 satisfy f = do

@@ -1,6 +1,7 @@ module Argo.QuasiQuoter where  import qualified Argo.Decode as Decode+import qualified Argo.Result as Result import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Language.Haskell.TH.Quote as QQ@@ -9,10 +10,12 @@ value :: QQ.QuasiQuoter value = QQ.QuasiQuoter     { QQ.quoteDec = const $ fail "quoteDec"-    , QQ.quoteExp = maybe (fail "invalid JSON") TH.lift-        . Decode.decodeWith pure-        . Text.encodeUtf8-        . Text.pack+    , QQ.quoteExp = quoteExp     , QQ.quotePat = const $ fail "quotePat"     , QQ.quoteType = const $ fail "quoteType"     }++quoteExp :: String -> TH.Q TH.Exp+quoteExp x = case Decode.decodeWith pure . Text.encodeUtf8 $ Text.pack x of+    Result.Failure e -> fail e+    Result.Success y -> TH.lift y

@@ -0,0 +1,34 @@+module Argo.Result where++import qualified Control.Applicative as Applicative++data Result a+    = Failure String+    | Success a+    deriving (Eq, 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

@@ -99,7 +99,7 @@                 encode (Argo.Object (array [Argo.Pair "a" $ Argo.Number 1 0, Argo.Pair "b" $ Argo.Number 2 0])) @?= "{\"a\":1,\"b\":2}"             ]         ]-    , Tasty.testGroup "decode" $ let decode = Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in+    , Tasty.testGroup "decode" $ let decode = resultToMaybe . Argo.decode :: ByteString.ByteString -> Maybe Argo.Value in         [ Tasty.testGroup "Null"             [ Tasty.testCase "null" $ do                 decode "null" @?= Just Argo.Null@@ -289,59 +289,63 @@                 decode "{1:2}" @?= Nothing             ]         ]-    , Tasty.testGroup "fromValue"+    , Tasty.testGroup "fromValue" $+        let+            fromValue :: Argo.FromValue a => Argo.Value -> Maybe a+            fromValue = resultToMaybe . Argo.fromValue+        in         [ Tasty.testCase "Value" $ do-            Argo.fromValue Argo.Null @?= Just Argo.Null+            fromValue Argo.Null @?= Just Argo.Null         , Tasty.testCase "Bool" $ do-            Argo.fromValue (Argo.Boolean False) @?= Just False+            fromValue (Argo.Boolean False) @?= Just False         , Tasty.testCase "Char" $ do-            Argo.fromValue (Argo.String "a") @?= Just 'a'+            fromValue (Argo.String "a") @?= Just 'a'         , Tasty.testCase "Int" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Int)         , Tasty.testCase "Int8" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int8)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int8)         , Tasty.testCase "Int16" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int16)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int16)         , Tasty.testCase "Int32" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int32)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int32)         , Tasty.testCase "Int64" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int64)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Int.Int64)         , Tasty.testCase "Word" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Word)         , Tasty.testCase "Word8" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word8)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word8)         , Tasty.testCase "Word16" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word16)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word16)         , Tasty.testCase "Word32" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word32)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word32)         , Tasty.testCase "Word64" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word64)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Word.Word64)         , Tasty.testCase "Integer" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Integer)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Integer)         , Tasty.testCase "Float" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Float)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Float)         , Tasty.testCase "Double" $ do-            Argo.fromValue (Argo.Number 0 0) @?= Just (0 :: Double)+            fromValue (Argo.Number 0 0) @?= Just (0 :: Double)         , Tasty.testCase "String" $ do-            Argo.fromValue (Argo.String "") @?= Just ("" :: String)+            fromValue (Argo.String "") @?= Just ("" :: String)         , Tasty.testCase "Text" $ do-            Argo.fromValue (Argo.String "") @?= Just ("" :: Text.Text)+            fromValue (Argo.String "") @?= Just ("" :: Text.Text)         , Tasty.testCase "LazyText" $ do-            Argo.fromValue (Argo.String "") @?= Just ("" :: LazyText.Text)+            fromValue (Argo.String "") @?= Just ("" :: LazyText.Text)         , Tasty.testCase "Maybe a" $ do-            Argo.fromValue (Argo.Boolean False) @?= Just (Just False)+            fromValue (Argo.Boolean False) @?= Just (Just False)         , Tasty.testCase "()" $ do-            Argo.fromValue (Argo.Array $ array []) @?= Just ()+            fromValue (Argo.Array $ array []) @?= Just ()         , Tasty.testCase "(a, b)" $ do-            Argo.fromValue (Argo.Array $ array [Argo.Boolean False, Argo.String "a"]) @?= Just (False, 'a')+            fromValue (Argo.Array $ array [Argo.Boolean False, Argo.String "a"]) @?= Just (False, 'a')         , Tasty.testCase "Array Int a" $ do-            Argo.fromValue (Argo.Array $ array []) @?= Just (array [] :: Array.Array Int Bool)+            fromValue (Argo.Array $ array []) @?= Just (array [] :: Array.Array Int Bool)         , Tasty.testCase "[a]" $ do-            Argo.fromValue (Argo.Array $ array []) @?= Just ([] :: [Bool])+            fromValue (Argo.Array $ array []) @?= Just ([] :: [Bool])         , Tasty.testCase "NonEmpty a" $ do-            Argo.fromValue (Argo.Array $ array [Argo.Boolean False]) @?= Just (False :| [])+            fromValue (Argo.Array $ array [Argo.Boolean False]) @?= Just (False :| [])         , Tasty.testCase "Map Text a" $ do-            Argo.fromValue (Argo.Object $ array [Argo.Pair "a" $ Argo.Boolean False]) @?= Just (Map.fromList [("a" :: Text.Text, False)])+            fromValue (Argo.Object $ array [Argo.Pair "a" $ Argo.Boolean False]) @?= Just (Map.fromList [("a" :: Text.Text, False)])         ]     , Tasty.testGroup "toValue"         [ Tasty.testCase "Value" $ do@@ -413,9 +417,9 @@         ]     , Tasty.testGroup "property"         [ Tasty.testProperty "decode . encode" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->-            (Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode y) === Just y+            (resultToMaybe . Argo.decode . LazyByteString.toStrict . Builder.toLazyByteString $ Argo.encode y) === Just y         , Tasty.testProperty "fromValue . toValue" . Tasty.forAll genValue $ \ x -> Tasty.shrinking shrinkValue x $ \ y ->-            Argo.fromValue (Argo.toValue y) === Just y+            (resultToMaybe . Argo.fromValue $ Argo.toValue y) === Just y         ]     ] @@ -457,3 +461,8 @@  shrinkArray :: Shrink a -> Shrink (Array.Array Int a) shrinkArray = Tasty.shrinkMapBy array Array.elems . Tasty.shrinkList++resultToMaybe :: Argo.Result a -> Maybe a+resultToMaybe r = case r of+    Argo.Failure _ -> Nothing+    Argo.Success x -> Just x