lens-aeson (empty) → 0.1

raw patch · 14 files changed

+571/−0 lines, 14 filesdep +aesondep +attoparsecdep +basebuild-type:Customsetup-changed

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

Files

• .ghci +1/−0
• .gitignore +13/−0
• .travis.yml +24/−0
• .vim.custom +31/−0
• AUTHORS.markdown +14/−0
• CHANGELOG.markdown +4/−0
• LICENSE +7/−0
• README.markdown +17/−0
• Setup.lhs +55/−0
• lens-aeson.cabal +84/−0
• src/Control/Lens/Aeson.hs +205/−0
• tests/doctests.hsc +73/−0
• travis/cabal-apt-install +27/−0
• travis/config +16/−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,24 @@+language: 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"

@@ -0,0 +1,31 @@+" 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 <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" 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"

@@ -0,0 +1,14 @@+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)++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

@@ -0,0 +1,4 @@+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,17 @@+lens-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

@@ -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,84 @@+name:          lens-aeson+category:      Numeric+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+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/analytics/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    && < 4,+    text                 >= 0.11.2 && < 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

@@ -0,0 +1,205 @@+{-# 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 <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Control.Lens.Aeson+  (+  -- * Numbers+    AsNumber(..)+  , integralValue+  , nonNull+  -- * Primitive+  , Primitive(..)+  , AsPrimitive(..)+  -- * Objects and Arrays+  , AsValue(..)+  , key, nth+  -- * 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+  _Number :: Prism' t Number+  default _Number :: AsPrimitive t => Prism' t Number+  _Number = _Primitive._Number++  -- | Prism into an 'Double' over a 'Value', 'Primitive' or 'Number'+  _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'+  _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'`+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+  _Primitive :: Prism' t Primitive+  default _Primitive :: AsValue t => Prism' t Primitive+  _Primitive = _Value._Primitive++  _String :: Prism' t Text+  _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v)++  _Bool :: Prism' t Bool+  _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v)++  _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+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+  -- |+  -- >>> putStrLn $ "{\"a\": 1, \"b\": 3}" & key "a"._Integer *~ 100+  -- {"a":100,"b":3}+  _Value :: Prism' t Value++  _Object :: Prism' t (HashMap Text Value)+  _Object = _Value.prism Object (\v -> case v of Object o -> Right o; _ -> Left v)++  _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+key :: AsValue t => Text -> IndexedTraversal' Text t Value+key i = _Object . ix i++-- | Like 'ix', but for Arrays with Int indexes+nth :: AsValue t => Int -> IndexedTraversal' Int t Value+nth i = _Array . ix i++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

@@ -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

@@ -0,0 +1,27 @@+#! /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+

@@ -0,0 +1,16 @@+-- 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