diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ # hw-json-lens -[![0.0-branch](https://circleci.com/gh/haskell-works/hw-json-lens/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-json-lens/tree/0.0-branch) +[![CircleCI](https://circleci.com/gh/haskell-works/hw-json-lens.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-json-lens) `hw-json-lens` provides traversals and prisms for the [HW-JSON](http://hackage.haskell.org/package/hw-json) library's JsonPartialValue type. diff --git a/hw-json-lens.cabal b/hw-json-lens.cabal --- a/hw-json-lens.cabal +++ b/hw-json-lens.cabal @@ -1,59 +1,98 @@ --- This file has been generated from package.yaml by hpack version 0.18.1. --- --- see: https://github.com/sol/hpack - -name: hw-json-lens -version: 0.1.0.0 -synopsis: Lens for hw-json -description: Please see README.md -category: Data -homepage: http://github.com/haskell-works/hw-json-lens#readme -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 John Ky -license: MIT -license-file: LICENSE -build-type: Simple -cabal-version: >= 1.10 +cabal-version: 2.2 -extra-source-files: - README.md +name: hw-json-lens +version: 0.2.0.0 +synopsis: Lens for hw-json +description: Lens for hw-json. Please see README.md +category: Data, Succinct Data Structures, Data Structures, JSON +homepage: http://github.com/haskell-works/hw-json-lens#readme +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 +license-file: LICENSE +build-type: Simple +extra-source-files: README.md source-repository head type: git location: https://github.com/haskell-works/hw-json-lens +common base { build-depends: base >= 4 && < 5 } + +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 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 } +common hw-bits { build-depends: hw-bits >= 0.7 && < 0.8 } +common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 } +common hw-json { build-depends: hw-json >= 1.3 && < 1.4 } +common hw-json-standard-cursor { build-depends: hw-json-standard-cursor >= 0.2 && < 0.3 } +common hw-prim { build-depends: hw-prim >= 0.6.2 && < 0.6.3 } +common lens { build-depends: lens >= 4 && < 5 } +common scientific { build-depends: scientific >= 0.3 && < 0.4 } +common text { build-depends: text >= 1.2 && < 1.3 } +common vector { build-depends: vector >= 0.12 && < 0.13 } +common word8 { build-depends: word8 >= 0.1 && < 0.2 } + +common hw-json-lens + build-depends: hw-json-lens + +common config + default-language: Haskell2010 + ghc-options: -Wall + library - hs-source-dirs: - src - ghc-options: -Wall -O2 -msse4.2 - build-depends: - base >= 4 && < 5 - , bytestring >= 0.10 && < 0.11 - , hw-json >= 0.8.1 && < 0.9 - , lens >= 4 && < 5 - , containers >= 0.5 && < 0.6 - , scientific >= 0.3 && < 0.4 - , word8 >= 0.1 && < 0.2 - exposed-modules: - HaskellWorks.Data.Json.Lens - HaskellWorks.Data.ListMap - other-modules: - Paths_hw_json_lens - default-language: Haskell2010 + import: base, config + , bytestring + , containers + , hw-json + , lens + , scientific + , text + , word8 + exposed-modules: HaskellWorks.Data.Json.Lens + HaskellWorks.Data.ListMap + other-modules: Paths_hw_json_lens + autogen-modules: Paths_hw_json_lens + hs-source-dirs: src + ghc-options: -O2 -msse4.2 benchmark bench - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: - bench - ghc-options: -Wall -O2 -msse4.2 - build-depends: - base >= 4 && < 5 - , bytestring >= 0.10 && < 0.11 - , hw-json >= 0.8.1 && < 0.9 - , lens >= 4 && < 5 - , criterion >= 1.4 && < 1.5 - , hw-json-lens - default-language: Haskell2010 + import: base, config + , bytestring + , criterion + , hw-json + , hw-json-lens + , 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 + +test-suite hw-json-lens-test + import: base, config + , bytestring + , hedgehog + , hspec + , hw-balancedparens + , hw-bits + , hw-hspec-hedgehog + , hw-json + , hw-json-lens + , hw-json-standard-cursor + , hw-prim + , lens + , vector + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: Paths_hw_json_lens + 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 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 @@ -23,6 +23,7 @@ module HaskellWorks.Data.Json.Lens where import Control.Applicative +import Control.Arrow (first) import Control.Lens import Data.Data import Data.Scientific (Scientific) @@ -32,6 +33,7 @@ import Prelude hiding (null) import qualified Data.Scientific as Scientific +import qualified Data.Text as T ------------------------------------------------------------------------------ -- Scientific prisms @@ -192,20 +194,19 @@ instance AsPrimitive JsonPartialValue where _Primitive = prism fromPrim toPrim - where - toPrim (JsonPartialString s) = Right $ StringPrim s - toPrim (JsonPartialNumber n) = Right $ NumberPrim (Scientific.fromFloatDigits n) - toPrim (JsonPartialBool b) = Right $ BoolPrim b - toPrim JsonPartialNull = Right NullPrim - toPrim v = Left v - {-# INLINE toPrim #-} - fromPrim (StringPrim s) = JsonPartialString s - fromPrim (NumberPrim n) = JsonPartialNumber (realToFrac n) - fromPrim (BoolPrim b) = JsonPartialBool b - fromPrim NullPrim = JsonPartialNull - {-# INLINE fromPrim #-} + where toPrim (JsonPartialString s) = Right $ StringPrim (T.unpack s) + toPrim (JsonPartialNumber n) = Right $ NumberPrim (Scientific.fromFloatDigits n) + toPrim (JsonPartialBool b) = Right $ BoolPrim b + toPrim JsonPartialNull = Right NullPrim + toPrim v = Left v + {-# INLINE toPrim #-} + fromPrim (StringPrim s) = JsonPartialString (T.pack s) + fromPrim (NumberPrim n) = JsonPartialNumber (realToFrac n) + fromPrim (BoolPrim b) = JsonPartialBool b + fromPrim NullPrim = JsonPartialNull + {-# INLINE fromPrim #-} {-# INLINE _Primitive #-} - _String = prism JsonPartialString $ \v -> case v of JsonPartialString s -> Right s; _ -> Left v + _String = prism (JsonPartialString . T.pack) $ \v -> case v of JsonPartialString s -> Right (T.unpack s); _ -> Left v {-# INLINE _String #-} _Bool = prism JsonPartialBool (\v -> case v of JsonPartialBool b -> Right b; _ -> Left v) {-# INLINE _Bool #-} @@ -256,8 +257,8 @@ -- >>> _Object._Wrapped # [("key" :: String, _String # "value")] :: String -- "{\"key\":\"value\"}" _Object :: Prism' t (ListMap JsonPartialValue) - _Object = _Value.prism (JsonPartialObject . toList) (\v -> case v of - JsonPartialObject o -> Right (fromList o) + _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 #-} @@ -429,12 +430,12 @@ type instance IxValue JsonPartialValue = JsonPartialValue instance Ixed JsonPartialValue where - ix i f (JsonPartialObject o) = (JsonPartialObject . toList) <$> ix i f (fromList o) + ix i f (JsonPartialObject o) = (JsonPartialObject . fmap (first T.pack) . toList) <$> ix i f (fromList (fmap (first T.unpack) o)) ix _ _ v = pure v {-# INLINE ix #-} instance Plated JsonPartialValue where - plate f (JsonPartialObject o) = (JsonPartialObject . toList) <$> traverse f (fromList o) + plate f (JsonPartialObject o) = (JsonPartialObject . fmap (first T.pack) . toList) <$> traverse f (fromList (fmap (first T.unpack) o)) plate f (JsonPartialArray a) = JsonPartialArray <$> traverse f a plate _ xs = pure xs {-# INLINE plate #-} diff --git a/test/HaskellWorks/Data/Json/LensSpec.hs b/test/HaskellWorks/Data/Json/LensSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Json/LensSpec.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HaskellWorks.Data.Json.LensSpec (spec) where + +import Control.Lens +import GHC.Base +import HaskellWorks.Data.Json.Internal.PartialIndex +import HaskellWorks.Data.Json.Lens +import HaskellWorks.Data.Json.PartialValue +import HaskellWorks.Data.ListMap (fromList) +import Prelude hiding (null) +import Test.Hspec + +import qualified Data.ByteString as BS +import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as JCF + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} + +j :: BS.ByteString -> JsonPartialValue +j bs = jsonPartialJsonValueAt (jsonPartialIndexAt (JCF.fromByteStringViaBlanking bs)) + +spec :: Spec +spec = describe "Nth Spec" $ do + let json = j "{\"d\": 1.5, \"s\": \"xyz\", \"b\": true, \"n\": null, \"o\": {}}" + + it "key" $ do + json ^? key "d" `shouldBe` Just (JsonPartialNumber 1.5) + j "[1,2,3]" ^? key "s" `shouldBe` Nothing + + it "key composed" $ do + json ^? key "d" . _Number `shouldBe` Just 1.5 + json ^? key "s" . _String `shouldBe` Just "xyz" + json ^? key "b" . _Bool `shouldBe` Just True + json ^? key "n" . _Null `shouldBe` Just () + json ^? key "b" . _Null `shouldBe` Nothing + + it "nonNull" $ do + json ^? key "s" . nonNull `shouldBe` Just (JsonPartialString "xyz") + json ^? key "o" . nonNull `shouldBe` Just (JsonPartialObject []) + json ^? key "n" . nonNull `shouldBe` Nothing + + it "preview" $ do + preview _Value (j "[1,2,3]") `shouldBe` Just (JsonPartialArray [JsonPartialNumber 1.0,JsonPartialNumber 2.0,JsonPartialNumber 3.0]) + + it "object" $ do + json ^? key "o" . _Object `shouldBe` Just (fromList []) + json ^? key "n" . _Object `shouldBe` Nothing + + it "members" $ do + fromList (json ^@.. members) `shouldBe` fromList [("d", JsonPartialNumber 1.5), ("s", JsonPartialString "xyz"), ("b", JsonPartialBool True), ("n", JsonPartialNull), ("o", JsonPartialObject [])] + (json & members . _Number *~10) ^? key "d" `shouldBe` Just (JsonPartialNumber 15) + + it "values" $ do + j "[1,2,3]" ^.. values `shouldBe` [JsonPartialNumber 1, JsonPartialNumber 2, JsonPartialNumber 3] + (j "[1,2,3]" & values . _Number *~ 10) `shouldBe` JsonPartialArray [JsonPartialNumber 10, JsonPartialNumber 20, JsonPartialNumber 30] diff --git a/test/HaskellWorks/Data/Json/NthSpec.hs b/test/HaskellWorks/Data/Json/NthSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Json/NthSpec.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HaskellWorks.Data.Json.NthSpec (spec) where + +import Control.Lens +import GHC.Base +import HaskellWorks.Data.Json.Internal.PartialIndex +import HaskellWorks.Data.Json.Lens +import HaskellWorks.Data.Json.PartialValue +import Prelude hiding (null) +import Test.Hspec + +import qualified Data.ByteString as Strict +import qualified HaskellWorks.Data.Json.Standard.Cursor.Fast as JCF + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} + +j :: Strict.ByteString -> JsonPartialValue +j = jsonPartialJsonValueAt . jsonPartialIndexAt . JCF.fromByteStringViaBlanking + +spec :: Spec +spec = describe "Nth Spec" $ do + let json = j "[1.5, \"x\", null, true, false]" + it "nth" $ do + json ^? nth 0 . _Number `shouldBe` Just 1.5 + json ^? nth 0 . _Double `shouldBe` Just 1.5 + json ^? nth 0 . _Integer `shouldBe` Just 1 + json ^? nth 0 . _String `shouldBe` Nothing + + it "nth with string" $ do + json ^? nth 1 . _String `shouldBe` Just "x" + json ^? nth 1 . _Double `shouldBe` Nothing + + it "nth out of bound" $ do + json ^? nth 8 . _Double `shouldBe` Nothing + json ^? nth 22 . _String `shouldBe` Nothing + + it "nth with null" $ do + json ^? nth 2 . _Null `shouldBe` Just () + json ^? nth 3 . _Null `shouldBe` Nothing + + it "nth with bool" $ do + json ^? nth 3 . _Bool `shouldBe` Just True + json ^? nth 4 . _Bool `shouldBe` Just False + json ^? nth 2 . _Bool `shouldBe` Nothing + + it "nth with primitive" $ do + json ^? nth 0 . _Primitive `shouldBe` Just (NumberPrim 1.5) + json ^? nth 1 . _Primitive `shouldBe` Just (StringPrim "x") + json ^? nth 2 . _Primitive `shouldBe` Just NullPrim + json ^? nth 3 . _Primitive `shouldBe` Just (BoolPrim True) + json ^? nth 4 . _Primitive `shouldBe` Just (BoolPrim False) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}