unjson 0.15.0.0 → 0.15.1.0
raw patch · 4 files changed
+101/−67 lines, 4 filesdep ~aesonPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson
API changes (from Hackage documentation)
+ Data.Unjson: arrayWithModeOf' :: (FromJSON a, ToJSON a, Typeable a) => ArrayMode -> UnjsonDef [a]
Files
- CHANGELOG.md +25/−0
- src/Data/Unjson.hs +44/−40
- test/Test.hs +28/−25
- unjson.cabal +4/−2
CHANGELOG.md view
@@ -1,6 +1,31 @@+# unjson-0.15.1.0 (2018-03-05)+* -Wall police.+* API addition: arrayWithModeOf'.+ # unjson-0.15.0.0 (2018-02-22) * Breaking change: Unjson definitions now require the underlying types to have Typeable instances ([#6](https://github.com/scrive/unjson/pull/6)). * Added a way to automatically derive Unjson definitions for parameterless sum types (`enumUnjsonDef`) ([#7](https://github.com/scrive/unjson/pull/7)). * Dropped support for GHC < 7.8.++# unjson-0.14.1.3 (2017-04-24)+* Bumped the dependency on aeson+* Fixed the test suite on GHC 7.10.3++# unjson-0.14.1.2 (2017-04-11)+* Bumped the dependency on aeson++# unjson-0.14.1.1 (2017-02-28)+* Adjusting tests++# unjson-0.14.1.0 (2017-02-28)+* Changed (>>=) to prevent error unpacking++# unjson-0.14.0.1 (2016-09-21)+* add README.md to extra-source-files+* relax the constraint on aeson++# unjson-0.14 (2016-09-21)+* initial release+* fix compilation with aeson-1.0
src/Data/Unjson.hs view
@@ -1,3 +1,4 @@+ {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-}@@ -116,6 +117,7 @@ -- ** Arrays , arrayOf , arrayWithModeOf+, arrayWithModeOf' , arrayWithPrimaryKeyOf , arrayWithModeAndPrimaryKeyOf , ArrayMode(..)@@ -152,12 +154,10 @@ where import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Text as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Builder as Builder import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as LazyText import qualified Data.Vector as Vector import qualified Data.Vector.Storable@@ -171,24 +171,22 @@ import qualified Data.HashSet as HashSet import Data.Typeable import Data.Data-import Data.Monoid import Data.Maybe+import Data.Monoid import Data.Primitive.Types import Data.Hashable import Data.Scientific import Data.Time.LocalTime import Data.Time.Clock import Data.Fixed-import Data.Tree import Foreign.Storable-import Control.Applicative import Control.Applicative.Free import Data.Functor.Invariant import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Lazy as LazyHashMap import Control.Exception-import Data.Traversable +import Control.Monad import Data.Bits import Data.Word import Data.Int@@ -196,12 +194,16 @@ import Data.List import qualified Text.ParserCombinators.ReadP as ReadP import Data.Char-import Control.Monad #if !MIN_VERSION_base(4,6,0) import Prelude hiding (catch) #endif +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+import Data.Traversable+#endif+ import qualified Text.PrettyPrint.HughesPJ as P -- | Describe a path from root JSON element to a specific@@ -321,7 +323,7 @@ instance {-# OVERLAPPABLE #-} (Unjson a, Typeable a) => Unjson [a] where unjsonDef = arrayOf unjsonDef -instance {-# INCOHERENT #-} Unjson String where+instance Unjson String where unjsonDef = unjsonAesonWithDoc "String" instance Unjson Bool where unjsonDef = unjsonAeson@@ -646,12 +648,12 @@ TupleFieldDef :: Int -> (s -> a) -> UnjsonDef a -> TupleFieldDef s a tupleDefToArray :: (forall b . UnjsonDef b -> b -> v) -> s -> Ap (TupleFieldDef s) a -> [v]-tupleDefToArray sx _ (Pure _) = []-tupleDefToArray sx s (Ap (TupleFieldDef _ f d) r) = (sx d (f s)) : tupleDefToArray sx s r+tupleDefToArray _sx _ (Pure _) = []+tupleDefToArray sx s (Ap (TupleFieldDef _ f d) r) = (sx d (f s)) : tupleDefToArray sx s r objectDefToArray :: Bool -> (forall b . UnjsonDef b -> b -> v) -> s -> Ap (FieldDef s) a -> [(Text.Text,v)]-objectDefToArray _ sx _ (Pure _) = []+objectDefToArray _ _sx _ (Pure _) = [] objectDefToArray explicitNulls sx s (Ap (FieldReqDef key _ f d) r) = (key,sx d (f s)) : objectDefToArray explicitNulls sx s r objectDefToArray explicitNulls sx s (Ap (FieldOptDef key _ f d) r) = case f s of@@ -691,7 +693,7 @@ -- unjsonToJSON' :: Options -> UnjsonDef a -> a -> Aeson.Value unjsonToJSON' _ (SimpleUnjsonDef _ _ g) a = g a-unjsonToJSON' opt (ArrayUnjsonDef _ m g k f) a =+unjsonToJSON' opt (ArrayUnjsonDef _ m _g k f) a = case (m, k a) of (ArrayModeParseAndOutputSingle,[b]) -> unjsonToJSON' opt f b (_,c) -> Aeson.toJSON (map (unjsonToJSON' opt f) c)@@ -733,7 +735,7 @@ unjsonGroup :: Int -> Options -> Builder.Builder -> Builder.Builder -> (a -> Builder.Builder) -> [a] -> Builder.Builder-unjsonGroup level _ open close _peritem [] =+unjsonGroup _level _ open close _peritem [] = mconcat $ [open, close] unjsonGroup level opt open close peritem items = mconcat $ [open, newline] ++ intersperse (Builder.char8 ',' <> newline) (map ((idnt2 <>) . peritem) items) ++ [newline, idnt, close]@@ -764,8 +766,8 @@ -- 'Builder.Builder'. Useful when JSON serialization is -- a part of a bigger serialization function. unjsonToByteStringBuilder'' :: Int -> Options -> UnjsonDef a -> a -> Builder.Builder-unjsonToByteStringBuilder'' level opt (SimpleUnjsonDef _ _ g) a = Builder.lazyByteString (Aeson.encode (g a))-unjsonToByteStringBuilder'' level opt (ArrayUnjsonDef _ m g k f) a =+unjsonToByteStringBuilder'' _level _opt (SimpleUnjsonDef _ _ g) a = Builder.lazyByteString (Aeson.encode (g a))+unjsonToByteStringBuilder'' level opt (ArrayUnjsonDef _ m _g k f) a = case (m, k a) of (ArrayModeParseAndOutputSingle,[b]) -> unjsonToByteStringBuilder'' level opt f b (_,c) -> unjsonGroup level opt (Builder.char8 '[') (Builder.char8 ']') (unjsonToByteStringBuilder'' (level+indent opt) opt f) c@@ -839,15 +841,15 @@ parseUpdating (SimpleUnjsonDef _ f _) _ov v = f v parseUpdating (ArrayUnjsonDef (Just (PrimaryKeyExtraction pk_from_object pk_from_json)) m g k f) (Just ov) v = case Aeson.parseEither Aeson.parseJSON v of- Right v -> join $ fmap g $- sequenceA (zipWith (\v i -> lookupObjectByJson v >>= \ov -> (resultPrependIndex i $ parseUpdating f ov v))- (Vector.toList v) [0..])+ Right v' -> join $ fmap g $+ sequenceA (zipWith (\v'' i -> lookupObjectByJson v'' >>= \ov' -> (resultPrependIndex i $ parseUpdating f ov' v''))+ (Vector.toList v') [0..]) Left e -> case m of ArrayModeStrict -> fail e _ -> join $ fmap g $- sequenceA [lookupObjectByJson v >>= \ov ->- parseUpdating f ov+ sequenceA [lookupObjectByJson v >>= \ov' ->+ parseUpdating f ov' v] where -- Note: Map.fromList is right-biased, so that Map.fromList [(1,1),(1,2)] is [(1,2)]@@ -855,10 +857,10 @@ objectMap = Map.fromListWith (flip const) (map (\o -> (pk_from_object o, o)) (k ov)) lookupObjectByJson js = parseUpdating pk_from_json Nothing js >>= \val -> return (Map.lookup val objectMap) -parseUpdating (ArrayUnjsonDef _ m g k f) _ov v+parseUpdating (ArrayUnjsonDef _ m g _k f) _ov v = case Aeson.parseEither Aeson.parseJSON v of- Right v -> join $ fmap g $- sequenceA (zipWith (\v i -> resultPrependIndex i $ parseUpdating f Nothing v) (Vector.toList v) [0..])+ Right v' -> join $ fmap g $+ sequenceA (zipWith (\v'' i -> resultPrependIndex i $ parseUpdating f Nothing v'') (Vector.toList v') [0..]) Left e -> case m of ArrayModeStrict -> fail e@@ -867,17 +869,17 @@ parseUpdating (ObjectUnjsonDef f) ov v = case Aeson.parseEither Aeson.parseJSON v of- Right v ->- join (runAp (lookupByFieldDef v ov) f)+ Right v' ->+ join (runAp (lookupByFieldDef v' ov) f) Left e -> fail e parseUpdating (TupleUnjsonDef f) ov v = case Aeson.parseEither Aeson.parseJSON v of- Right v ->- let r@(Result g h) = runAp (lookupByTupleFieldDef v ov) f+ Right v' ->+ let r@(Result g h) = runAp (lookupByTupleFieldDef v' ov) f tupleSize = countAp 0 f- arrayLength = Vector.length v+ arrayLength = Vector.length v' in if tupleSize == arrayLength then join r else join $ Result g ([Anchored mempty ("cannot parse array of length " <> Text.pack (show arrayLength) <>@@ -887,10 +889,10 @@ parseUpdating (DisjointUnjsonDef k l) ov v = case Aeson.parseEither Aeson.parseJSON v of- Right v -> case HashMap.lookup k v of+ Right v' -> case HashMap.lookup k v' of Just x -> case Aeson.parseEither Aeson.parseJSON x of Right xx -> case filter (\(nm,_,_) -> nm==xx) l of- [(_,_,f)] -> join (runAp (lookupByFieldDef v ov) f)+ [(_,_,f)] -> join (runAp (lookupByFieldDef v' ov) f) _ -> resultPrependKey k $ fail $ "value '" ++ Text.unpack xx ++ "' is not one of the allowed for enumeration [" ++ intercalate "," (map (\(a,_,_) -> Text.unpack a) l) ++ "]" Left e ->@@ -902,16 +904,16 @@ fail e parseUpdating (UnionUnjsonDef l) ov v = case Aeson.parseEither Aeson.parseJSON v of- Right v -> case filter (\(_,f) -> isJust (mapM_ (\k -> HashMap.lookup k v) (listRequiredKeys f))) l of- ((_,f):_) -> join (runAp (lookupByFieldDef v ov) f)+ Right v' -> case filter (\(_,f) -> isJust (mapM_ (\k -> HashMap.lookup k v') (listRequiredKeys f))) l of+ ((_,f):_) -> join (runAp (lookupByFieldDef v' ov) f) _ -> fail $ "union value type could not be recognized based on presence of keys" Left e -> fail e parseUpdating (MapUnjsonDef f g h) ov v = case Aeson.parseEither Aeson.parseJSON v of- Right v ->+ Right v' -> let hov = fmap h ov in- join $ fmap g $ HashMap.traverseWithKey (\k1 v1 -> resultPrependKey k1 $ parseUpdating f (join (fmap (HashMap.lookup k1) hov)) v1) v+ join $ fmap g $ HashMap.traverseWithKey (\k1 v1 -> resultPrependKey k1 $ parseUpdating f (join (fmap (HashMap.lookup k1) hov)) v1) v' Left e -> fail e @@ -978,20 +980,20 @@ update a vd = parseUpdating vd (Just a) lookupByFieldDef :: Aeson.Object -> Maybe s -> FieldDef s a -> Result a-lookupByFieldDef v ov (FieldReqDef name docstring f valuedef)+lookupByFieldDef v ov (FieldReqDef name _docstring f valuedef) = resultPrependKey name $ case HashMap.lookup name v of Just x -> parseUpdating valuedef (fmap f ov) x Nothing -> case ov of Just xov -> Result (f xov) [] Nothing -> fail "missing key"-lookupByFieldDef v ov (FieldDefDef name docstring def f valuedef)+lookupByFieldDef v ov (FieldDefDef name _docstring def f valuedef) = resultPrependKey name $ case HashMap.lookup name v of Just Aeson.Null -> Result def [] Just x -> parseUpdating valuedef (fmap f ov) x Nothing -> case ov of Just xov -> Result (f xov) [] Nothing -> Result def []-lookupByFieldDef v ov (FieldOptDef name docstring f valuedef)+lookupByFieldDef v ov (FieldOptDef name _docstring f valuedef) = resultPrependKey name $ case HashMap.lookup name v of Just Aeson.Null -> Result Nothing [] Just x -> case ov of@@ -1000,7 +1002,7 @@ Nothing -> case ov of Just xov -> Result (f xov) [] Nothing -> Result Nothing []-lookupByFieldDef _ _ (FieldRODef name docstring f valuedef) = Result () []+lookupByFieldDef _ _ (FieldRODef _name _docstring _f _valuedef) = Result () [] lookupByTupleFieldDef :: Aeson.Array -> Maybe s -> TupleFieldDef s a -> Result a@@ -1301,6 +1303,8 @@ -- | Declare array of primitive values lifed from 'Aeson'. Accepts -- mode specifier. --+-- @since 0.15.1.0+-- -- Example: -- -- > unjsonArrayOfIntOrSimpleInt :: UnjsonDef [Int]@@ -1480,7 +1484,7 @@ -- for example. renderDoc :: UnjsonDef a -> P.Doc renderDoc (SimpleUnjsonDef doc _ _) = P.text (ansiDimmed ++ Text.unpack doc ++ ansiReset)-renderDoc (ArrayUnjsonDef _ _m g k f) = P.text (ansiDimmed ++ "array of" ++ ansiReset ++ ":") P.$+$+renderDoc (ArrayUnjsonDef _ _m _g _k f) = P.text (ansiDimmed ++ "array of" ++ ansiReset ++ ":") P.$+$ P.nest 4 (renderDoc f) renderDoc (MapUnjsonDef f _ _) = P.text (ansiDimmed ++ "map of" ++ ansiReset ++ ":") P.$+$ P.nest 4 (renderDoc f)@@ -1491,7 +1495,7 @@ renderDoc (DisjointUnjsonDef k z) = P.text (ansiDimmed ++ "disjoint union based on key:" ++ ansiReset) P.$+$ P.vcat [P.text (ansiBold ++ Text.unpack k ++ ": " ++ Text.unpack l ++ ansiReset) P.$+$ P.nest 4 (P.vcat (renderFields f)) | (l,_,f) <- z] renderDoc (UnionUnjsonDef z) = P.text (ansiDimmed ++ "plain union based on presence of required keys:" ++ ansiReset) P.$+$- P.vcat [P.text (ansiBold ++ "case " ++ show i ++ ":" ++ ansiReset) P.$+$ P.nest 4 (P.vcat (renderFields f)) | ((_,f),i) <- zip z [1..]]+ P.vcat [P.text (ansiBold ++ "case " ++ show (i::Int) ++ ":" ++ ansiReset) P.$+$ P.nest 4 (P.vcat (renderFields f)) | ((_,f),i) <- zip z [1..]] -- | Render only selected part of structure documentation as -- 'P.Doc'. Path should point to a subtree, if it does not then
test/Test.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-+{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Main where import qualified Data.Text as Text@@ -7,12 +7,9 @@ import Data.Int import Data.Typeable import Data.Unjson-import Control.Applicative import qualified Data.Aeson as Aeson import Data.Aeson ((.=))-import Control.Exception import Test.HUnit-import Data.Monoid import Data.List import Data.Data import Data.Functor.Invariant@@ -26,6 +23,11 @@ import Prelude hiding (catch) #endif +#if !MIN_VERSION_base(4,8,0)+import Control.Applicative+import Data.Monoid+#endif+ default (Text.Text, String, Int, Double) -- As an example we will use a hypothetical configuration data.@@ -95,7 +97,7 @@ test_proper_parse = "Proper parsing of a complex structure" ~: do let json = Aeson.object [ "hostname" .= "www.example.com"- , "comment" .= "nice server"+ , "comment" .= "nice server" , "credentials" .= Aeson.object [ "username" .= "usr1" , "password" .= "pass1"@@ -155,13 +157,13 @@ "Enveloped Konfig" unjsonKonfig do- let Result val iss = parse unjsonEnvelope json+ let Result _val iss = parse unjsonEnvelope json assertEqual "There is one issue in parsing" [Anchored (Path [ PathElemKey "payload" , PathElemKey "credentials" , PathElemKey "password" ]) "missing key"] iss do- let Result val iss = parse unjsonKonfig json1+ let Result _val iss = parse unjsonKonfig json1 assertEqual "There is one issue in parsing" [Anchored (Path [ PathElemKey "credentials" , PathElemKey "password" ]) "missing key"] iss@@ -177,7 +179,7 @@ , "int32" .= 999 ] - let Result val iss = parse unjsonKonfig json+ let Result _val iss = parse unjsonKonfig json assertEqual "Number of issues in parsing" 3 (length iss) assertEqual "Hostname must be string error info is present" (Anchored (Path [ PathElemKey "hostname"@@ -204,19 +206,19 @@ assertEqual "Second element of tuple" "port" val2 assertEqual "Third element of tuple" 123 val3 - let Result (_ :: (String, Text.Text, Int, Int)) iss = parse unjsonDef json+ let Result (_ :: (String, Text.Text, Int, Int)) iss' = parse unjsonDef json assertEqual "Issue in parsing" [Anchored mempty "cannot parse array of length 3 into tuple of size 4"- ,Anchored (Path [PathElemIndex 3]) "missing key"] iss+ ,Anchored (Path [PathElemIndex 3]) "missing key"] iss' - let Result (_ :: (Integer, Integer, Text.Text)) iss = parse unjsonDef json+ let Result (_ :: (Integer, Integer, Text.Text)) iss'' = parse unjsonDef json assertEqual "Issues in parsing" [ Anchored (Path [PathElemIndex 0]) "expected Integer, encountered String" , Anchored (Path [PathElemIndex 1]) "expected Integer, encountered String" , Anchored (Path [PathElemIndex 2]) "expected Text, encountered Number"- ] iss+ ] iss'' - let Result (_ :: (String, Text.Text)) iss = parse unjsonDef json- assertEqual "Array too long for 2-tuple" [Anchored mempty "cannot parse array of length 3 into tuple of size 2"] iss+ let Result (_ :: (String, Text.Text)) iss''' = parse unjsonDef json+ assertEqual "Array too long for 2-tuple" [Anchored mempty "cannot parse array of length 3 into tuple of size 2"] iss''' return () @@ -233,7 +235,7 @@ } let json = unjsonToJSON unjsonKonfig expect- let Result val iss = parse unjsonKonfig json+ let Result val _iss = parse unjsonKonfig json assertEqual "Serialize-parse produces no problems" expect val assertEqual "Serialize-parse is identity" expect val return ()@@ -383,13 +385,13 @@ [ "text_value" .= False , "numerical_value" .= 12345 ]- let Result val iss = parse unjsonEitherIntText json+ let Result _val iss = parse unjsonEitherIntText json assertEqual "Problem when mode is missing" [Anchored (Path [PathElemKey "mode"]) "missing key"] iss do let json = Aeson.object [ "mode" .= "something else" ]- let Result val iss = parse unjsonEitherIntText json+ let Result _val iss = parse unjsonEitherIntText json assertEqual "Problem when mode is missing" [Anchored (Path [PathElemKey "mode"]) "value 'something else' is not one of the allowed for enumeration [number,text]"] iss do let json = Aeson.object@@ -433,7 +435,7 @@ let json = Aeson.object [ "mode" .= "wrong" ]- let Result val iss = parse unjsonEnumAB json+ let Result _val iss = parse unjsonEnumAB json assertEqual "No problems" [Anchored (Path [PathElemKey "mode"]) "value 'wrong' is not one of the allowed for enumeration [A,B]"] iss @@ -463,7 +465,7 @@ let json = Aeson.object [ "AutoAB" .= "wrong" ]- let Result val iss = parse unjsonAutoEnumAB json+ let Result _val iss = parse unjsonAutoEnumAB json assertEqual "No problems" [Anchored (Path [PathElemKey "AutoAB"]) "value 'wrong' is not one of the allowed for enumeration [AutoA,AutoB]"] iss @@ -513,12 +515,13 @@ , konfigOptions = [] , konfigInt32 = 0 }- let expect = Konfig+ let _expect = Konfig { konfigHostname = "www.example.com" , konfigPort = 80 , konfigComment = Nothing , konfigCredentials = Credentials "usr1" "pass1" (Nothing)- , konfigAlternates = Just ("abc", Credentials "usrx" "passx" Nothing)+ , konfigAlternates = Just ("abc"+ , Credentials "usrx" "passx" Nothing) , konfigOptions = [] , konfigInt32 = 256 }@@ -565,7 +568,7 @@ <*> fieldBy "hostname" id "Single value or array" (arrayWithModeOf ArrayModeParseAndOutputSingle unjsonDef)- let Result val0 iss0 = parse p0 json+ let Result _val0 iss0 = parse p0 json assertEqual "Does not parse value in strict array mode" [Anchored (Path [PathElemKey "hostname"]) "Error in $: expected Vector a, encountered String"] iss0@@ -726,7 +729,7 @@ [ "key1" .= (123 :: Int) ] - let Result val3 iss3 = parse unjsonPlainUnion json3+ let Result _val3 iss3 = parse unjsonPlainUnion json3 assertEqual "Cannot parse PlainUnionA" [Anchored (Path [PathElemKey "key1"]) "expected String, encountered Number"] iss3 @@ -819,7 +822,7 @@ updateExampleRendering = do contents <- readFile "src/Data/Unjson.hs" let (before,exampleAndRest) = break (=="-- Example rendering:") (lines contents)- (example,after) = break ("render ::" `isPrefixOf`) exampleAndRest+ (_example,after) = break ("render ::" `isPrefixOf`) exampleAndRest _ <- return $! length after writeFile "src/Data/Unjson.hs" (unlines (before ++ ["-- Example rendering:", "--"] ++@@ -834,7 +837,7 @@ filterOutAnsiTillEndOfMulticharSequence :: String -> String filterOutAnsiTillEndOfMulticharSequence (c : rest) | c >= '@' = filterOutAnsi rest-filterOutAnsiTillEndOfMulticharSequence (c : rest) =+filterOutAnsiTillEndOfMulticharSequence (_c : rest) = filterOutAnsiTillEndOfMulticharSequence rest filterOutAnsiTillEndOfMulticharSequence [] = []
unjson.cabal view
@@ -1,5 +1,5 @@ name: unjson-version: 0.15.0.0+version: 0.15.1.0 synopsis: Bidirectional JSON parsing and generation. description: Bidirectional JSON parsing and generation with automatic documentation support.@@ -25,7 +25,7 @@ source-repository this type: git location: https://github.com/scrive/unjson.git- tag: 0.15.0.0+ tag: 0.15.1.0 library exposed-modules: Data.Unjson@@ -37,6 +37,7 @@ bytestring >= 0.10, containers, hashable, primitive, time, invariant hs-source-dirs: src+ ghc-options: -Wall default-language: Haskell2010 default-extensions: BangPatterns, DeriveDataTypeable,@@ -61,6 +62,7 @@ unordered-containers, vector, HUnit, bytestring >= 0.10, pretty, primitive, containers, time, hashable, invariant+ ghc-options: -Wall default-language: Haskell2010 default-extensions: BangPatterns, DeriveDataTypeable,