packages feed

argo 0.2021.10.24 → 0.2021.11.2

raw patch · 13 files changed

+459/−70 lines, 13 filesdep −genvaliditydep −genvalidity-containersdep −genvalidity-textdep ~basedep ~bytestringdep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: genvalidity, genvalidity-containers, genvalidity-text

Dependency ranges changed: base, bytestring, template-haskell

API changes (from Hackage documentation)

- Argo.Literal: digitOne :: Word8
+ 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.Json.Array: fromList :: [value] -> ArrayOf value
+ Argo.Json.Array: toList :: ArrayOf value -> [value]
+ Argo.Json.Boolean: fromBool :: Bool -> Boolean
+ Argo.Json.Boolean: toBool :: Boolean -> Bool
+ Argo.Json.Name: fromString :: String -> Name
+ Argo.Json.Name: toString :: Name -> String
+ Argo.Json.Null: fromUnit :: () -> Null
+ Argo.Json.Null: toUnit :: Null -> ()
+ Argo.Json.Object: fromList :: [MemberOf value] -> ObjectOf value
+ Argo.Json.Object: toList :: ObjectOf value -> [MemberOf value]
+ Argo.Json.String: fromText :: Text -> String
+ Argo.Json.String: toText :: String -> Text

Files

argo.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.2  name: argo-version: 0.2021.10.24+version: 0.2021.11.2  build-type: Simple category: JSON@@ -23,11 +23,11 @@  common library     build-depends:-        , base >= 4.14.0 && < 4.16-        , bytestring >= 0.10.12 && < 0.11+        , base >= 4.14.0 && < 4.17+        , bytestring >= 0.10.12 && < 0.12         , containers >= 0.6.4 && < 0.7         , deepseq >= 1.4.4 && < 1.5-        , template-haskell >= 2.16.0 && < 2.18+        , template-haskell >= 2.16.0 && < 2.19         , text >= 1.2.4 && < 1.3         , transformers >= 0.5.6 && < 0.6     default-language: Haskell2010@@ -35,6 +35,7 @@         -Weverything         -Wno-all-missed-specialisations         -Wno-implicit-prelude+        -Wno-missed-specialisations         -Wno-missing-deriving-strategies         -Wno-missing-export-lists         -Wno-missing-exported-signatures@@ -46,6 +47,11 @@     if flag(pedantic)         ghc-options: -Werror +    if impl(ghc >= 9.2)+        ghc-options:+            -Wno-implicit-lift+            -Wno-missing-kind-signatures+ common executable     import: library @@ -63,6 +69,7 @@         Argo         Argo.Class.FromValue         Argo.Class.ToValue+        Argo.Codec         Argo.Decode         Argo.Decoder         Argo.Encode@@ -101,9 +108,6 @@     import: executable      build-depends:-        , genvalidity >= 0.11.0 && < 0.12-        , genvalidity-containers >= 0.9.0 && < 0.10-        , genvalidity-text >= 0.7.0 && < 0.8         , tasty >= 1.4.2 && < 1.5         , tasty-hunit >= 0.10.0 && < 0.11         , tasty-quickcheck >= 0.10.1 && < 0.11
+ source/library/Argo/Codec.hs view
@@ -0,0 +1,303 @@+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/Encode.hs view
@@ -15,8 +15,9 @@ encodeWith :: ToValue.ToValue a => Encoder.Indent -> a -> Builder.Builder encodeWith i x =     let c = Encoder.Config { Encoder.indent = i, Encoder.level = 0 }-    in Identity.runIdentity-    . Trans.execWriterT+    in snd+    . Identity.runIdentity+    . Trans.runWriterT     . flip Trans.runReaderT c     $ do         Value.encode $ ToValue.toValue x
source/library/Argo/Encoder.hs view
@@ -37,7 +37,7 @@         c <- Trans.ask         let newLine = if hasIndent c then Builder.word8 Literal.newLine else mempty         Trans.local increaseLevel $ do-            i <- Trans.asks makeIndent+            i <- makeIndent <$> Trans.ask             Trans.lift . Trans.tell $ newLine <> i             f x             Monad.forM_ ys $ \ y -> do
source/library/Argo/Json/Array.hs view
@@ -17,13 +17,19 @@     = Array [value]     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +fromList :: [value] -> ArrayOf value+fromList = Array++toList :: ArrayOf value -> [value]+toList (Array x) = x+ encode :: (value -> Encoder.Encoder ()) -> ArrayOf value -> Encoder.Encoder ()-encode f (Array xs) = Encoder.list+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-    xs+    . toList  decode :: Decoder.Decoder value -> Decoder.Decoder (ArrayOf value) decode f = do@@ -32,4 +38,4 @@     xs <- Decoder.list f     Decoder.word8 Literal.rightSquareBracket     Decoder.spaces-    pure $ Array xs+    pure $ fromList xs
source/library/Argo/Json/Boolean.hs view
@@ -19,17 +19,23 @@     = Boolean Bool     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +fromBool :: Bool -> Boolean+fromBool = Boolean++toBool :: Boolean -> Bool+toBool (Boolean x) = x+ encode :: Boolean -> Encoder.Encoder ()-encode (Boolean x) = Trans.lift+encode x = Trans.lift     . Trans.tell     . Builder.byteString-    $ if x then Literal.true else Literal.false+    $ if toBool x then Literal.true else Literal.false  decode :: Decoder.Decoder Boolean decode = decodeFalse <|> decodeTrue  decodeFalse :: Decoder.Decoder Boolean-decodeFalse = Boolean False <$ Decoder.byteString Literal.false <* Decoder.spaces+decodeFalse = fromBool False <$ Decoder.byteString Literal.false <* Decoder.spaces  decodeTrue :: Decoder.Decoder Boolean-decodeTrue = Boolean True <$ Decoder.byteString Literal.true <* Decoder.spaces+decodeTrue = fromBool True <$ Decoder.byteString Literal.true <* Decoder.spaces
source/library/Argo/Json/Name.hs view
@@ -15,8 +15,14 @@     = Name String.String     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +fromString :: String.String -> Name+fromString = Name++toString :: Name -> String.String+toString (Name x) = x+ encode :: Name -> Encoder.Encoder ()-encode (Name x) = String.encode x+encode = String.encode . toString  decode :: Decoder.Decoder Name-decode = Name <$> String.decode+decode = fromString <$> String.decode
source/library/Argo/Json/Null.hs view
@@ -17,8 +17,14 @@     = Null ()     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +fromUnit :: () -> Null+fromUnit = Null++toUnit :: Null -> ()+toUnit (Null x) = x+ encode :: Null -> Encoder.Encoder () encode = const . Trans.lift . Trans.tell $ Builder.byteString Literal.null  decode :: Decoder.Decoder Null-decode = Null () <$ Decoder.byteString Literal.null <* Decoder.spaces+decode = fromUnit () <$ Decoder.byteString Literal.null <* Decoder.spaces
source/library/Argo/Json/Object.hs view
@@ -19,13 +19,19 @@     = Object [Member.MemberOf value]     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +fromList :: [Member.MemberOf value] -> ObjectOf value+fromList = Object++toList :: ObjectOf value -> [Member.MemberOf value]+toList (Object x) = x+ encode :: (value -> Encoder.Encoder ()) -> ObjectOf value -> Encoder.Encoder ()-encode f (Object xs) = Encoder.list+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)-    xs+    . toList  encodeElement :: (value -> Encoder.Encoder ()) -> Int -> Member.MemberOf value -> Encoder.Encoder () encodeElement f i x = do@@ -39,4 +45,4 @@     xs <- Decoder.list $ Member.decode f     Decoder.word8 Literal.rightCurlyBracket     Decoder.spaces-    pure $ Object xs+    pure $ fromList xs
source/library/Argo/Json/String.hs view
@@ -22,11 +22,17 @@     = String Text.Text     deriving (Eq, Generics.Generic, TH.Lift, DeepSeq.NFData, Show) +fromText :: Text.Text -> Argo.Json.String.String+fromText = String++toText :: Argo.Json.String.String -> Text.Text+toText (String x) = x+ encode :: Argo.Json.String.String -> Encoder.Encoder ()-encode (String x) = Trans.lift+encode x = Trans.lift     . Trans.tell     $ Builder.word8 Literal.quotationMark-    <> Text.encodeUtf8BuilderEscaped encodeChar x+    <> Text.encodeUtf8BuilderEscaped encodeChar (toText x)     <> Builder.word8 Literal.quotationMark  encodeChar :: Builder.BoundedPrim Word.Word8@@ -73,7 +79,7 @@         Left e -> fail $ show e         Right x -> case unescapeText x of             Nothing -> fail "invalid escape"-            Just y -> pure $ String y+            Just y -> pure $ fromText y  findAt :: Word.Word8 -> Int -> ByteString.ByteString -> Maybe Int findAt x i = fmap (+ i) . ByteString.elemIndex x . ByteString.drop i
source/library/Argo/Literal.hs view
@@ -18,9 +18,6 @@ digitNine :: Word.Word8 digitNine = 0x39 -digitOne :: Word.Word8-digitOne = 0x31- digitZero :: Word.Word8 digitZero = 0x30 
source/library/Argo/Vendor/Transformers.hs view
@@ -1,15 +1,26 @@ module Argo.Vendor.Transformers-    ( ReaderT.ReaderT+    ( ExceptT.ExceptT+    , MaybeT.MaybeT+    , ReaderT.ReaderT+    , StateT.StateT     , WriterT.WriterT     , ReaderT.ask-    , ReaderT.asks-    , WriterT.execWriterT+    , StateT.get     , Trans.lift     , ReaderT.local+    , StateT.put+    , ExceptT.runExceptT+    , MaybeT.runMaybeT     , ReaderT.runReaderT+    , StateT.runStateT+    , WriterT.runWriterT     , WriterT.tell+    , ExceptT.throwE     ) where  import qualified Control.Monad.Trans.Class as Trans+import qualified Control.Monad.Trans.Except as ExceptT+import qualified Control.Monad.Trans.Maybe as MaybeT import qualified Control.Monad.Trans.Reader as ReaderT+import qualified Control.Monad.Trans.State as StateT import qualified Control.Monad.Trans.Writer as WriterT
source/test-suite/Main.hs view
@@ -4,17 +4,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -import Data.GenValidity.Map ()-import Data.GenValidity.Text () import Data.List.NonEmpty (NonEmpty((:|))) import Test.Tasty.HUnit ((@?=)) import Test.Tasty.QuickCheck ((===))  import qualified Argo+import qualified Argo.Codec as Codec import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LazyByteString-import qualified Data.GenValidity as GenValidity import qualified Data.Int as Int import qualified Data.Map as Map import qualified Data.Text as Text@@ -480,14 +478,56 @@                 Argo.fromValue (Argo.toValue x) === Argo.Success (x :: Map.Map Text.Text Bool)             ]         ]+    , 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 ""+        , 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+        , 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 "")+        , 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)+        , 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)+        , 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 "")+        ]     ] +data Record = Record+    { recordBool :: Bool+    , recordText :: Maybe Text.Text+    } deriving (Eq, Show)++recordCodec :: Codec.ValueCodec Record+recordCodec = Codec.fromObjectCodec Codec.Allow $ Record+    <$> Codec.project recordBool (Codec.required (Argo.Name "bool") Codec.boolCodec)+    <*> Codec.project recordText (Codec.optional (Argo.Name "text") Codec.textCodec)+ property-    :: (Show t, Tasty.Testable prop, GenValidity.GenValid t)+    :: (Show t, Tasty.Testable prop, Tasty.Arbitrary t)     => Tasty.TestName     -> (t -> prop)     -> Tasty.TestTree-property n = propertyWith n GenValidity.genValid GenValidity.shrinkValid+property n = propertyWith n Tasty.arbitrary Tasty.shrink  propertyWith     :: (Show t, Tasty.Testable prop)@@ -500,50 +540,47 @@     . Tasty.forAll g     $ \ x -> Tasty.shrinking s x f -instance GenValidity.Validity Argo.Name where-    validate (Argo.Name x) = GenValidity.validate x--instance GenValidity.GenValid Argo.Name where-    genValid = Argo.Name <$> GenValidity.genValid-    shrinkValid (Argo.Name x) = Argo.Name <$> GenValidity.shrinkValid x--instance GenValidity.Validity Argo.Member where-    validate (Argo.Member k v) = GenValidity.validate (k, v)--instance GenValidity.GenValid Argo.Member where-    genValid = Argo.Member <$> GenValidity.genValid <*> GenValidity.genValid-    shrinkValid (Argo.Member k v) = uncurry Argo.Member <$> GenValidity.shrinkValid (k, v)+instance Tasty.Arbitrary Argo.Name where+    arbitrary = Argo.Name <$> Tasty.arbitrary+    shrink (Argo.Name x) = Argo.Name <$> Tasty.shrink x -instance GenValidity.Validity Argo.Value where-    validate x = case x of-        Argo.Null -> GenValidity.valid-        Argo.Boolean y -> GenValidity.annotate y "Boolean"-        Argo.Number y z -> GenValidity.annotate (y, z) "Number"-        Argo.String y -> GenValidity.annotate y "String"-        Argo.Array y -> GenValidity.annotate y "Array"-        Argo.Object y -> GenValidity.annotate y "Object"+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 GenValidity.GenValid Argo.Value where-    genValid = Tasty.sized genValueSized-    shrinkValid x = case x of+instance Tasty.Arbitrary Argo.Value where+    arbitrary = Tasty.sized genValueSized+    shrink x = case x of         Argo.Null -> []-        Argo.Boolean y -> Argo.Boolean <$> GenValidity.shrinkValid y-        Argo.Number y z -> uncurry Argo.Number <$> GenValidity.shrinkValid (y, z)-        Argo.String y -> Argo.String <$> GenValidity.shrinkValid y-        Argo.Array y -> Argo.Array <$> GenValidity.shrinkValid y-        Argo.Object y -> Argo.Object <$> GenValidity.shrinkValid y+        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 <$> GenValidity.genValid-    , Argo.Number <$> GenValidity.genValid <*> GenValidity.genValid-    , Argo.String <$> GenValidity.genValid+    , 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 <$> GenValidity.genValid <*> 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)