microlens-aeson (empty) → 2.0.0

raw patch · 12 files changed

+871/−0 lines, 12 filesdep +aesondep +attoparsecdep +basebuild-type:Customsetup-changed

Dependencies added: aeson, attoparsec, base, bytestring, directory, doctest, filepath, generic-deriving, microlens, scientific, semigroups, simple-reflect, text, unordered-containers, vector

Files

• .ghci +1/−0
• .gitignore +13/−0
• .travis.yml +35/−0
• AUTHORS.md +17/−0
• CHANGELOG.md +30/−0
• LICENSE +7/−0
• README.md +78/−0
• Setup.lhs +55/−0
• microlens-aeson.cabal +74/−0
• src/Lens/Micro/Aeson.hs +431/−0
• src/Lens/Micro/Aeson/Internal.hs +57/−0
• tests/doctests.hsc +73/−0

@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h

@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#

@@ -0,0 +1,35 @@+# Use new container infrastructure to enable caching+sudo: false++# Choose a lightweight base image; we provide our own build tools.+language: c++# GHC depends on GMP. You can add other dependencies here as well.+addons:+  apt:+    packages:+    - libgmp-dev++# The different configurations we want to test. You could also do things like+# change flags or use --stack-yaml to point to a different file.+env:+- ARGS=""+# - ARGS="--resolver lts"+- ARGS="--resolver nightly-2015-12-16"+- ARGS="--resolver nightly"++before_install:+# Download and unpack the stack executable+- mkdir -p ~/.local/bin+- export PATH=$HOME/.local/bin:$PATH+- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'++# This line does all of the work: installs GHC if necessary, build the library,+# executables, and test suites, and runs the test suites. --no-terminal works+# around some quirks in Travis's terminal implementation.+script: stack $ARGS --no-terminal --install-ghc test++# Caching so the next build will be fast too.+cache:+  directories:+  - $HOME/.stack

@@ -0,0 +1,17 @@+This project was started by Paul Wilson+[@statusfailed](https://github.com/statusfailed).++Edward Kmett stole it and decided he was going to polish it up and put it on+Hackage. In the process he took all sorts of liberties with the structure of+the project. If you don't like the result, it is probably his fault.++* [Edward Kmett](mailto:ekmett@gmail.com) [@ekmett](https://github.com/ekmett)++In late 2015, Colin Woodbury [@fosskers](https://github.com/fosskers)+further stole this library and converted it to use `microlens`. This was to+be used in a potential fork of+[wreq](http://hackage.haskell.org/package/wreq), which uses the full `lens`+library and all its dependencies.++This change ripped out all `Prism`s in favour of `Traversal`s, which are+sufficient for basic manipulations of Aeson data.

@@ -0,0 +1,30 @@+2.0.0+-----+* Complete conversion to `microlens`++1.0.0.5+-------+* Fix tests to work against vector-0.11+* Documentation fixes+* No functional changes since 1.0.0.4++1.0.0.3+-------+* Move lens upper bound to < 5 like the other packages in the family++1+----+* Module migrated from lens package to Data.Aeson.Lens++0.1.2+-----+* Added `members` and `values`++0.1.1+-----+* Broadened dependencies++0.1+---+* Repository initialized+

@@ -0,0 +1,7 @@+Copyright (C) 2013 Paul Wilson++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,78 @@+microlens-aeson+===============++[![Build Status](https://travis-ci.org/fosskers/microlens-aeson.svg?branch=master)](https://travis-ci.org/fosskers/microlens-aeson)++`microlens-aeson` provides Traversals for the+[Aeson](http://hackage.haskell.org/package/aeson) library's `Value` type,+while obeying the `Traversal` laws.++`microlens-aeson` is derived from `lens-aeson`, but is based upon `microlens`+to reduce the amount of dependencies involved.++Here is the dependency graph for `lens-aeson`:++![lens-aeson dependencies](lens-aeson.png)++And that for `microlens-aeson`:++![microlens-aeson dependencies](microlens-aeson.png)++Usage+-----+`microlens-aeson` provides Traversals into both lazy and strict variants+of all the text types. Here are some examples:++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Data.Aeson+import Data.Text (Text)+import Lens.Micro.Aeson++--------------------------+-- Manipulating primatives+--------------------------+-- | Optionally getting one value+a :: Maybe Int+a = ("37" :: Text) ^? _Integer  -- Just 42++-- | Setting one value within encoded JSON+b :: Maybe Text+b = "true" & _Bool .~ False  -- "false"++----------------------+-- Manipulating arrays+----------------------+-- | Get all values as an Aeson type.+c :: [Value]+c = "[1, 2, 3]" ^.. values  -- [Number 1.0, Number 2.0, Number 3.0]++-- | Get all values cast to some simpler number type.+c :: [Double]+c = "[1, 2, 3]" ^.. values . _Double  -- [1.0, 2.0, 3.0]++-- | Access a specific index, and set a `Value` directly.+d :: Text+d = "[1,2,3]" & nth 1 .~ Number 20  -- "[1,20,3]"++-----------------------+-- Manipulating objects+-----------------------+-- | Access all values of the key/value pairs.+e :: Text+e = "{\"a\":4,\"b\":7}" & members . _Number %~ (*10)  -- "{\"a\":40,\"b\":70}"++-- | Access via a given key.+f :: Maybe Value+f = ("{\"a\": 100, \"b\": 200}" :: Text) ^? key "a"  -- Just (Number 100.0)++-----------------------------------+-- Aeson `Value`s from encoded JSON+-----------------------------------+g :: Maybe Text+g = "{\"a\":4,\"b\":7}" ^? _Value+-- Just (Object (fromList [("a",Number 4.0),("b",Number 7.0)]))+```++See the Haddock documentation for a full API specification.

@@ -0,0 +1,55 @@+#!/usr/bin/runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) []+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}

@@ -0,0 +1,74 @@+name:          microlens-aeson+category:      Numeric+version:       2.0.0+license:       MIT+cabal-version: >= 1.8+license-file:  LICENSE+author:        Colin Woodbury+maintainer:    Colin Woodbury <colingw@gmail.com>+stability:     provisional+homepage:      http://github.com/fosskers/microlens-aeson/+bug-reports:   http://github.com/fosskers/microlens-aeson/issues+copyright:+          Copyright (C) 2012 Paul Wilson+          Copyright (C) 2013 Edward A. Kmett+          Copyright (C) 2015 Colin Woodbury+build-type:    Custom+synopsis:      Law-abiding lenses for Aeson, using microlens.+description:   Law-abiding lenses for Aeson, using microlens.++extra-source-files:+  .travis.yml+  .ghci+  .gitignore+  AUTHORS.md+  README.md+  CHANGELOG.md++source-repository head+  type: git+  location: git://github.com/fosskers/microlens-aeson.git++-- You can disable the doctests test suite with -f-test-doctests+flag test-doctests+  default: True+  manual: True++library+  build-depends:+                  aeson                >= 0.7.0.5   && < 0.11+                , attoparsec           >= 0.10      && < 0.14+                , base                 >= 4.5       && < 5+                , bytestring           >= 0.9       && < 0.11+                , microlens            >= 0.3       && < 0.4+                , scientific           >= 0.3.2     && < 0.4+                , text                 >= 0.11.1.10 && < 1.3+                , unordered-containers >= 0.2.3     && < 0.3+                , vector               >= 0.9       && < 0.12++  exposed-modules:+    Lens.Micro.Aeson++  other-modules:+    Lens.Micro.Aeson.Internal++  ghc-options: -Wall -fwarn-tabs -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+                  , directory      >= 1.0+                  , doctest        >= 0.9.1+                  , filepath+                  , generic-deriving+                  , semigroups     >= 0.9+                  , simple-reflect >= 0.3.1

@@ -0,0 +1,431 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DefaultSignatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module    :  Lens.Micro.Aeson+-- Copyright :  (c) Colin Woodbury 2015, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012+-- License   :  BSD3+-- Maintainer:  Colin Woodbury <colingw@gmail.com>+--+-- Traversals for Data.Aeson, based on microlens for minimal dependencies.+-- +-- For basic manipulation of Aeson values, full `Prism` functionality+-- isn't necessary. Since all Prisms are inherently Traversals, we provide+-- Traversals that mimic the behaviour of the Prisms found in the original+-- Data.Aeson.Lens.++module Lens.Micro.Aeson+  (+  -- * Numbers+    AsNumber(..)+  , _Integral+  , nonNull+  -- * Primitive+  , Primitive(..)+  , AsPrimitive(..)+  -- * Objects and Arrays+  , AsValue(..)+  , key, members+  , nth, values+  -- * Decoding+  , AsJSON(..)+  ) where++import           Data.Aeson+import           Data.Aeson.Parser (value)+import           Data.Attoparsec.ByteString.Lazy (maybeResult, parse)+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.Scientific (Scientific)+import qualified Data.Scientific as Scientific+import           Data.Text as Text+import qualified Data.Text.Encoding as StrictText+import qualified Data.Text.Lazy as LazyText+import qualified Data.Text.Lazy.Encoding as LazyText+import           Data.Vector (Vector)+import           Lens.Micro+import           Lens.Micro.Aeson.Internal ()+import           Prelude hiding (null)++-- $setup+-- >>> import Data.ByteString.Char8 as Strict.Char8+-- >>> import qualified Data.Vector as Vector+-- >>> :set -XOverloadedStrings++------------------------------------------------------------------------------+-- Scientific Traversals+------------------------------------------------------------------------------++-- | Traverse into various number types.+class AsNumber t where+  -- |+  -- >>> "[1, \"x\"]" ^? nth 0 . _Number+  -- Just 1.0+  --+  -- >>> "[1, \"x\"]" ^? nth 1 . _Number+  -- Nothing+  _Number :: Traversal' t Scientific+  default _Number :: AsPrimitive t => Traversal' t Scientific+  _Number = _Primitive . _Number+  {-# INLINE _Number #-}++  -- |+  -- Traversal into an 'Double' over a 'Value', 'Primitive' or 'Scientific'+  --+  -- >>> "[10.2]" ^? nth 0 . _Double+  -- Just 10.2+  _Double :: Traversal' t Double+  _Double = _Number . lens Scientific.toRealFloat (const realToFrac)+  {-# INLINE _Double #-}++  -- |+  -- Traversal 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 :: Traversal' t Integer+  _Integer = _Number . lens floor (const fromIntegral)+  {-# INLINE _Integer #-}++instance AsNumber Value where+  _Number f (Number n) = Number <$> f n+  _Number _ v = pure v+  {-# INLINE _Number #-}++instance AsNumber Scientific where+  _Number = id+  {-# INLINE _Number #-}++instance AsNumber Strict.ByteString+instance AsNumber Lazy.ByteString+instance AsNumber Text+instance AsNumber LazyText.Text+instance AsNumber String++------------------------------------------------------------------------------+-- Conversion Traversals+------------------------------------------------------------------------------++-- | Access Integer 'Value's as Integrals.+--+-- >>> "[10]" ^? nth 0 . _Integral+-- Just 10+--+-- >>> "[10.5]" ^? nth 0 . _Integral+-- Just 10+_Integral :: (AsNumber t, Integral a) => Traversal' t a+_Integral = _Number . lens floor (const fromIntegral)+{-# INLINE _Integral #-}++------------------------------------------------------------------------------+-- Null values and primitives+------------------------------------------------------------------------------++-- | Primitives of 'Value'+data Primitive+  = StringPrim !Text+  | NumberPrim !Scientific+  | BoolPrim !Bool+  | NullPrim+  deriving (Eq,Ord,Show,Data,Typeable)++instance AsNumber Primitive where+  _Number f (NumberPrim n) = NumberPrim <$> f n+  _Number _ p = pure p+  {-# INLINE _Number #-}++-- | Traverse into various JSON primatives.+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 :: Traversal' t Primitive+  default _Primitive :: AsValue t => Traversal' t Primitive+  _Primitive = _Value . _Primitive+  {-# INLINE _Primitive #-}++  -- |+  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String+  -- Just "xyz"+  --+  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String+  -- Nothing+  _String :: Traversal' t Text+  _String = _Primitive . trav+    where trav f (StringPrim s) = StringPrim <$> f s+          trav _ x = pure x+  {-# INLINE _String #-}++  -- |+  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _Bool+  -- Just True+  --+  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool+  -- Nothing+  _Bool :: Traversal' t Bool+  _Bool = _Primitive . trav+    where trav f (BoolPrim b) = BoolPrim <$> f b+          trav _ x = pure x+  {-# INLINE _Bool #-}++  -- |+  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null+  -- Just ()+  --+  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null+  -- Nothing+  _Null :: Traversal' t ()+  _Null = _Primitive . trav+    where trav f NullPrim = const NullPrim <$> f ()+          trav _ x = pure x+  {-# INLINE _Null #-}++-- Helper for the function below.+fromPrim :: Primitive -> Value+fromPrim (StringPrim s) = String s+fromPrim (NumberPrim n) = Number n+fromPrim (BoolPrim b)   = Bool b+fromPrim NullPrim       = Null+{-# INLINE fromPrim #-}++instance AsPrimitive Value where+  _Primitive f (String s) = fromPrim <$> f (StringPrim s)+  _Primitive f (Number n) = fromPrim <$> f (NumberPrim n)+  _Primitive f (Bool b)   = fromPrim <$> f (BoolPrim b)+  _Primitive f Null       = fromPrim <$> f NullPrim+  _Primitive _ v          = pure v+  {-# INLINE _Primitive #-}++  _String f (String s) = String <$> f s+  _String _ v = pure v+  {-# INLINE _String #-}++  _Bool f (Bool b) = Bool <$> f b+  _Bool _ v = pure v+  {-# INLINE _Bool #-}++  _Null f Null = const Null <$> f ()+  _Null _ v = pure 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 #-}++-- | Traversal 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 :: Traversal' Value Value+nonNull _ Null = pure Null+nonNull f v = _Value f v+{-# INLINE nonNull #-}++------------------------------------------------------------------------------+-- Non-primitive traversals+------------------------------------------------------------------------------++-- | Traverse into JSON Objects and Arrays.+class AsPrimitive t => AsValue t where+  -- | Traverse into data that encodes a `Value`+  _Value :: Traversal' t Value++  -- |+  -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object+  -- Just (fromList [])+  --+  -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object+  -- Nothing+  _Object :: Traversal' t (HashMap Text Value)+  _Object = _Value . trav+    where trav f (Object o) = Object <$> f o+          trav _ v = pure v+  {-# INLINE _Object #-}++  _Array :: Traversal' t (Vector Value)+  _Array = _Value . trav+    where trav f (Array a) = Array <$> f a+          trav _ v = pure v+  {-# INLINE _Array #-}++instance AsValue Value 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 => Text -> Traversal' t Value+key i = _Object . ix i+{-# INLINE key #-}++-- | A Traversal into Object properties+--+-- >>> "{\"a\": 4, \"b\": 7}" ^.. members+-- [Number 4.0,Number 7.0]+--+-- >>> "{\"a\": 4, \"b\": 7}" & members . _Number %~ (* 10)+-- "{\"a\":40,\"b\":70}"+members :: AsValue t => Traversal' t Value+members = _Object . traverse+{-# 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 Value+nth i = _Array . ix i+{-# INLINE nth #-}++-- | A 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 => Traversal' t Value+values = _Array . traverse+{-# INLINE values #-}++strictUtf8 :: Lens' String Strict.ByteString+strictUtf8 = lens Text.pack (const Text.unpack) . strictTextUtf8++lazyUtf8 :: Lens' Strict.ByteString Lazy.ByteString+lazyUtf8 = lens Lazy.fromStrict (const Lazy.toStrict)++strictTextUtf8 :: Lens' Text.Text Strict.ByteString+strictTextUtf8 = lens StrictText.encodeUtf8 (const StrictText.decodeUtf8)++lazyTextUtf8 :: Lens' LazyText.Text Lazy.ByteString+lazyTextUtf8 = lens LazyText.encodeUtf8 (const LazyText.decodeUtf8)++-- | Traverse into actual encoded JSON.+class AsJSON t where+  -- | '_JSON' is a 'Traversal' from something containing JSON+  -- to something encoded in that structure.+  _JSON :: Traversal' t Value++instance AsJSON Strict.ByteString where+  _JSON = lazyUtf8 . _JSON+  {-# INLINE _JSON #-}++instance AsJSON Lazy.ByteString where+  _JSON f b = case maybeResult (parse value b) of+    Just v -> encode <$> f v+    _      -> pure b+  {-# 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 = id+  {-# INLINE _JSON #-}++------------------------------------------------------------------------------+-- Some additional tests for prismhood; see https://github.com/ekmett/lens/issues/439.+------------------------------------------------------------------------------++-- $LazyByteStringTests+-- >>> ("42" :: Lazy.ByteString) ^? _JSON+-- Just (Number 42.0)+--+-- >>> ("42" :: Lazy.ByteString) ^? _Integer+-- Just 42++-- $StrictByteStringTests+-- >>> ("42" :: Strict.ByteString) ^? _JSON+-- Just (Number 42.0)+--+-- >>> ("42" :: Lazy.ByteString) ^? _Integer+-- Just 42++-- $StringTests+-- >>> ("42" :: String) ^? _JSON+-- Just (Number 42.0)+--+-- >>> ("42" :: String) ^? _Integer+-- Just 42

@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module    :  Lens.Micro.Aeson.Internal+-- Copyright :  (c) Colin Woodbury 2015, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012+-- License   :  BSD3+-- Maintainer:  Colin Woodbury <colingw@gmail.com>+--+-- These are stolen from `Lens.Micro.Platform` to avoid its dependencies.+-- They're altered to be specific to the Aeson context.+-- Creating instances for `microlens` typeclasses is generally warned+-- against, hence these instances are hidden here.++module Lens.Micro.Aeson.Internal where++import Data.Aeson (Value(..))+import Data.HashMap.Lazy as HashMap+import Data.Text (Text)+import Data.Vector as V+import Lens.Micro.Internal++---++type instance Index Value = Text++type instance IxValue Value = Value++-- | Can only index into the contents of an `Object`,+-- which is a `HashMap`.+instance Ixed Value where+  ix i f (Object o) = Object <$> ix i f o+  ix _ _ v          = pure v+  {-# INLINE ix #-}++type instance Index   (HashMap Text Value) = Text++type instance IxValue (HashMap Text Value) = Value++-- | Straight-forward implementation.+instance Ixed (HashMap Text Value) where+  ix k f m = case HashMap.lookup k m of+    Just v  -> (\v' -> HashMap.insert k v' m) <$> f v+    Nothing -> pure m+  {-# INLINE ix #-}++type instance Index   (V.Vector a) = Int++type instance IxValue (V.Vector a) = a++-- | Also straight-forward. Only applicable for non-zero length `Vector`s.+instance Ixed (V.Vector a) where+  ix i f v+    | 0 <= i && i < V.length v = (\a -> v V.// [(i, a)]) <$> f (v V.! i)+    | otherwise = pure v+  {-# INLINE ix #-}

@@ -0,0 +1,73 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-13 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- 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 (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++##if defined(mingw32_HOST_OS)+##if defined(i386_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##elif defined(x86_64_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif+##endif++-- | Run in a modified codepage where we can print UTF-8 values on Windows.+withUnicode :: IO a -> IO a+##ifdef USE_CP+withUnicode m = do+  cp <- c_GetConsoleCP+  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp+##else+withUnicode m = m+##endif++main :: IO ()+main = withUnicode $ getSources >>= \sources -> doctest $+    "-isrc"+  : "-idist/build/autogen"+  : "-optP-include"+  : "-optPdist/build/autogen/cabal_macros.h"+  : "-hide-all-packages"+  : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c