From 1603621d2e9c1d09a5b3c39c224221e089f11e2a Mon Sep 17 00:00:00 2001 From: Sean Chalmers Date: Tue, 20 Nov 2018 13:27:05 +1000 Subject: [PATCH 1/3] Add new decoder and tests --- changelog.md | 4 +++ src/Waargonaut/Decode.hs | 55 ++++++++++++++++++++++++++++++++++++---- test/Decoder.hs | 23 ++++++++++++----- waargonaut.cabal | 2 +- waargonaut.nix | 2 +- 5 files changed, 72 insertions(+), 14 deletions(-) diff --git a/changelog.md b/changelog.md index c1e3c19..7ff3184 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ # Revision history for waargonaut +## 0.4.1.0 -- 2018-11-20 + +* Add `oneOf` decoder and tests + ## 0.4.0.0 -- 2018-11-19 * Redesign & rebuild of `Encoder` internals to allow for greater control and flexibility diff --git a/src/Waargonaut/Decode.hs b/src/Waargonaut/Decode.hs index 71c44b2..a533391 100644 --- a/src/Waargonaut/Decode.hs +++ b/src/Waargonaut/Decode.hs @@ -77,6 +77,7 @@ module Waargonaut.Decode , withDefault , maybeOrNull , either + , oneOf ) where @@ -90,7 +91,7 @@ import Control.Lens (Cons, Lens', Prism', (^.), _Wrapped) import Prelude (Bool, Bounded, Char, - Int, Integral, + Eq, Int, Integral, String, fromIntegral, (-), (==)) @@ -110,15 +111,16 @@ import Control.Error.Util (note) import Control.Monad.Error.Hoist ((), ()) import Data.Either (Either (..)) -import Data.Foldable (foldl) +import Data.Foldable (Foldable, foldl, + foldr) import Data.Function (const, flip, ($), (&)) -import Data.Functor (fmap, (<$), (<$>)) +import Data.Functor (Functor, fmap, (<$), + (<$>)) import Data.Functor.Alt (()) import Data.Functor.Identity (Identity, runIdentity) import Data.Monoid (mempty) - import Data.Scientific (Scientific) import Data.List.NonEmpty (NonEmpty ((:|))) @@ -500,7 +502,7 @@ atCursor m c = withCursor $ \curs -> do -- movements. This lets you combine arbitrary cursor movements with an accumulating -- function. -- --- The functions 'leftwardCons' and 'rightwardSnoc' are both impelemented using +-- The functions 'leftwardCons' and 'rightwardSnoc' are both implemented using -- this function. -- -- @ @@ -525,6 +527,49 @@ foldCursor nom f s elemD curs = DecodeResult . ReaderT $ \p -> (DI.Decoder' $ runDecoder elemD p) curs +-- | Helper function for "pattern matching" on a decoded value to some Haskell +-- value. The 'Text' argument is used in the error message should this decoder +-- fail. Normally it would simply be the name of the type you are writing the +-- decoder for. +-- +-- This is useful for decoding sum types, such as: +-- +-- @ +-- data MyEnum +-- = A +-- | B +-- | C +-- +-- decodeMyEnum :: Monad f => Decoder f MyEnum +-- decodeMyEnum = D.oneOf D.text "MyEnum" +-- [ ("a", A) +-- , ("b", B) +-- , ("c", C) +-- ] +-- +-- decodeMyEnumFromInt :: Monad f => Decoder f MyEnum +-- decodeMyEnumFromInt = D.oneOf D.int "MyEnum" +-- [ (1, A) +-- , (2, B) +-- , (3, C) +-- ] +-- @ +-- +oneOf + :: ( Foldable g + , Functor g + , Monad f + , Eq a + ) + => Decoder f a + -> Text + -> g (a, b) + -> Decoder f b +oneOf d l = foldr () err + . fmap (\(a,b) -> d >>= \t -> if t == a then pure b else err) + where + err = throwError (ConversionFailure l) + -- | From the current cursor position, move leftwards one position at a time and -- push each 'a' onto the front of some 'Cons' structure. leftwardCons diff --git a/test/Decoder.hs b/test/Decoder.hs index bda612a..da46863 100644 --- a/test/Decoder.hs +++ b/test/Decoder.hs @@ -8,10 +8,9 @@ module Decoder import Prelude (Char, Eq, Int, Show, String, print, (==)) -import Control.Applicative (liftA3, pure, (<$>)) +import Control.Applicative (liftA3, (<$>)) import Control.Category ((.)) import Control.Monad (Monad, (>=>), (>>=)) -import Control.Monad.Except (throwError) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (Assertion, assertBool, assertEqual, @@ -46,6 +45,7 @@ decoderTests = testGroup "Decoding" , testCase "(Char,String,[Int])" decodeTest3Json , testCase "Fail with Bad Key" decodeTestBadObjKey , testCase "Fail with Missing Key" decodeTestMissingObjKey + , testCase "Enum" decodeTestEnum , testCase "Enum and throwError" decodeTestEnumError , testCase "Using Alt" decodeAlt , testCase "Using Alt (Error) - Records BranchFail" decodeAltError @@ -145,11 +145,20 @@ data MyEnum deriving (Eq, Show) decodeMyEnum :: Monad f => D.Decoder f MyEnum -decodeMyEnum = D.text >>= \case - "a" -> pure A - "b" -> pure B - "c" -> pure C - _ -> throwError (D.ConversionFailure "MyEnum") +decodeMyEnum = D.oneOf D.text "MyEnum" + [ ("a", A) + , ("b", B) + , ("c", C) + ] + +decodeTestEnum :: Assertion +decodeTestEnum = do + chk "\"a\"" A + chk "\"b\"" B + chk "\"c\"" C + where + chk i o = + D.runPureDecode decodeMyEnum parseBS (D.mkCursor i) @?= (Either.Right o) decodeTestEnumError :: Assertion decodeTestEnumError = D.runDecode decodeMyEnum parseBS (D.mkCursor "\"WUT\"") diff --git a/waargonaut.cabal b/waargonaut.cabal index 47b35f2..a0999e3 100644 --- a/waargonaut.cabal +++ b/waargonaut.cabal @@ -10,7 +10,7 @@ name: waargonaut -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.4.0.0 +version: 0.4.1.0 -- A short (one-line) description of the package. synopsis: JSON wrangling diff --git a/waargonaut.nix b/waargonaut.nix index 3e728ed..62809ea 100644 --- a/waargonaut.nix +++ b/waargonaut.nix @@ -10,7 +10,7 @@ }: mkDerivation { pname = "waargonaut"; - version = "0.4.0.0"; + version = "0.4.1.0"; src = ./.; setupHaskellDepends = [ base Cabal cabal-doctest ]; libraryHaskellDepends = [ From eae681821324681185bde60acf91482418ac9cfc Mon Sep 17 00:00:00 2001 From: Sean Chalmers Date: Tue, 20 Nov 2018 13:41:20 +1000 Subject: [PATCH 2/3] Rewrite oneOf without Functor constraint --- src/Waargonaut/Decode.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Waargonaut/Decode.hs b/src/Waargonaut/Decode.hs index a533391..2f8c609 100644 --- a/src/Waargonaut/Decode.hs +++ b/src/Waargonaut/Decode.hs @@ -557,7 +557,6 @@ foldCursor nom f s elemD curs = DecodeResult . ReaderT $ \p -> -- oneOf :: ( Foldable g - , Functor g , Monad f , Eq a ) @@ -565,9 +564,10 @@ oneOf -> Text -> g (a, b) -> Decoder f b -oneOf d l = foldr () err - . fmap (\(a,b) -> d >>= \t -> if t == a then pure b else err) +oneOf d l = + foldr (\i x -> g i x) err where + g (a,b) = d >>= \t -> if t == a then pure b else err err = throwError (ConversionFailure l) -- | From the current cursor position, move leftwards one position at a time and From 3f2df82ff84bb4dd9ad5fb90f565fc16505dfe4e Mon Sep 17 00:00:00 2001 From: Sean Chalmers Date: Tue, 20 Nov 2018 13:43:56 +1000 Subject: [PATCH 3/3] Functor import redundant, fixed. --- src/Waargonaut/Decode.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Waargonaut/Decode.hs b/src/Waargonaut/Decode.hs index 2f8c609..1f0e171 100644 --- a/src/Waargonaut/Decode.hs +++ b/src/Waargonaut/Decode.hs @@ -115,8 +115,7 @@ import Data.Foldable (Foldable, foldl, foldr) import Data.Function (const, flip, ($), (&)) -import Data.Functor (Functor, fmap, (<$), - (<$>)) +import Data.Functor (fmap, (<$), (<$>)) import Data.Functor.Alt (()) import Data.Functor.Identity (Identity, runIdentity)