diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,7 @@ -Copyright Alexey Raga (c) 2016, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012 +Copyright (c) John Ky 2018-2019 +Copyright (c) Alexey Raga 2016 +Copyright (c) Edward Kmett 2013-2014 +Copyright (c) Paul Wilson 2012 All rights reserved. diff --git a/doctest/DoctestDriver.hs b/doctest/DoctestDriver.hs new file mode 100644 --- /dev/null +++ b/doctest/DoctestDriver.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE CPP #-} + +#if MIN_VERSION_GLASGOW_HASKELL(8,4,4,0) +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} +#else +module Main where + +import qualified System.IO as IO + +main :: IO () +main = IO.putStrLn "WARNING: doctest will not run on GHC versions earlier than 8.4.4" +#endif diff --git a/hw-json-lens.cabal b/hw-json-lens.cabal --- a/hw-json-lens.cabal +++ b/hw-json-lens.cabal @@ -1,7 +1,7 @@ -cabal-version: 2.2 +cabal-version: 2.2 name: hw-json-lens -version: 0.2.0.0 +version: 0.2.1.0 synopsis: Lens for hw-json description: Lens for hw-json. Please see README.md category: Data, Succinct Data Structures, Data Structures, JSON @@ -9,9 +9,13 @@ bug-reports: https://github.com/haskell-works/hw-json-lens/issues author: Alexey Raga, John Ky maintainer: alexey.raga@gmail.com, newhoggy@gmail.com -copyright: 2016 Alexey Raga, 2018-2019 John Ky -license: MIT +copyright: 2018-2019 John Ky + , 2016 Alexey Raga + , 2013-2014 Edward Kmett, + , 2012 Paul Wilson +license: BSD-3-Clause license-file: LICENSE +tested-with: GHC == 8.10.1, GHC == 8.8.3, GHC == 8.6.5, GHC == 8.4.4 build-type: Simple extra-source-files: README.md @@ -21,9 +25,12 @@ common base { build-depends: base >= 4 && < 5 } +common aeson { build-depends: aeson } common bytestring { build-depends: bytestring >= 0.10 && < 0.11 } common containers { build-depends: containers >= 0.5 && < 0.7 } common criterion { build-depends: criterion >= 1.4 && < 1.6 } +common doctest { build-depends: doctest >= 0.16.2 && < 0.17 } +common doctest-discover { build-depends: doctest-discover >= 0.2 && < 0.3 } common hedgehog { build-depends: hedgehog >= 0.5 && < 1.1 } common hspec { build-depends: hspec >= 2.4 && < 3 } common hw-balancedparens { build-depends: hw-balancedparens >= 0.2.0.1 && < 0.4 } @@ -47,6 +54,7 @@ library import: base, config + , aeson , bytestring , containers , hw-json @@ -70,7 +78,6 @@ , lens type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: Paths_hw_json_lens hs-source-dirs: bench ghc-options: -O2 -msse4.2 @@ -90,9 +97,20 @@ , vector type: exitcode-stdio-1.0 main-is: Spec.hs - other-modules: Paths_hw_json_lens - HaskellWorks.Data.Json.LensSpec + other-modules: HaskellWorks.Data.Json.LensSpec HaskellWorks.Data.Json.NthSpec hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-tool-depends: hspec-discover:hspec-discover + +test-suite hw-json-lens-doctest + import: base, config + , doctest + , doctest-discover + , hw-json-lens + default-language: Haskell2010 + type: exitcode-stdio-1.0 + ghc-options: -threaded + main-is: DoctestDriver.hs + HS-Source-Dirs: doctest + build-tool-depends: doctest-discover:doctest-discover diff --git a/src/HaskellWorks/Data/Json/Lens.hs b/src/HaskellWorks/Data/Json/Lens.hs --- a/src/HaskellWorks/Data/Json/Lens.hs +++ b/src/HaskellWorks/Data/Json/Lens.hs @@ -11,15 +11,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} --------------------------------------------------------------------- --- | --- Copyright : (c) Alexey Raga 2016, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012 --- License : BSD3 --- Maintainer: Alexey Raga --- Stability : experimental --- Portability: non-portable --------------------------------------------------------------------- - module HaskellWorks.Data.Json.Lens where import Control.Applicative @@ -40,12 +31,6 @@ ------------------------------------------------------------------------------ class AsNumber t where - -- | - -- >>> "[1, \"x\"]" ^? nth 0 . _Number - -- Just 1.0 - -- - -- >>> "[1, \"x\"]" ^? nth 1 . _Number - -- Nothing _Number :: Prism' t Scientific #ifndef HLINT default _Number :: AsPrimitive t => Prism' t Scientific @@ -55,24 +40,12 @@ -- | -- Prism into an 'Double' over a 'Value', 'Primitive' or 'Scientific' - -- - -- >>> "[10.2]" ^? nth 0 . _Double - -- Just 10.2 _Double :: Prism' t Double _Double = _Number.iso Scientific.toRealFloat realToFrac {-# INLINE _Double #-} -- | -- Prism into an 'Integer' over a 'Value', 'Primitive' or 'Scientific' - -- - -- >>> "[10]" ^? nth 0 . _Integer - -- Just 10 - -- - -- >>> "[10.5]" ^? nth 0 . _Integer - -- Just 10 - -- - -- >>> "42" ^? _Integer - -- Just 42 _Integer :: Prism' t Integer _Integer = _Number.iso floor fromIntegral {-# INLINE _Integer #-} @@ -87,25 +60,11 @@ _Number = id {-# INLINE _Number #-} --- We can implement these once jw-json declared FromJSON/ToJSON classes - --- instance AsNumber Strict.ByteString --- instance AsNumber Lazy.ByteString --- instance AsNumber Text --- instance AsNumber LazyText.Text --- instance AsNumber String - ------------------------------------------------------------------------------ -- Conversion Prisms ------------------------------------------------------------------------------ -- | Access Integer 'Value's as Integrals. --- --- >>> "[10]" ^? nth 0 . _Integral --- Just 10 --- --- >>> "[10.5]" ^? nth 0 . _Integral --- Just 10 _Integral :: (AsNumber t, Integral a) => Prism' t a _Integral = _Number . iso floor fromIntegral {-# INLINE _Integral #-} @@ -127,21 +86,6 @@ {-# INLINE _Number #-} class AsNumber t => AsPrimitive t where - -- | - -- >>> "[1, \"x\", null, true, false]" ^? nth 0 . _Primitive - -- Just (NumberPrim 1.0) - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 1 . _Primitive - -- Just (StringPrim "x") - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 2 . _Primitive - -- Just NullPrim - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 3 . _Primitive - -- Just (BoolPrim True) - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 4 . _Primitive - -- Just (BoolPrim False) _Primitive :: Prism' t Primitive #ifndef HLINT default _Primitive :: AsValue t => Prism' t Primitive @@ -149,44 +93,14 @@ {-# INLINE _Primitive #-} #endif - -- | - -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String - -- Just "xyz" - -- - -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String - -- Nothing - -- - -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")] :: String - -- "{\"key\":\"value\"}" _String :: Prism' t String _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v) {-# INLINE _String #-} - -- | - -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _Bool - -- Just True - -- - -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool - -- Nothing - -- - -- >>> _Bool # True :: String - -- "true" - -- - -- >>> _Bool # False :: String - -- "false" _Bool :: Prism' t Bool _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v) {-# INLINE _Bool #-} - -- | - -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null - -- Just () - -- - -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null - -- Nothing - -- - -- >>> _Null # () :: String - -- "null" _Null :: Prism' t () _Null = _Primitive.prism (const NullPrim) (\v -> case v of NullPrim -> Right (); _ -> Left v) {-# INLINE _Null #-} @@ -213,26 +127,11 @@ _Null = prism (const JsonPartialNull) (\v -> case v of JsonPartialNull -> Right (); _ -> Left v) {-# INLINE _Null #-} --- instance AsPrimitive Strict.ByteString --- instance AsPrimitive Lazy.ByteString --- instance AsPrimitive Text.Text --- instance AsPrimitive LazyText.Text --- instance AsPrimitive String - instance AsPrimitive Primitive where _Primitive = id {-# INLINE _Primitive #-} -- | Prism into non-'Null' values --- --- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . nonNull --- Just (String "xyz") --- --- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . nonNull --- Just (Object (fromList [])) --- --- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . nonNull --- Nothing nonNull :: Prism' JsonPartialValue JsonPartialValue nonNull = prism id (\v -> if isn't _Null v then Right v else Left v) {-# INLINE nonNull #-} @@ -242,29 +141,14 @@ ------------------------------------------------------------------------------ class AsPrimitive t => AsValue t where - -- | - -- >>> preview _Value "[1,2,3]" == Just (Array (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])) - -- True _Value :: Prism' t JsonPartialValue - -- | - -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object - -- Just (fromList []) - -- - -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object - -- Nothing - -- - -- >>> _Object._Wrapped # [("key" :: String, _String # "value")] :: String - -- "{\"key\":\"value\"}" _Object :: Prism' t (ListMap JsonPartialValue) _Object = _Value.prism (JsonPartialObject . fmap (first T.pack) . toList) (\v -> case v of JsonPartialObject o -> Right (fromList (fmap (first T.unpack) o)) _ -> Left v) {-# INLINE _Object #-} - -- | - -- >>> preview _Array "[1,2,3]" == Just (Vector.fromList [Number 1.0,Number 2.0,Number 3.0]) - -- True _Array :: Prism' t [JsonPartialValue] _Array = _Value.prism JsonPartialArray (\v -> case v of JsonPartialArray a -> Right a @@ -275,71 +159,24 @@ _Value = id {-# INLINE _Value #-} --- instance AsValue Strict.ByteString where --- _Value = _JSON --- {-# INLINE _Value #-} --- --- instance AsValue Lazy.ByteString where --- _Value = _JSON --- {-# INLINE _Value #-} --- --- instance AsValue String where --- _Value = strictUtf8._JSON --- {-# INLINE _Value #-} --- --- instance AsValue Text where --- _Value = strictTextUtf8._JSON --- {-# INLINE _Value #-} --- --- instance AsValue LazyText.Text where --- _Value = lazyTextUtf8._JSON --- {-# INLINE _Value #-} - -- | -- Like 'ix', but for 'Object' with Text indices. This often has better -- inference than 'ix' when used with OverloadedStrings. --- --- >>> "{\"a\": 100, \"b\": 200}" ^? key "a" --- Just (Number 100.0) --- --- >>> "[1,2,3]" ^? key "a" --- Nothing key :: AsValue t => String -> Traversal' t JsonPartialValue key i = _Object . ix i {-# INLINE key #-} -- | An indexed Traversal into Object properties --- --- >>> "{\"a\": 4, \"b\": 7}" ^@.. members --- [("a",Number 4.0),("b",Number 7.0)] --- --- >>> "{\"a\": 4, \"b\": 7}" & members . _Number *~ 10 --- "{\"a\":40,\"b\":70}" members :: AsValue t => IndexedTraversal' String t JsonPartialValue members = _Object . itraversed {-# INLINE members #-} -- | Like 'ix', but for Arrays with Int indexes --- --- >>> "[1,2,3]" ^? nth 1 --- Just (Number 2.0) --- --- >>> "\"a\": 100, \"b\": 200}" ^? nth 1 --- Nothing --- --- >>> "[1,2,3]" & nth 1 .~ Number 20 --- "[1,20,3]" nth :: AsValue t => Int -> Traversal' t JsonPartialValue nth i = _Array . ix i {-# INLINE nth #-} -- | An indexed Traversal into Array elements --- --- >>> "[1,2,3]" ^.. values --- [Number 1.0,Number 2.0,Number 3.0] --- --- >>> "[1,2,3]" & values . _Number *~ 10 --- "[10,20,30]" values :: AsValue t => IndexedTraversal' Int t JsonPartialValue values = _Array . traversed {-# INLINE values #-} @@ -352,75 +189,6 @@ -- -- lazyTextUtf8 :: Iso' LazyText.Text Lazy.ByteString -- lazyTextUtf8 = iso LazyText.encodeUtf8 LazyText.decodeUtf8 - --- class AsJSON t where --- -- | '_JSON' is a 'Prism' from something containing JSON to something encoded in that structure --- _JSON :: (FromJSON a, ToJSON a) => Prism' t a --- --- instance AsJSON Strict.ByteString where --- _JSON = lazy._JSON --- {-# INLINE _JSON #-} --- --- instance AsJSON Lazy.ByteString where --- _JSON = prism' encode decodeValue --- where --- decodeValue :: (FromJSON a) => Lazy.ByteString -> Maybe a --- decodeValue s = maybeResult (parse value s) >>= \x -> case fromJSON x of --- Success v -> Just v --- _ -> Nothing --- {-# INLINE _JSON #-} --- --- instance AsJSON String where --- _JSON = strictUtf8._JSON --- {-# INLINE _JSON #-} --- --- instance AsJSON Text where --- _JSON = strictTextUtf8._JSON --- {-# INLINE _JSON #-} --- --- instance AsJSON LazyText.Text where --- _JSON = lazyTextUtf8._JSON --- {-# INLINE _JSON #-} --- --- instance AsJSON Value where --- _JSON = prism toJSON $ \x -> case fromJSON x of --- Success y -> Right y; --- _ -> Left x --- {-# INLINE _JSON #-} - ------------------------------------------------------------------------------- --- Some additional tests for prismhood; see https://github.com/ekmett/lens/issues/439. ------------------------------------------------------------------------------- - --- $LazyByteStringTests --- >>> "42" ^? (_JSON :: Prism' Lazy.ByteString Value) --- Just (Number 42.0) --- --- >>> preview (_Integer :: Prism' Lazy.ByteString Integer) "42" --- Just 42 --- --- >>> Lazy.unpack (review (_Integer :: Prism' Lazy.ByteString Integer) 42) --- "42" - --- $StrictByteStringTests --- >>> "42" ^? (_JSON :: Prism' Strict.ByteString Value) --- Just (Number 42.0) --- --- >>> preview (_Integer :: Prism' Strict.ByteString Integer) "42" --- Just 42 --- --- >>> Strict.Char8.unpack (review (_Integer :: Prism' Strict.ByteString Integer) 42) --- "42" - --- $StringTests --- >>> "42" ^? (_JSON :: Prism' String Value) --- Just (Number 42.0) --- --- >>> preview (_Integer :: Prism' String Integer) "42" --- Just 42 --- --- >>> review (_Integer :: Prism' String Integer) 42 --- "42" ------------------------------------------------------------------------------ -- Orphan instances for lens library interop diff --git a/src/HaskellWorks/Data/ListMap.hs b/src/HaskellWorks/Data/ListMap.hs --- a/src/HaskellWorks/Data/ListMap.hs +++ b/src/HaskellWorks/Data/ListMap.hs @@ -10,7 +10,6 @@ module HaskellWorks.Data.ListMap where import Control.Lens -import Data.Monoid import Prelude hiding (lookup, null) import qualified Prelude as P