lens-aeson-0.1.2/0000755000000000000000000000000012231314042011734 5ustar0000000000000000lens-aeson-0.1.2/.ghci0000644000000000000000000000012512231314042012645 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h lens-aeson-0.1.2/.gitignore0000644000000000000000000000010412231314042013717 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# lens-aeson-0.1.2/.travis.yml0000644000000000000000000000113012231314042014040 0ustar0000000000000000language: haskell before_install: # Uncomment whenever hackage is down. # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update - cabal update - travis/cabal-apt-install $mode install: - cabal configure -flib-Werror $mode - cabal build script: - $script && hlint src --cpp-define HLINT notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313lens-aeson\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" env: - mode="--enable-tests" script="cabal test --show-details=always" lens-aeson-0.1.2/.vim.custom0000644000000000000000000000137712231314042014051 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" lens-aeson-0.1.2/AUTHORS.markdown0000644000000000000000000000125212231314042014625 0ustar0000000000000000This 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) You can watch contributors carry on the quest for bragging rights in the [contributors graph](https://github.com/analytics/compensated/graphs/contributors). Omission from this list is by no means an attempt to discount your contribution. Thank you for all of your help! -Edward Kmett lens-aeson-0.1.2/CHANGELOG.markdown0000644000000000000000000000016412231314042014770 0ustar00000000000000000.1.2 ----- * Added `members` and `values` 0.1.1 ----- * Broadened dependencies 0.1 --- * Repository initialized lens-aeson-0.1.2/lens-aeson.cabal0000644000000000000000000000400412231314042014762 0ustar0000000000000000name: lens-aeson category: Numeric version: 0.1.2 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/lens/lens-aeson/ bug-reports: http://github.com/lens/lens-aeson/issues copyright: Copyright (C) 2012 Paul Wilson Copyright (C) 2013 Edward A. Kmett build-type: Custom tested-with: GHC == 7.4.1, GHC == 7.6.1 synopsis: Law-abiding lenses for aeson description: Law-abiding lenses for aeson extra-source-files: .travis.yml .ghci .gitignore .vim.custom travis/cabal-apt-install travis/config AUTHORS.markdown README.markdown CHANGELOG.markdown source-repository head type: git location: git://github.com/lens/lens-aeson.git -- You can disable the doctests test suite with -f-test-doctests flag test-doctests default: True manual: True flag lib-Werror default: False manual: True library build-depends: base >= 4.3 && < 5, lens >= 3.9 && < 3.11, text >= 0.11.1.10 && < 0.12, vector >= 0.9 && < 0.11, unordered-containers >= 0.2.3 && < 0.3, utf8-string >= 0.3.7 && < 0.4, attoparsec >= 0.10 && < 0.11, bytestring >= 0.9 && < 0.11, aeson >= 0.6 && < 0.7 exposed-modules: Control.Lens.Aeson if flag(lib-Werror) ghc-options: -Werror 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 if impl(ghc<7.6.1) ghc-options: -Werror lens-aeson-0.1.2/LICENSE0000644000000000000000000000203712231314042012743 0ustar0000000000000000Copyright (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. lens-aeson-0.1.2/README.markdown0000644000000000000000000000100212231314042014426 0ustar0000000000000000lens-aeson ========== [![Build Status](https://secure.travis-ci.org/lens/lens-aeson.png)](http://travis-ci.org/lens/lens-aeson) The goal of `lens-aeson` is to provide traversals and prisms for the [Aeson](http://hackage.haskell.org/package/aeson) library's Value type, while obeying the `Traversal`/`Prism` laws. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett lens-aeson-0.1.2/Setup.lhs0000644000000000000000000000464412231314042013554 0ustar0000000000000000#!/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} lens-aeson-0.1.2/src/0000755000000000000000000000000012231314042012523 5ustar0000000000000000lens-aeson-0.1.2/src/Control/0000755000000000000000000000000012231314042014143 5ustar0000000000000000lens-aeson-0.1.2/src/Control/Lens/0000755000000000000000000000000012231314042015044 5ustar0000000000000000lens-aeson-0.1.2/src/Control/Lens/Aeson.hs0000644000000000000000000002114112231314042016444 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DefaultSignatures #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013, (c) Paul Wilson 2012 -- License : BSD3 -- Maintainer: Edward Kmett -- Stability : experimental -- Portability: non-portable -- -------------------------------------------------------------------- module Control.Lens.Aeson ( -- * Numbers AsNumber(..) , integralValue , nonNull -- * Primitive , Primitive(..) , AsPrimitive(..) -- * Objects and Arrays , AsValue(..) , key, members , nth, values -- * Decoding , AsJSON(..) ) where import Control.Applicative import Control.Lens import Data.Aeson import Data.Attoparsec.Number import Data.ByteString.Lazy.Char8 as Lazy hiding (putStrLn) import Data.ByteString.Lazy.UTF8 as UTF8 hiding (decode) import Data.Data import Data.HashMap.Strict (HashMap) import Data.Text import Data.Vector (Vector) import Numeric.Lens import Prelude hiding(null) -- $setup -- >>> :set -XOverloadedStrings ------------------------------------------------------------------------------ -- Number prisms ------------------------------------------------------------------------------ class AsNumber t where -- | -- >>> "[1, \"x\"]" ^? nth 0 . _Number -- Just 1 -- -- >>> "[1, \"x\"]" ^? nth 1 . _Number -- Nothing _Number :: Prism' t Number #ifndef HLINT default _Number :: AsPrimitive t => Prism' t Number _Number = _Primitive._Number #endif -- | -- Prism into an 'Double' over a 'Value', 'Primitive' or 'Number' -- -- >>> "[10.2]" ^? nth 0 . _Double -- Just 10.2 _Double :: Prism' t Double _Double = _Number.prism D (\v -> case v of D d -> Right d; _ -> Left v) -- | -- Prism into an 'Integer' over a 'Value', 'Primitive' or 'Number' -- -- >>> "[10]" ^? nth 0 . _Integer -- Just 10 -- -- >>> "[10.5]" ^? nth 0 . _Integer -- Nothing _Integer :: Prism' t Integer _Integer = _Number.prism I (\v -> case v of I i -> Right i; _ -> Left v) instance AsNumber Value where _Number = prism Number $ \v -> case v of Number n -> Right n; _ -> Left v instance AsNumber Number where _Number = id instance AsNumber ByteString instance AsNumber String ------------------------------------------------------------------------------ -- Conversion Prisms ------------------------------------------------------------------------------ -- | Access Integer 'Value's as Integrals. -- -- defined as `integer . 'Numeric.Lens.integral'` -- -- >>> "[10]" ^? nth 0 . integralValue -- Just 10 -- -- >>> "[10.5]" ^? nth 0 . integralValue -- Nothing integralValue :: (AsNumber t, Integral a) => Prism' t a integralValue = _Integer . integral ------------------------------------------------------------------------------ -- Null values and primitives ------------------------------------------------------------------------------ -- | Primitives of 'Value' data Primitive = StringPrim !Text | NumberPrim !Number | 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 class AsNumber t => AsPrimitive t where -- | -- >>> "[1, \"x\", null, true, false]" ^? nth 0 . _Primitive -- Just (NumberPrim 1) -- -- >>> "[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 #endif -- "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String -- Just "xyz" -- -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String -- Nothing _String :: Prism' t Text _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v) -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _Bool -- Just True -- -- "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool -- Nothing _Bool :: Prism' t Bool _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v) -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null -- Just () -- -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null -- Nothing _Null :: Prism' t () _Null = _Primitive.prism (const NullPrim) (\v -> case v of NullPrim -> Right (); _ -> Left v) 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 fromPrim (StringPrim s) = String s fromPrim (NumberPrim n) = Number n fromPrim (BoolPrim b) = Bool b fromPrim NullPrim = Null _String = prism String $ \v -> case v of String s -> Right s; _ -> Left v _Bool = prism Bool (\v -> case v of Bool b -> Right b; _ -> Left v) _Null = prism (const Null) (\v -> case v of Null -> Right (); _ -> Left v) instance AsPrimitive ByteString instance AsPrimitive String instance AsPrimitive Primitive where _Primitive = id -- | 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) ------------------------------------------------------------------------------ -- Non-primitive traversals ------------------------------------------------------------------------------ class AsPrimitive t => AsValue t where -- | -- >>>"[1,2,3]" ^? _Value -- Just (Array (fromList [Number 1,Number 2,Number 3])) _Value :: Prism' t Value -- | -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object -- Just fromList [] -- -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object -- Nothing _Object :: Prism' t (HashMap Text Value) _Object = _Value.prism Object (\v -> case v of Object o -> Right o; _ -> Left v) -- | -- >>> "[1,2,3]" ^? _Array -- Just (fromList [Number 1,Number 2,Number 3]) _Array :: Prism' t (Vector Value) _Array = _Value.prism Array (\v -> case v of Array a -> Right a; _ -> Left v) instance AsValue Value where _Value = id instance AsValue ByteString where _Value = _JSON instance AsValue String where _Value = iso UTF8.fromString UTF8.toString._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) -- -- >>> "[1,2,3]" ^? key "a" -- Nothing key :: AsValue t => Text -> Traversal' t Value key i = _Object . ix i members :: AsValue t => IndexedTraversal' Text t Value members = _Object . each -- | Like 'ix', but for Arrays with Int indexes -- -- >>> "[1,2,3]" ^? nth 1 -- Just (Number 2) -- -- >>> "\"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 values :: AsValue t => IndexedTraversal' Int t Value values = _Array . traversed class AsJSON t where -- | A Prism into 'Value' on lazy 'ByteString's. _JSON :: (FromJSON a, ToJSON a) => Prism' t a instance AsJSON Lazy.ByteString where _JSON = prism' encode decode instance AsJSON String where _JSON = iso UTF8.fromString UTF8.toString._JSON ------------------------------------------------------------------------------ -- Orphan instances ------------------------------------------------------------------------------ type instance Index Value = Text type instance IxValue Value = Value instance Applicative f => Ixed f Value where ix i = _Object.ix i instance (Applicative f, Gettable f) => Contains f Value where contains i f (Object o) = coerce (contains i f o) contains i f _ = coerce (indexed f i False) instance Plated Value where plate f (Object o) = Object <$> traverse f o plate f (Array a) = Array <$> traverse f a plate _ xs = pure xs lens-aeson-0.1.2/tests/0000755000000000000000000000000012231314042013076 5ustar0000000000000000lens-aeson-0.1.2/tests/doctests.hsc0000644000000000000000000000450112231314042015425 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-13 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 (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 lens-aeson-0.1.2/travis/0000755000000000000000000000000012231314042013244 5ustar0000000000000000lens-aeson-0.1.2/travis/cabal-apt-install0000755000000000000000000000127212231314042016464 0ustar0000000000000000#! /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 lens-aeson-0.1.2/travis/config0000644000000000000000000000120612231314042014433 0ustar0000000000000000-- 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