diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/src/Data/Unjson.hs b/src/Data/Unjson.hs --- a/src/Data/Unjson.hs +++ b/src/Data/Unjson.hs @@ -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 diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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 [] = [] diff --git a/unjson.cabal b/unjson.cabal --- a/unjson.cabal +++ b/unjson.cabal @@ -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,