diff --git a/.ghci b/.ghci deleted file mode 100644 --- a/.ghci +++ /dev/null @@ -1,1 +0,0 @@ -:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,1 @@ +- arguments: [--cpp-define=HLINT, --cpp-ansi] diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 --- a/.travis.yml +++ /dev/null @@ -1,175 +0,0 @@ -# This Travis job script has been generated by a script via -# -# haskell-ci '--output=.travis.yml' '--config=cabal.haskell-ci' 'cabal.project' -# -# For more information, see https://github.com/haskell-CI/haskell-ci -# -# version: 0.5.20180830 -# -language: c -dist: xenial -git: - # whether to recursively clone submodules - submodules: false -notifications: - irc: - channels: - - irc.freenode.org#haskell-lens - skip_join: true - template: - - "\"\\x0313lens-aeson\\x03/\\x0306%{branch}\\x03 \\x0314%{commit}\\x03 %{build_url} %{message}\"" -cache: - directories: - - $HOME/.cabal/packages - - $HOME/.cabal/store -before_cache: - - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log - # remove files that are regenerated by 'cabal update' - - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* - - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar - - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx - - rm -rfv $CABALHOME/packages/head.hackage -matrix: - include: - - compiler: ghc-8.8.1 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}} - - compiler: ghc-8.6.5 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} - - compiler: ghc-8.4.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} - - compiler: ghc-8.2.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} - - compiler: ghc-8.0.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} - - compiler: ghc-7.10.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} - - compiler: ghc-7.8.4 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} - - compiler: ghc-7.6.3 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-3.0"]}} - - compiler: ghc-7.4.2 - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-3.0"]}} - - compiler: ghc-head - addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head"]}} - allow_failures: - - compiler: ghc-head -before_install: - - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') - - WITHCOMPILER="-w $HC" - - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') - - HCPKG="$HC-pkg" - - unset CC - - CABAL=/opt/ghc/bin/cabal - - CABALHOME=$HOME/.cabal - - export PATH="$CABALHOME/bin:$PATH" - - TOP=$(pwd) - - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - - echo $HCNUMVER - - CABAL="$CABAL -vnormal+nowrap+markoutput" - - set -o pipefail - - | - echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk - echo 'BEGIN { state = "output"; }' >> .colorful.awk - echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk - echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk - echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk - echo ' if (state == "cabal") {' >> .colorful.awk - echo ' print blue($0)' >> .colorful.awk - echo ' } else {' >> .colorful.awk - echo ' print $0' >> .colorful.awk - echo ' }' >> .colorful.awk - echo '}' >> .colorful.awk - - cat .colorful.awk - - | - color_cabal_output () { - awk -f $TOP/.colorful.awk - } - - echo text | color_cabal_output -install: - - ${CABAL} --version - - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - - TEST=--enable-tests - - BENCH=--enable-benchmarks - - HEADHACKAGE=false - - if [ $HCNUMVER -gt 80801 ] ; then HEADHACKAGE=true ; fi - - rm -f $CABALHOME/config - - | - echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config - echo "remote-build-reporting: anonymous" >> $CABALHOME/config - echo "write-ghc-environment-files: always" >> $CABALHOME/config - echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config - echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config - echo "world-file: $CABALHOME/world" >> $CABALHOME/config - echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config - echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config - echo "installdir: $CABALHOME/bin" >> $CABALHOME/config - echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config - echo "store-dir: $CABALHOME/store" >> $CABALHOME/config - echo "install-dirs user" >> $CABALHOME/config - echo " prefix: $CABALHOME" >> $CABALHOME/config - echo "repository hackage.haskell.org" >> $CABALHOME/config - echo " url: http://hackage.haskell.org/" >> $CABALHOME/config - - | - if $HEADHACKAGE; then - echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config - echo "repository head.hackage.ghc.haskell.org" >> $CABALHOME/config - echo " url: https://ghc.gitlab.haskell.org/head.hackage/" >> $CABALHOME/config - echo " secure: True" >> $CABALHOME/config - echo " root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d" >> $CABALHOME/config - echo " 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329" >> $CABALHOME/config - echo " f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89" >> $CABALHOME/config - echo " key-threshold: 3" >> $CABALHOME/config - fi - - cat $CABALHOME/config - - rm -fv cabal.project cabal.project.local cabal.project.freeze - - travis_retry ${CABAL} v2-update -v - - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 80802 ] ; then (cd /tmp && ${CABAL} v2-install $WITHCOMPILER -j2 hlint --constraint='hlint ==2.1.*' | color_cabal_output) ; fi - # Generate cabal.project - - rm -rf cabal.project cabal.project.local cabal.project.freeze - - touch cabal.project - - | - echo "packages: ." >> cabal.project - - | - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(lens-aeson)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi - - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output - - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - - rm cabal.project.freeze - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output -script: - - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) - # Packaging... - - ${CABAL} v2-sdist all | color_cabal_output - # Unpacking... - - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - - cd ${DISTDIR} || false - - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; - - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; - - PKGDIR_lens_aeson="$(find . -maxdepth 1 -type d -regex '.*/lens-aeson-[0-9.]*')" - # Generate cabal.project - - rm -rf cabal.project cabal.project.local cabal.project.freeze - - touch cabal.project - - | - echo "packages: ${PKGDIR_lens_aeson}" >> cabal.project - - | - - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(lens-aeson)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - - cat cabal.project || true - - cat cabal.project.local || true - # Building with tests and benchmarks... - # build & run tests, build benchmarks - - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output - # Testing... - - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output - # HLint.. - - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 80802 ] ; then (cd ${PKGDIR_lens_aeson} && hlint --cpp-ansi --cpp-define=HLINT src) ; fi - # cabal check... - - (cd ${PKGDIR_lens_aeson} && ${CABAL} -vnormal check) - # haddock... - - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output - -# REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"] -# EOF diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,77 @@ +1.2.3 [2023.06.27] +------------------ +* Use `aeson`'s `decode` function in the `AsJSON` instance for `ByteString`s. + This allows removing a direct dependency on `attoparsec`. +* Allow building with `aeson-2.2`. + +1.2.2 [2022.08.11] +------------------ +* Add `atKey :: AsValue t => Key -> Traversal' t (Maybe Value)`, a variant of + `key` that uses `at` instead of `ix`. + +1.2.1 [2022.05.07] +------------------ +* Change the `IsKey` instances for `ByteString`s to use + `decodeUtf8With lenientDecode` instead of `decodeUtf8`. While these `IsKey` + instances are meant to used for interoperability with `aeson` values that + are UTF-8–encoded, using `decodeUtf8With lenientDecode` at least ensures + that converting a non–UTF-8–encoded `ByteString` will not crash. + +1.2 [2022.03.19] +---------------- +* Require `aeson-2.0.2.*` and `lens-5.0.*` or greater. +* Change the types of `_Object`, `key`, and `members`: + + ```diff + -_Object :: Prism' t (HashMap Text Value) + +_Object :: Prism' t (KeyMap Value) + + -key :: AsValue t => Text -> Traversal' t Value + +key :: AsValue t => Key -> Traversal' t Value + + -members :: AsValue t => IndexedTraversal' Text t Value + +members :: AsValue t => IndexedTraversal' Key t Value + ``` + + This mirrors similar changes made in `aeson-2.0.*`, where the type of + `Object`'s field was changed from `HashMap Text Value` to `KeyMap Value`. + + The `Ixed Value` instance changes similarly: + + ```diff + -type instance Index Value = Text + +type instance Index Value = Key + ``` +* Remove `Primitive` and `AsPrimitive`, since https://tools.ietf.org/html/rfc7159 + de-emphasized the notion of primitive versus composite JSON values. + * The `AsPrimitive` methods (`_Value`, `_String`, and `_Bool`) are now + `AsValue` methods. + * `_Number`'s default signature, `Bool_`, `String_`, and `Null_` now have an + `AsValue` constraint. +* Add `Wrapped` and `Rewrapped` instances for `KeyMap`. These treat `KeyMap v` + as a wrapper around `[(Key, v)]`. The order in which the key-value pairs + appear in this list is not stable. +* Add an `IsKey` class, whose method `_Key` is an `Iso` for converting values + to and from a `Key`. + +1.1.3 [2021.11.16] +------------------ +* Drop support for pre-8.0 versions of GHC. + +1.1.2 [2021.10.09] +------------------ +* Allow building with `aeson-2.0.0.0`. +* Add `Index`, `IxValue`, `Ixed`, `At`, and `Each` instances for `KeyMap` if + building with `aeson-2.0.0.0` or later. + +1.1.1 [2021.02.17] +------------------ +* Allow building with `lens-5.*`. +* The build-type has been changed from `Custom` to `Simple`. + To achieve this, the `doctests` test suite has been removed in favor of using + [`cabal-docspec`](https://github.com/phadej/cabal-extras/tree/master/cabal-docspec) + to run the doctests. + 1.1 [2019.09.26] ---------------- * Generalize the type of `_JSON` from `Prism' t a` to `Prism t t a b`. If you @@ -42,4 +116,3 @@ 0.1 --- * Repository initialized - diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,7 +1,7 @@ lens-aeson ========== -[![Hackage](https://img.shields.io/hackage/v/lens-aeson.svg)](https://hackage.haskell.org/package/lens-aeson) [![Build Status](https://secure.travis-ci.org/lens/lens-aeson.svg)](http://travis-ci.org/lens/lens-aeson) +[![Hackage](https://img.shields.io/hackage/v/lens-aeson.svg)](https://hackage.haskell.org/package/lens-aeson) [![Build Status](https://github.com/lens/lens-aeson/workflows/Haskell-CI/badge.svg)](https://github.com/lens/lens-aeson/actions?query=workflow%3AHaskell-CI) The goal of `lens-aeson` is to provide traversals and prisms for the [Aeson](http://hackage.haskell.org/package/aeson) library's diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,34 +1,7 @@ -\begin{code} -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -Wall #-} -module Main (main) where - -#ifndef MIN_VERSION_cabal_doctest -#define MIN_VERSION_cabal_doctest(x,y,z) 0 -#endif - -#if MIN_VERSION_cabal_doctest(1,0,0) - -import Distribution.Extra.Doctest ( defaultMainWithDoctests ) -main :: IO () -main = defaultMainWithDoctests "doctests" - -#else - -#ifdef MIN_VERSION_Cabal --- If the macro is defined, we have new cabal-install, --- but for some reason we don't have cabal-doctest in package-db --- --- Probably we are running cabal sdist, when otherwise using new-build --- workflow -import Warning () -#endif - -import Distribution.Simple - -main :: IO () -main = defaultMain +#!/usr/bin/runhaskell +> module Main (main) where -#endif +> import Distribution.Simple -\end{code} +> main :: IO () +> main = defaultMain diff --git a/Warning.hs b/Warning.hs deleted file mode 100644 --- a/Warning.hs +++ /dev/null @@ -1,5 +0,0 @@ -module Warning - {-# WARNING ["You are configuring this package without cabal-doctest installed.", - "The doctests test-suite will not work as a result.", - "To fix this, install cabal-doctest before configuring."] #-} - () where diff --git a/lens-aeson.cabal b/lens-aeson.cabal --- a/lens-aeson.cabal +++ b/lens-aeson.cabal @@ -1,8 +1,8 @@ name: lens-aeson -category: Numeric -version: 1.1 +category: Data, JSON, Lenses +version: 1.2.3 license: MIT -cabal-version: >= 1.8 +cabal-version: >= 1.10 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett @@ -12,77 +12,47 @@ copyright: Copyright (C) 2012 Paul Wilson Copyright (C) 2013 Edward A. Kmett -build-type: Custom -tested-with: GHC == 7.4.2 - , GHC == 7.6.3 - , GHC == 7.8.4 - , GHC == 7.10.3 - , GHC == 8.0.2 +build-type: Simple +tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 - , GHC == 8.8.1 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.7 + , GHC == 9.4.5 + , GHC == 9.6.2 synopsis: Law-abiding lenses for aeson description: Law-abiding lenses for aeson. extra-source-files: - .travis.yml - .ghci .gitignore + .hlint.yaml .vim.custom - travis/cabal-apt-install - travis/config AUTHORS.markdown README.markdown CHANGELOG.markdown - Warning.hs source-repository head type: git location: https://github.com/lens/lens-aeson -custom-setup - setup-depends: - base >= 4 && < 5, - Cabal, - cabal-doctest >= 1 && < 1.1 - --- You can disable the doctests test suite with -f-test-doctests -flag test-doctests - default: True - manual: True - library build-depends: - base >= 4.5 && < 5, - lens >= 4.4 && < 5, - text >= 0.11.1.10 && < 1.3, - vector >= 0.9 && < 0.13, + base >= 4.9 && < 5, + lens >= 5.0 && < 6, + text >= 0.11.1.10 && < 2.1, + text-short >= 0.1.4 && < 0.2, + vector >= 0.9 && < 0.14, unordered-containers >= 0.2.3 && < 0.3, - attoparsec >= 0.10 && < 0.14, - bytestring >= 0.9 && < 0.11, - aeson >= 0.7.0.5 && < 1.5, + bytestring >= 0.9 && < 0.12, + aeson >= 2.0.2 && < 2.3, scientific >= 0.3.2 && < 0.4 exposed-modules: Data.Aeson.Lens - ghc-options: -Wall -fwarn-tabs -O2 + ghc-options: -Wall -Wtabs -O2 hs-source-dirs: src - -test-suite doctests - type: exitcode-stdio-1.0 - main-is: doctests.hs - ghc-options: -Wall -threaded - hs-source-dirs: tests - - if !flag(test-doctests) - buildable: False - else - build-depends: - base, - doctest >= 0.11.1 && < 0.17, - generic-deriving, - lens-aeson, - semigroups >= 0.9, - simple-reflect >= 0.3.1 + default-language: Haskell2010 diff --git a/src/Data/Aeson/Lens.hs b/src/Data/Aeson/Lens.hs --- a/src/Data/Aeson/Lens.hs +++ b/src/Data/Aeson/Lens.hs @@ -1,17 +1,14 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DefaultSignatures #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} -#endif +{-# OPTIONS_GHC -Wno-orphans #-} -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2019, (c) Paul Wilson 2012 @@ -29,44 +26,41 @@ AsNumber(..) , _Integral , nonNull - -- * Primitive - , Primitive(..) - , AsPrimitive(..) -- * Objects and Arrays , AsValue(..) - , key, members + , key, atKey, members , nth, values + , IsKey(..) -- * Decoding , AsJSON(..) , _JSON' -- * Pattern Synonyms -#if __GLASGOW_HASKELL__ >= 800 , pattern JSON , pattern Value_ , pattern Number_ , pattern Double , pattern Integer , pattern Integral - , pattern Primitive , pattern Bool_ , pattern String_ , pattern Null_ -#endif + , pattern Key_ ) where import Control.Applicative import Control.Lens import Data.Aeson -import Data.Aeson.Parser (value) -import Data.Attoparsec.ByteString.Lazy (maybeResult, parse) +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson.KeyMap (KeyMap) import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import qualified Data.ByteString as Strict import Data.ByteString.Lazy.Char8 as Lazy hiding (putStrLn) -import Data.Data -import Data.HashMap.Strict (HashMap) import Data.Text as Text +import qualified Data.Text.Encoding.Error as Encoding import qualified Data.Text.Lazy as LazyText +import Data.Text.Short (ShortText) import Data.Text.Lens (packed) import qualified Data.Text.Encoding as StrictText import qualified Data.Text.Lazy.Encoding as LazyText @@ -74,7 +68,12 @@ import Prelude hiding (null) -- $setup +-- >>> import Control.Lens +-- >>> import Data.Aeson +-- >>> import Data.Text (Text) +-- >>> import qualified Data.ByteString as Strict (ByteString) -- >>> import Data.ByteString.Char8 as Strict.Char8 +-- >>> import qualified Data.ByteString.Lazy as Lazy (ByteString) -- >>> import qualified Data.Vector as Vector -- >>> :set -XOverloadedStrings @@ -90,12 +89,12 @@ -- >>> "[1, \"x\"]" ^? nth 1 . _Number -- Nothing _Number :: Prism' t Scientific - default _Number :: AsPrimitive t => Prism' t Scientific - _Number = _Primitive._Number + default _Number :: AsValue t => Prism' t Scientific + _Number = _Value._Number {-# INLINE _Number #-} -- | - -- Prism into an 'Double' over a 'Value', 'Primitive' or 'Scientific' + -- Prism into an 'Double' over a 'Value' or 'Scientific' -- -- >>> "[10.2]" ^? nth 0 . _Double -- Just 10.2 @@ -104,7 +103,7 @@ {-# INLINE _Double #-} -- | - -- Prism into an 'Integer' over a 'Value', 'Primitive' or 'Scientific' + -- Prism into an 'Integer' over a 'Value' or 'Scientific' -- -- >>> "[10]" ^? nth 0 . _Integer -- Just 10 @@ -148,41 +147,32 @@ {-# INLINE _Integral #-} ------------------------------------------------------------------------------ --- Null values and primitives +-- Null values ------------------------------------------------------------------------------ --- | Primitives of 'Value' -data Primitive - = StringPrim !Text - | NumberPrim !Scientific - | BoolPrim !Bool - | NullPrim - deriving (Eq,Ord,Show,Data,Typeable) +-- | 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' Value Value +nonNull = prism id (\v -> if isn't _Null v then Right v else Left v) +{-# INLINE nonNull #-} -instance AsNumber Primitive where - _Number = prism NumberPrim $ \v -> case v of NumberPrim s -> Right s; _ -> Left v - {-# INLINE _Number #-} +------------------------------------------------------------------------------ +-- Non-number traversals +------------------------------------------------------------------------------ -class AsNumber t => AsPrimitive t where +class AsNumber t => AsValue 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 - default _Primitive :: AsValue t => Prism' t Primitive - _Primitive = _Value._Primitive - {-# INLINE _Primitive #-} + -- >>> preview _Value "[1,2,3]" == Just (Array (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])) + -- True + _Value :: Prism' t Value -- | -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String @@ -191,10 +181,10 @@ -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String -- Nothing -- - -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")] :: String + -- >>> _Object._Wrapped # [("key" :: Key, _String # "value")] :: String -- "{\"key\":\"value\"}" _String :: Prism' t Text - _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v) + _String = _Value.prism String (\v -> case v of String s -> Right s; _ -> Left v) {-# INLINE _String #-} -- | @@ -210,7 +200,7 @@ -- >>> _Bool # False :: String -- "false" _Bool :: Prism' t Bool - _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v) + _Bool = _Value.prism Bool (\v -> case v of Bool b -> Right b; _ -> Left v) {-# INLINE _Bool #-} -- | @@ -223,76 +213,19 @@ -- >>> _Null # () :: String -- "null" _Null :: Prism' t () - _Null = _Primitive.prism (const NullPrim) (\v -> case v of NullPrim -> Right (); _ -> Left v) - {-# INLINE _Null #-} - - -instance AsPrimitive Value where - _Primitive = prism fromPrim toPrim - where - toPrim (String s) = Right $ StringPrim s - toPrim (Number n) = Right $ NumberPrim n - toPrim (Bool b) = Right $ BoolPrim b - toPrim Null = Right NullPrim - toPrim v = Left v - {-# INLINE toPrim #-} - fromPrim (StringPrim s) = String s - fromPrim (NumberPrim n) = Number n - fromPrim (BoolPrim b) = Bool b - fromPrim NullPrim = Null - {-# INLINE fromPrim #-} - {-# INLINE _Primitive #-} - _String = prism String $ \v -> case v of String s -> Right s; _ -> Left v - {-# INLINE _String #-} - _Bool = prism Bool (\v -> case v of Bool b -> Right b; _ -> Left v) - {-# INLINE _Bool #-} - _Null = prism (const Null) (\v -> case v of Null -> Right (); _ -> Left v) + _Null = _Value.prism (const Null) (\v -> case v of Null -> 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' Value Value -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 Value - - -- | -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object -- Just (fromList []) -- -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object -- Nothing -- - -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")] :: String + -- >>> _Object._Wrapped # [("key" :: Key, _String # "value")] :: String -- "{\"key\":\"value\"}" - _Object :: Prism' t (HashMap Text Value) + _Object :: Prism' t (KeyMap Value) _Object = _Value.prism Object (\v -> case v of Object o -> Right o; _ -> Left v) {-# INLINE _Object #-} @@ -328,7 +261,7 @@ {-# INLINE _Value #-} -- | --- Like 'ix', but for 'Object' with Text indices. This often has better +-- Like 'ix', but for 'Object' with 'Key' indices. This often has better -- inference than 'ix' when used with OverloadedStrings. -- -- >>> "{\"a\": 100, \"b\": 200}" ^? key "a" @@ -336,10 +269,23 @@ -- -- >>> "[1,2,3]" ^? key "a" -- Nothing -key :: AsValue t => Text -> Traversal' t Value +key :: AsValue t => Key -> Traversal' t Value key i = _Object . ix i {-# INLINE key #-} +-- | +-- Like 'key', but uses 'at' instead of 'ix'. This is handy when +-- adding and removing object keys: +-- +-- >>> "{\"a\": 100, \"b\": 200}" & atKey "a" .~ Nothing +-- "{\"b\":200}" +-- +-- >>> "{\"a\": 100, \"b\": 200}" & atKey "c" ?~ String "300" +-- "{\"a\":100,\"b\":200,\"c\":\"300\"}" +atKey :: AsValue t => Key -> Traversal' t (Maybe Value) +atKey i = _Object . at i +{-# INLINE atKey #-} + -- | An indexed Traversal into Object properties -- -- >>> Data.List.sort ("{\"a\": 4, \"b\": 7}" ^@.. members . _Number) @@ -347,7 +293,7 @@ -- -- >>> "{\"a\": 4}" & members . _Number *~ 10 -- "{\"a\":40}" -members :: AsValue t => IndexedTraversal' Text t Value +members :: AsValue t => IndexedTraversal' Key t Value members = _Object . itraversed {-# INLINE members #-} @@ -380,14 +326,77 @@ strictUtf8 = packed . strictTextUtf8 strictTextUtf8 :: Iso' Text.Text Strict.ByteString -strictTextUtf8 = iso StrictText.encodeUtf8 StrictText.decodeUtf8 +strictTextUtf8 = iso StrictText.encodeUtf8 (StrictText.decodeUtf8With Encoding.lenientDecode) lazyTextUtf8 :: Iso' LazyText.Text Lazy.ByteString -lazyTextUtf8 = iso LazyText.encodeUtf8 LazyText.decodeUtf8 +lazyTextUtf8 = iso LazyText.encodeUtf8 (LazyText.decodeUtf8With Encoding.lenientDecode) _JSON' :: (AsJSON t, FromJSON a, ToJSON a) => Prism' t a _JSON' = _JSON + +class IsKey t where + -- | '_Key' is an 'Iso' from something to a 'Key'. This is primarily intended + -- for situations where one wishes to use object keys that are not string + -- literals and therefore must be converted: + -- + -- >>> let k = "a" :: Text + -- >>> "{\"a\": 100, \"b\": 200}" ^? key (k ^. _Key) + -- Just (Number 100.0) + -- + -- Note that applying '_Key' directly to a string literal + -- (e.g., @\"a\" ^. '_Key'@) will likely not typecheck when + -- @OverloadedStrings@ is enabled. + _Key :: Iso' t Key + +instance IsKey Key where + _Key = id + {-# INLINE _Key #-} + +instance IsKey String where + _Key = iso Key.fromString Key.toString + {-# INLINE _Key #-} + +instance IsKey Text.Text where + _Key = iso Key.fromText Key.toText + {-# INLINE _Key #-} + +instance IsKey LazyText.Text where + _Key = strict._Key + {-# INLINE _Key #-} + +instance IsKey ShortText where + _Key = iso Key.fromShortText Key.toShortText + {-# INLINE _Key #-} + +-- | This instance assumes that you are dealing with UTF-8–encoded +-- 'Strict.ByteString's, as this is the encoding that RFC 8259 requires JSON +-- values to use. As such, this is not a full 'Iso', since non–UTF-8–encoded +-- 'Strict.ByteString's will not roundtrip: +-- +-- >>> let str = view _Key ("\255" :: Strict.ByteString) +-- >>> str +-- "\65533" +-- >>> view (from _Key) str :: Strict.ByteString +-- "\239\191\189" +instance IsKey Strict.ByteString where + _Key = from strictTextUtf8._Key + {-# INLINE _Key #-} + +-- | This instance assumes that you are dealing with UTF-8–encoded +-- 'Lazy.ByteString's, as this is the encoding that RFC 8259 requires JSON +-- values to use. As such, this is not a full 'Iso', since non–UTF-8–encoded +-- 'Lazy.ByteString's will not roundtrip: +-- +-- >>> let str = view _Key ("\255" :: Lazy.ByteString) +-- >>> str +-- "\65533" +-- >>> view (from _Key) str :: Lazy.ByteString +-- "\239\191\189" +instance IsKey Lazy.ByteString where + _Key = from lazyTextUtf8._Key + {-# INLINE _Key #-} + class AsJSON t where -- | '_JSON' is a 'Prism' from something containing JSON to something encoded in that structure _JSON :: (FromJSON a, ToJSON b) => Prism t t a b @@ -397,12 +406,7 @@ {-# 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 + _JSON = prism' encode decode {-# INLINE _JSON #-} instance AsJSON String where @@ -428,6 +432,8 @@ ------------------------------------------------------------------------------ -- $LazyByteStringTests +-- >>> import qualified Data.ByteString.Lazy.Char8 as Lazy +-- -- >>> "42" ^? (_JSON :: Prism' Lazy.ByteString Value) -- Just (Number 42.0) -- @@ -438,6 +444,8 @@ -- "42" -- $StrictByteStringTests +-- >>> import qualified Data.ByteString.Char8 as Strict +-- -- >>> "42" ^? (_JSON :: Prism' Strict.ByteString Value) -- Just (Number 42.0) -- @@ -461,7 +469,7 @@ -- Orphan instances for lens library interop ------------------------------------------------------------------------------ -type instance Index Value = Text +type instance Index Value = Key type instance IxValue Value = Value instance Ixed Value where @@ -475,11 +483,31 @@ plate _ xs = pure xs {-# INLINE plate #-} +type instance Index (KM.KeyMap v) = Key.Key +type instance IxValue (KM.KeyMap v) = v + +instance Ixed (KM.KeyMap v) + +instance At (KM.KeyMap v) where + at k f = KM.alterF f k + {-# INLINE at #-} + +instance Each (KM.KeyMap a) (KM.KeyMap b) a b where + each = traversed + {-# INLINE each #-} + +-- | Use @'iso' 'KM.toList' 'KM.fromList'@. +-- Unwrapping returns some permutation of the list. +instance (t ~ KeyMap v') => Rewrapped (KeyMap v) t +instance Wrapped (KeyMap v) where + type Unwrapped (KeyMap v) = [(Key, v)] + _Wrapped' = iso KM.toList KM.fromList + {-# INLINE _Wrapped' #-} + ------------------------------------------------------------------------------ -- Pattern Synonyms ------------------------------------------------------------------------------ -#if __GLASGOW_HASKELL__ >= 800 pattern JSON :: (FromJSON a, ToJSON a, AsJSON t) => () => a -> t pattern JSON a <- (preview _JSON -> Just a) where JSON a = _JSON # a @@ -504,19 +532,18 @@ pattern Integral d <- (preview _Integral -> Just d) where Integral d = _Integral # d -pattern Primitive :: AsPrimitive t => Primitive -> t -pattern Primitive p <- (preview _Primitive -> Just p) where - Primitive p = _Primitive # p - -pattern Bool_ :: AsPrimitive t => Bool -> t +pattern Bool_ :: AsValue t => Bool -> t pattern Bool_ b <- (preview _Bool -> Just b) where Bool_ b = _Bool # b -pattern String_ :: AsPrimitive t => Text -> t +pattern String_ :: AsValue t => Text -> t pattern String_ p <- (preview _String -> Just p) where String_ p = _String # p -pattern Null_ :: AsPrimitive t => t +pattern Null_ :: AsValue t => t pattern Null_ <- (preview _Null -> Just ()) where Null_ = _Null # () -#endif + +pattern Key_ :: IsKey t => Key -> t +pattern Key_ k <- (preview _Key -> Just k) where + Key_ k = _Key # k diff --git a/tests/doctests.hs b/tests/doctests.hs deleted file mode 100644 --- a/tests/doctests.hs +++ /dev/null @@ -1,25 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Main (doctests) --- Copyright : (C) 2012-14 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett --- Stability : provisional --- Portability : portable --- --- This module provides doctests for a project based on the actual versions --- of the packages it was built with. It requires a corresponding Setup.lhs --- to be added to the project ------------------------------------------------------------------------------ -module Main where - -import Build_doctests (flags, pkgs, module_sources) -import Data.Foldable (traverse_) -import Test.DocTest - -main :: IO () -main = do - traverse_ putStrLn args - doctest args - where - args = flags ++ pkgs ++ module_sources diff --git a/travis/cabal-apt-install b/travis/cabal-apt-install deleted file mode 100644 --- a/travis/cabal-apt-install +++ /dev/null @@ -1,27 +0,0 @@ -#! /bin/bash -set -eu - -APT="sudo apt-get -q -y" -CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall" - -$APT update -$APT install dctrl-tools - -# Find potential system packages to satisfy cabal dependencies -deps() -{ - local M='^\([^ ]\+\)-[0-9.]\+ (.*$' - local G=' -o ( -FPackage -X libghc-\L\1\E-dev )' - local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \ - | sed -ne "s/$M/$G/p" | sort -u)" - grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u -} - -$APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special -$CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage - -if ! $APT install hlint ; then - $APT install $(deps hlint) - cabal install hlint -fi - diff --git a/travis/config b/travis/config deleted file mode 100644 --- a/travis/config +++ /dev/null @@ -1,16 +0,0 @@ --- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix --- --- This is particularly useful for travis-ci to get it to stop complaining --- about a broken build when everything is still correct on our end. --- --- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead --- --- To enable this, uncomment the before_script in .travis.yml - -remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive -remote-repo-cache: ~/.cabal/packages -world-file: ~/.cabal/world -build-summary: ~/.cabal/logs/build.log -remote-build-reporting: anonymous -install-dirs user -install-dirs global