diff --git a/src/Data/Unjson.hs b/src/Data/Unjson.hs --- a/src/Data/Unjson.hs +++ b/src/Data/Unjson.hs @@ -147,9 +147,9 @@ ) where -import qualified Data.Aeson as Aeson hiding (encode) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Text as Aeson import qualified Data.Aeson.Types as Aeson -import qualified Data.Aeson.Encode as Aeson import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Builder as Builder import qualified Data.Text as Text @@ -172,13 +172,6 @@ import Data.Primitive.Types import Data.Hashable import Data.Scientific -#ifdef MIN_VERSION_attoparsec -#if MIN_VERSION_attoparsec(0,14,0) - -- do nothing -#else -import Data.Attoparsec.Number -#endif -#endif import Data.Time.LocalTime import Data.Time.Clock import Data.Fixed @@ -282,8 +275,8 @@ instance Monad Result where return = pure - Result a pa >>= m = Result ma (pa ++ pma) - where Result ma pma = m a + Result a [] >>= m = m a + Result _ es@(e:_) >>= _ = Result (throw e) es fail str = Result (throw anchoredMessage) [anchoredMessage] where anchoredMessage = Anchored mempty (Text.pack str) @@ -321,10 +314,10 @@ -- 'UnjsonDef'. unjsonDef :: UnjsonDef a -instance (Unjson a) => Unjson [a] where +instance {-# OVERLAPPABLE #-} (Unjson a) => Unjson [a] where unjsonDef = arrayOf unjsonDef -instance Unjson String where +instance {-# INCOHERENT #-} Unjson String where unjsonDef = unjsonAesonWithDoc "String" instance Unjson Bool where unjsonDef = unjsonAeson @@ -344,19 +337,8 @@ instance Unjson Word64 where unjsonDef = unjsonAeson instance Unjson () where unjsonDef = unjsonAeson instance Unjson Text.Text where unjsonDef = unjsonAeson -#ifdef MIN_VERSION_attoparsec -#if MIN_VERSION_attoparsec(0,14,0) - -- do nothing -#else -instance Unjson Number where unjsonDef = unjsonAeson -#endif -#endif instance Unjson IntSet.IntSet where unjsonDef = unjsonAeson -#ifdef MIN_VERSION_aeson -#if MIN_VERSION_aeson(0,7,0) instance Unjson Scientific where unjsonDef = unjsonAeson -#endif -#endif instance Unjson LazyText.Text where unjsonDef = unjsonAeson instance Unjson ZonedTime where unjsonDef = unjsonAeson instance Unjson UTCTime where unjsonDef = unjsonAeson diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -151,34 +151,11 @@ , PathElemKey "credentials" , PathElemKey "password" ]) "missing key"] iss - assertEqual "Value is accessible in parsed parts" "usr1" (credentialsUsername (konfigCredentials val)) - catch - (do - evaluate $ credentialsPassword (konfigCredentials val) - assertFailure "Should have thrown an exception") - (\(Anchored path (msg :: Text.Text)) -> do - assertEqual "Path to problematic key" - (Path [ PathElemKey "password" - ]) path - assertEqual "Message about the problem" (Text.pack "missing key") msg) - return () - do let Result val iss = parse unjsonKonfig json1 assertEqual "There is one issue in parsing" [Anchored (Path [ PathElemKey "credentials" , PathElemKey "password" ]) "missing key"] iss - assertEqual "Value is accessible in parsed parts" "usr1" (credentialsUsername (konfigCredentials val)) - catch - (do - evaluate $ credentialsPassword (konfigCredentials val) - assertFailure "Should have thrown an exception") - (\(Anchored path (msg :: Text.Text)) -> do - assertEqual "Path to problematic key" - (Path [ PathElemKey "password" - ]) path - assertEqual "Message about the problem" (Text.pack "missing key") msg) - return () test_wrong_value_type :: Test test_wrong_value_type = "Value at key is wrong type" ~: do @@ -217,27 +194,18 @@ assertEqual "Second element of tuple" "port" val2 assertEqual "Third element of tuple" 123 val3 - let Result (xval1 :: String, xval2 :: Text.Text, xval3 :: Int, xval4 :: 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 - catch - (do - evaluate $ xval4 - assertFailure "Should have thrown an exception") - (\(Anchored path (msg :: Text.Text)) -> do - assertEqual "Path to problematic key" - (Path [PathElemIndex 3]) path - assertEqual "Message about the problem" (Text.pack "missing key") msg) - - let Result (yval1 :: Integer, yval2 :: Integer, yval3 :: 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 - let Result (zval1 :: String, zval2 :: Text.Text) iss = parse unjsonDef json + 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 () @@ -451,15 +419,6 @@ ] 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 - catch - (do - evaluate val - assertFailure "Should have thrown an exception") - (\(Anchored path (msg :: Text.Text)) -> do - assertEqual "Path to problematic key" - (Path [ PathElemKey "mode" - ]) path - assertEqual "Message about the problem" (Text.pack "value 'wrong' is not one of the allowed for enumeration [A,B]") msg) test_update_from_serialization :: Test test_update_from_serialization = "test_update_from_serialization" ~: do @@ -525,11 +484,9 @@ ] ] ] - let Result val iss = update initial unjsonKonfig json + let Result _ iss = update initial unjsonKonfig json assertEqual "Cannot reset mangatory field without default" [Anchored (Path [PathElemKey "hostname"]) "expected Text, encountered Null"] iss - assertEqual "Can reset value with default" (konfigPort expect) (konfigPort val) - assertEqual "Can reset optional value" (konfigComment expect) (konfigComment val) return () test_array_modes :: Test diff --git a/unjson.cabal b/unjson.cabal --- a/unjson.cabal +++ b/unjson.cabal @@ -1,79 +1,79 @@ --- Initial unjson.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - name: unjson -version: 0.14.0.1 +version: 0.14.1.2 synopsis: Bidirectional JSON parsing and generation. -description: Bidirectional JSON parsing and generation with automatic documentation support. +description: Bidirectional JSON parsing and generation + with automatic documentation support. +homepage: https://github.com/scrive/unjson license: BSD3 license-file: LICENSE author: Scrive AB -maintainer: Gracjan Polak , Jonathan Jouty , Mikhail Glushenkov +maintainer: Gracjan Polak , + Jonathan Jouty , + Mikhail Glushenkov copyright: Scrive AB category: Data build-type: Simple extra-source-files: README.md cabal-version: >=1.18 -tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 +tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, + GHC == 7.10.3, GHC == 8.0.1 source-repository head type: git - location: https://github.com/scrive/unjson + location: https://github.com/scrive/unjson.git source-repository this type: git - location: https://github.com/scrive/unjson - tag: 0.14 + location: https://github.com/scrive/unjson.git + tag: 0.14.1.2 library exposed-modules: Data.Unjson -- other-modules: -- other-extensions: - build-depends: base >= 4.5 && < 5, text, aeson >= 0.10 && < 1.1, + build-depends: base >= 4.5 && < 5, text, aeson >= 1.0 && < 1.2, free, scientific, attoparsec, unordered-containers, vector, pretty, bytestring >= 0.10, containers, hashable, primitive, time, invariant hs-source-dirs: src default-language: Haskell2010 - default-extensions: DeriveDataTypeable, - OverloadedStrings, + default-extensions: BangPatterns, + DeriveDataTypeable, DeriveFunctor, ExtendedDefaultRules, - GeneralizedNewtypeDeriving, - RankNTypes, FlexibleContexts, FlexibleInstances, - TypeFamilies, + GADTs, + GeneralizedNewtypeDeriving, OverloadedStrings, - UndecidableInstances, + RankNTypes, ScopedTypeVariables, - OverlappingInstances, - BangPatterns, - GADTs + TypeFamilies, + UndecidableInstances Test-Suite test type: exitcode-stdio-1.0 main-is: Test.hs hs-source-dirs: src, test - build-depends: base >= 4.5 && < 5, text, aeson >= 0.10 && < 1.1, + build-depends: base >= 4.5 && < 5, text, aeson >= 1.0 && < 1.2, free, scientific, attoparsec, unordered-containers, vector, HUnit, bytestring >= 0.10, pretty, primitive, containers, time, hashable, invariant default-language: Haskell2010 - default-extensions: DeriveDataTypeable, - OverloadedStrings, - GeneralizedNewtypeDeriving, + default-extensions: BangPatterns, + DeriveDataTypeable, DeriveFunctor, ExtendedDefaultRules, - RankNTypes, - UndecidableInstances, FlexibleContexts, FlexibleInstances, - TypeFamilies, + GADTs, + GeneralizedNewtypeDeriving, + OverlappingInstances, OverloadedStrings, + OverloadedStrings, + RankNTypes, ScopedTypeVariables, - OverlappingInstances, - BangPatterns, - GADTs + TypeFamilies, + UndecidableInstances