packages feed

hw-json-lens (empty) → 0.0.0.1

raw patch · 10 files changed

+822/−0 lines, 10 filesdep +QuickCheckdep +ansi-wl-pprintdep +arraysetup-changed

Dependencies added: QuickCheck, ansi-wl-pprint, array, attoparsec, base, bytestring, conduit, containers, criterion, dlist, hspec, hw-balancedparens, hw-bits, hw-conduit, hw-diagnostics, hw-json, hw-json-lens, hw-parser, hw-prim, hw-rankselect, lens, mmap, mono-traversable, parsec, resourcet, scientific, text, transformers, unordered-containers, vector, word8

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexey Raga (c) 2016, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,5 @@+# hw-xml-lens++[![0.0-branch](https://circleci.com/gh/haskell-works/hw-xml-lens/tree/0.0-branch.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-xml-lens/tree/0.0-branch)++`hw-xml-lens` provides traversals and prisms for the [HW-JSON](http://hackage.haskell.org/package/hw-json) library's JsonPartialValue type.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import           Criterion.Main++benchJsonMQuery :: [Benchmark]+benchJsonMQuery =+  [+  ]++main :: IO ()+main = defaultMain benchJsonMQuery
+ hw-json-lens.cabal view
@@ -0,0 +1,103 @@+name:                   hw-json-lens+version:                0.0.0.1+synopsis:               Lens for hw-json+description:            Please see README.md+homepage:               http://github.com/haskell-works/hw-json-lens#readme+license:                MIT+license-file:           LICENSE+author:                 Alexey Raga+maintainer:             alexey.raga@gmail.com+copyright:              2016 Alexey Raga+category:               Data+build-type:             Simple+extra-source-files:     README.md+cabal-version:          >= 1.22++library+  hs-source-dirs:       src+  exposed-modules:      HaskellWorks.Data.Json.Lens, HaskellWorks.Data.ListMap+  build-depends:        base                          >= 4          && < 5+                      , array+                      , ansi-wl-pprint+                      , attoparsec+                      , bytestring+                      , conduit+                      , containers+                      , dlist+                      , hw-balancedparens             >= 0.1.0.0+                      , hw-bits                       >= 0.4.0.0+                      , hw-conduit                    >= 0.1.0.0+                      , hw-diagnostics                >= 0.0.0.5+                      , hw-json                       >= 0.4.0.0+                      , hw-parser+                      , hw-prim                       >= 0.4.0.0+                      , hw-rankselect                 >= 0.8.0.0+                      , lens >=3.8+                      , mmap+                      , mono-traversable+                      , resourcet+                      , scientific+                      , text+                      , unordered-containers+                      , vector+                      , word8++  default-language:     Haskell2010+  ghc-options:          -Wall -O2 -msse4.2++test-suite hw-json-lens-test+  type:                 exitcode-stdio-1.0+  hs-source-dirs:       test+  main-is:              Spec.hs+  other-modules:        HaskellWorks.Data.Json.NthSpec+                      , HaskellWorks.Data.Json.LensSpec+  build-depends:        base                          >= 4          && < 5+                      , attoparsec+                      , bytestring+                      , containers+                      , conduit+                      , hspec+                      , hw-balancedparens             >= 0.1.0.0+                      , hw-bits                       >= 0.4.0.0+                      , hw-conduit                    >= 0.1.0.0+                      , hw-json                       >= 0.4.0.0+                      , hw-json-lens+                      , hw-prim                       >= 0.4.0.0+                      , hw-rankselect                 >= 0.8.0.0+                      , lens >=3.8+                      , mmap+                      , parsec+                      , QuickCheck+                      , resourcet+                      , scientific+                      , transformers+                      , unordered-containers+                      , vector+  ghc-options:          -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:     Haskell2010++source-repository head+  type:     git+  location: https://github.com/haskell-works/hw-json-lens++benchmark bench+    Type: exitcode-stdio-1.0+    HS-Source-Dirs: bench+    Main-Is: Main.hs+    GHC-Options: -O2 -Wall -msse4.2+    Default-Language: Haskell2010+    Build-Depends:      base                          >= 4          && < 5+                      , bytestring+                      , conduit+                      , criterion+                      , hw-bits                       >= 0.4.0.0+                      , hw-conduit                    >= 0.1.0.0+                      , hw-json-lens+                      , hw-prim                       >= 0.4.0.0+                      , hw-rankselect                 >= 0.8.0.0+                      , lens >=3.8+                      , mmap+                      , resourcet+                      , scientific+                      , unordered-containers+                      , vector
+ src/HaskellWorks/Data/Json/Lens.hs view
@@ -0,0 +1,438 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE Trustworthy           #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE TypeFamilies          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++--------------------------------------------------------------------+-- |+-- Copyright :  (c) Alexey Raga 2016, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012+-- License   :  BSD3+-- Maintainer:  Alexey Raga <alexey.raga@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--------------------------------------------------------------------++module HaskellWorks.Data.Json.Lens where++import           Control.Applicative+import           Control.Lens+import           Data.Data+import           Data.Scientific                     (Scientific)+import qualified Data.Scientific                     as Scientific+import           GHC.Base+import           HaskellWorks.Data.Json.PartialValue as J+import           HaskellWorks.Data.ListMap           (ListMap, fromList, toList)+import           Prelude                             hiding (null)++------------------------------------------------------------------------------+-- Scientific prisms+------------------------------------------------------------------------------++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+  _Number = _Primitive._Number+  {-# INLINE _Number #-}+#endif++  -- |+  -- 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 #-}++instance AsNumber JsonPartialValue where+  _Number = prism (JsonPartialNumber . realToFrac) $ \v -> case v of+    JsonPartialNumber n -> Right (Scientific.fromFloatDigits n)+    _                   -> Left v+  {-# INLINE _Number #-}++instance AsNumber Scientific where+  _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 #-}++------------------------------------------------------------------------------+-- Null values and primitives+------------------------------------------------------------------------------++-- | Primitives of 'Value'+data Primitive+  = StringPrim !String+  | NumberPrim !Scientific+  | BoolPrim !Bool+  | NullPrim+  deriving (Eq,Ord,Show,Data,Typeable)++instance AsNumber Primitive where+  _Number = prism NumberPrim $ \v -> case v of NumberPrim s -> Right s; _ -> Left v+  {-# 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+  _Primitive = _Value._Primitive+  {-# 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 #-}+++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 #-}+  {-# INLINE _Primitive #-}+  _String = prism JsonPartialString $ \v -> case v of JsonPartialString s -> Right s; _ -> Left v+  {-# INLINE _String #-}+  _Bool = prism JsonPartialBool (\v -> case v of JsonPartialBool b -> Right b; _ -> Left v)+  {-# INLINE _Bool #-}+  _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 #-}++------------------------------------------------------------------------------+-- Non-primitive traversals+------------------------------------------------------------------------------++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 . toList) (\v -> case v of+    JsonPartialObject o -> Right (fromList 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+    _                  -> Left v)+  {-# INLINE _Array #-}++instance AsValue JsonPartialValue where+  _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 #-}++-- strictUtf8 :: Iso' String Strict.ByteString+-- strictUtf8 = packed . strictTextUtf8+--+-- strictTextUtf8 :: Iso' Text.Text Strict.ByteString+-- strictTextUtf8 = iso StrictText.encodeUtf8 StrictText.decodeUtf8+--+-- 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+------------------------------------------------------------------------------++type instance Index JsonPartialValue = String++type instance IxValue JsonPartialValue = JsonPartialValue+instance Ixed JsonPartialValue where+  ix i f (JsonPartialObject o) = (JsonPartialObject . toList) <$> ix i f (fromList o)+  ix _ _ v          = pure v+  {-# INLINE ix #-}++instance Plated JsonPartialValue where+  plate f (JsonPartialObject o) = (JsonPartialObject . toList) <$> traverse f (fromList o)+  plate f (JsonPartialArray a) = JsonPartialArray <$> traverse f a+  plate _ xs = pure xs+  {-# INLINE plate #-}
+ src/HaskellWorks/Data/ListMap.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE Trustworthy           #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE TypeFamilies          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module HaskellWorks.Data.ListMap where++import           Control.Lens+import           Data.Monoid+import           Prelude      hiding (lookup, null)+import qualified Prelude      as P++newtype ListMap a = ListMap [(String, a)] deriving (Eq, Show)++instance Functor ListMap where+  fmap f = mapWithKey (\_ v -> f v)+  {-# INLINE fmap #-}++instance Foldable ListMap where+  foldMap f (ListMap as) = foldMap f (snd <$> as)+  {-# INLINE foldMap #-}+  foldr f z (ListMap as) = foldr f z (snd <$> as)+  {-# INLINE foldr #-}+++instance Traversable ListMap where+  traverse f = traverseWithKey (\_ v -> f v)+  {-# INLINE traverse #-}+++type instance Index (ListMap a) = String+type instance IxValue (ListMap a) = a++instance Ixed (ListMap a) where+  ix k f m = case lookup k m of+     Just v  -> f v <&> \v' -> insert k v' m+     Nothing -> pure m+  {-# INLINE ix #-}++instance At (ListMap a) where+  at k f m = f mv <&> \r -> case r of+    Nothing -> maybe m (const (delete k m)) mv+    Just v' -> insert k v' m+    where mv = lookup k m+  {-# INLINE at #-}++-- | @'each' :: 'Traversal' ('Map' c a) ('Map' c b) a b@+instance Each (ListMap a) (ListMap b) a b where+  each = traversed+  {-# INLINE each #-}++instance AsEmpty (ListMap a) where+  _Empty = nearly empty null+  {-# INLINE _Empty #-}++instance FunctorWithIndex String ListMap+instance FoldableWithIndex String ListMap+instance TraversableWithIndex String ListMap where+#if MIN_VERSION_containers(0,5,0)+  itraverse = traverseWithKey+#else+  itraverse f = sequenceA . IntMap.mapWithKey f+#endif+  {-# INLINE [0] itraverse #-}++mapWithKey :: (String -> a -> b) -> ListMap a -> ListMap b+mapWithKey f (ListMap as) = ListMap $ (\(k, v) -> (k, f k v)) <$> as+{-# INLINE mapWithKey #-}++traverseWithKey :: Applicative t => (String -> a -> t b) -> ListMap a -> t (ListMap b)+traverseWithKey f (ListMap as) = ListMap <$> traverse (\(k, v) -> (k,) <$> f k v) as+{-# INLINE traverseWithKey #-}++empty :: ListMap a+empty = ListMap []+{-# INLINE empty #-}++null :: ListMap a -> Bool+null (ListMap xs) = P.null xs+{-# INLINE null #-}++fromList :: [(String, a)] -> ListMap a+fromList = ListMap+{-# INLINE fromList #-}++toList :: ListMap a -> [(String, a)]+toList (ListMap m) = m+{-# INLINE toList #-}++insert :: String -> a -> ListMap a -> ListMap a+insert k v (ListMap m) = ListMap $ case break (\(k', _) -> k' == k) m of+  (ps, _:xs) -> ps <> ((k, v):xs)+  _          -> (k, v) : m+{-# INLINE insert #-}++delete :: String -> ListMap a -> ListMap a+delete k (ListMap m) = ListMap $ case break (\(k', _) -> k' == k) m of+  (ps, _:xs) -> ps <> xs+  _          -> m+{-# INLINE delete #-}++lookup :: String -> ListMap a -> Maybe a+lookup k (ListMap m) = P.lookup k m+{-# INLINE lookup #-}
+ test/HaskellWorks/Data/Json/LensSpec.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}+module HaskellWorks.Data.Json.LensSpec (spec) where++import           GHC.Base+import           Control.Lens+import qualified Data.ByteString as Strict+import           HaskellWorks.Data.ListMap (fromList)+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           Prelude hiding (null)+import           HaskellWorks.Data.BalancedParens.Simple+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Json.Succinct.Cursor+import           HaskellWorks.Data.Json.Succinct.PartialIndex+import           HaskellWorks.Data.Json.PartialValue+import           HaskellWorks.Data.Json.Lens+import           HaskellWorks.Data.FromByteString+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++loadJson :: Strict.ByteString -> JsonCursor Strict.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+loadJson = fromByteString++j :: Strict.ByteString -> JsonPartialValue+j = jsonPartialJsonValueAt . jsonPartialIndexAt . loadJson++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]
+ test/HaskellWorks/Data/Json/NthSpec.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+module HaskellWorks.Data.Json.NthSpec (spec) where++import           GHC.Base+import           Control.Lens+import qualified Data.ByteString as Strict+import qualified Data.Vector.Storable                                       as DVS+import           Data.Word+import           Prelude hiding (null)+import           HaskellWorks.Data.BalancedParens.Simple+import           HaskellWorks.Data.Bits.BitShown+import           HaskellWorks.Data.Json.Succinct.Cursor+import           HaskellWorks.Data.Json.Succinct.PartialIndex+import           HaskellWorks.Data.Json.PartialValue+import           HaskellWorks.Data.Json.Lens+import           HaskellWorks.Data.FromByteString+import           Test.Hspec++{-# ANN module ("HLint: ignore Redundant do"        :: String) #-}+{-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}++loadJson :: Strict.ByteString -> JsonCursor Strict.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64))+loadJson = fromByteString++j :: Strict.ByteString -> JsonPartialValue+j = jsonPartialJsonValueAt . jsonPartialIndexAt . loadJson++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)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}