packages feed

lens 4.1.2.1 → 4.2

raw patch · 43 files changed

+734/−509 lines, 43 filesdep +attoparsecdep −utf8-stringdep ~mtldep ~scientificdep ~transformers

Dependencies added: attoparsec

Dependencies removed: utf8-string

Dependency ranges changed: mtl, scientific, transformers

Files

.gitignore view
@@ -14,3 +14,4 @@ *# .cabal-sandbox/ cabal.sandbox.config+codex.tags
.travis.yml view
@@ -3,7 +3,7 @@ env:   - GHCVER=7.4.2   - GHCVER=7.6.3-  - GHCVER=7.8.1+  - GHCVER=7.8.2   - GHCVER=head   # - >   #   GHCVER=7.4.2@@ -37,7 +37,7 @@    # Update happy when building with GHC head   - |-    if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.1" ]; then+    if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.2" ]; then       $CABAL install happy alex       export PATH=$HOME/.cabal/bin:$PATH     fi
.vim.custom view
@@ -15,7 +15,7 @@ syntax on  " search for the tags file anywhere between here and /-set tags=TAGS;/+set tags=TAGS;/,codex.tags;/  " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗
AUTHORS.markdown view
@@ -36,6 +36,7 @@ * [Michael Thompson](mailto:what_is_it_to_do_anything@yahoo.com) [@michaelt](https://github.com/michaelt) * [John Wiegley](mailto:johnw@newartisans.com) [@jwiegley](https://github.com/jwiegley) * [Jonathan Fischoff](mailto:jfischoff@yahoo.com) [@jfischoff](https://github.com/jfischoff)+* [Bradford Larsen](mailto:brad.larsen@gmail.com) [@bradlarsen](https://github.com/bradlarsen)  You can watch them carry on the quest for bragging rights in the [contributors graph](https://github.com/ekmett/lens/graphs/contributors).
CHANGELOG.markdown view
@@ -1,6 +1,10 @@-4.1.2.1-------* Bump `scientific` upper bound to < 0.4+4.2+---+* Added `_Text` isomorphisms to make the proper use with `(#)` more obvious and fit newer convention.+* Added `Wrapped` instances for `Vector` types+* Resolved issue #439.  The various `Prism`s for string-like types in `Data.Aeson.Lens` are now law-abiding `Prism`s "up to quotient."+* Added `selfIndex`.+* Support `attoparsec` 0.12.  4.1.2 -----
README.markdown view
@@ -1,7 +1,7 @@ Lens: Lenses, Folds, and Traversals ================================== -[![Build Status](https://secure.travis-ci.org/ekmett/lens.png)](http://travis-ci.org/ekmett/lens)+[![Build Status](https://secure.travis-ci.org/ekmett/lens.svg)](http://travis-ci.org/ekmett/lens)  This package provides families of [lenses](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Type.hs), [isomorphisms](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Iso.hs), [folds](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Fold.hs), [traversals](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Traversal.hs), [getters](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Getter.hs) and [setters](https://github.com/ekmett/lens/blob/master/src/Control/Lens/Setter.hs).
− examples/Brainfuck.hs 
@@ -1,153 +0,0 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveFunctor #-}--------------------------------------------------------------------------------- |--- Module      :  Brainfuck--- Copyright   :  (C) 2012 Edward Kmett, nand`--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  TH, Rank2, NoMonomorphismRestriction------ A simple interpreter for the esoteric programming language "Brainfuck"--- written using lenses and zippers.-------------------------------------------------------------------------------module Main where--import Prelude hiding (Either(..))--import Control.Lens-import Control.Applicative-import Control.Monad.State-import Control.Monad.Writer--import qualified Data.ByteString.Lazy as BS-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Word (Word8)--import System.Environment (getArgs)-import System.IO---- | Brainfuck is defined to have a memory of 30000 cells.-memoryCellNum :: Int-memoryCellNum = 30000---- Low level syntax form--data Instr = Plus | Minus | Right | Left | Comma | Dot | Open | Close-type Code = [Instr]--parse :: String -> Code-parse = mapMaybe (`lookup` symbols)-  where symbols = [ ('+', Plus ), ('-', Minus), ('<', Left), ('>', Right)-                  , (',', Comma), ('.', Dot  ), ('[', Open), (']', Close) ]---- Higher level semantic graph--data Program-  = Succ Program | Pred Program  -- Increment or decrement the current value-  | Next Program | Prev Program  -- Shift memory left or right-  | Read Program | Write Program -- Input or output the current value-  | Halt                         -- End execution--  -- Branching semantic, used for both sides of loops-  | Branch { zero :: Program, nonzero :: Program }--compile :: Code -> Program-compile = fst . bracket []--bracket :: [Program] -> Code -> (Program, [Program])-bracket [] []        = (Halt, [])-bracket _  []        = error "Mismatched opening bracket"-bracket [] (Close:_) = error "Mismatched closing bracket"---- Match a closing bracket: Pop a forward continuation, push backwards-bracket (c:cs) (Close : xs) = (Branch n c, n:bs)-  where (n, bs) = bracket cs xs---- Match an opening bracket: Pop a backwards continuation, push forwards-bracket cs (Open : xs) = (Branch b n, bs)-  where (n, b:bs) = bracket (n:cs) xs---- Match any other symbol in the trivial way-bracket cs (x:xs) = over _1 (f x) (bracket cs xs)-  where-    f Plus  = Succ; f Minus = Pred-    f Right = Next; f Left  = Prev-    f Comma = Read; f Dot   = Write---- * State/Writer-based interpreter--type Cell   = Word8-type Input  = [Cell]-type Output = [Cell]-type Memory = Top :>> [Cell] :>> Cell -- list zipper--data MachineState = MachineState-  { _input  :: [Cell]-  , _memory :: Memory }-makeLenses ''MachineState--type Interpreter = StateT MachineState (Writer Output) ()---- | Initial memory configuration-initial :: Input -> MachineState-initial i = MachineState i (zipper (replicate memoryCellNum 0) & fromWithin traverse)--interpret :: Input -> Program -> Output-interpret i = execWriter . flip execStateT (initial i) . run---- | Evaluation function-run :: Program -> Interpreter-run Halt     = return ()-run (Succ n) = memory.focus += 1   >> run n-run (Pred n) = memory.focus -= 1   >> run n-run (Next n) = memory %= wrapRight >> run n-run (Prev n) = memory %= wrapLeft  >> run n-run (Read n) = do-  memory.focus <~ uses input head-  input %= tail-  run n-run (Write n) = do-  x <- use (memory.focus)-  tell [x]-  run n-run (Branch z n) = do-  c <- use (memory.focus)-  run $ if c == 0 then z else n---- | Zipper helpers-wrapRight, wrapLeft :: (a :>> b) -> (a :>> b)-wrapRight = liftM2 fromMaybe leftmost rightward-wrapLeft  = liftM2 fromMaybe rightmost leftward---- Main program action to actually run this stuff--main :: IO ()-main = do-  as <- getArgs-  case as of-    -- STDIN is program-    [ ] -> do-      hSetBuffering stdin  NoBuffering-      hSetBuffering stdout NoBuffering-      getContents >>= eval noInput--    -- STDIN is input-    [f] -> join $ eval <$> getInput <*> readFile f--    -- Malformed command line-    _ -> putStrLn "Usage: brainfuck [program]"--eval :: Input -> String -> IO ()-eval i = mapM_ putByte . interpret i . compile . parse-  where putByte = BS.putStr . BS.pack . return---- | EOF is represented as 0-getInput :: IO Input-getInput = f <$> BS.getContents-  where f s = BS.unpack s ++ repeat 0--noInput :: Input-noInput = repeat 0
− examples/BrainfuckFinal.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE DeriveFunctor #-}--------------------------------------------------------------------------------- |--- Module      :  BrainfuckFinal--- Copyright   :  (C) 2012 Edward Kmett, nand`--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  TH, Rank2, NoMonomorphismRestriction------ A simple interpreter for the esoteric programming language "Brainfuck"--- written using lenses and zippers.------ This version of the interpreter is 'finally encoded' without going through--- an AST.-------------------------------------------------------------------------------module Main where--import Prelude hiding (Either(..))--import Control.Lens-import Control.Applicative-import Control.Monad.State-import Control.Monad.Writer--import qualified Data.ByteString.Lazy as BS-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Word (Word8)--import System.Environment (getArgs)-import System.IO---- | Brainfuck is defined to have a memory of 30000 cells.-memoryCellNum :: Int-memoryCellNum = 30000---- * State/Writer-based interpreter--type Cell   = Word8-type Input  = [Cell]-type Output = [Cell]-type Memory = Top :>> [Cell] :>> Cell -- list zipper--data MachineState = MachineState-  { _input  :: [Cell]-  , _memory :: Memory }--makeLenses ''MachineState--type Program = StateT MachineState (Writer Output) ()--compile :: String -> Program-compile = fst . bracket []--branch :: Program -> Program -> Program-branch z n = do-  c <- use (memory.focus)-  if c == 0 then z else n--bracket :: [Program] -> String -> (Program, [Program])-bracket [] ""      = (return () , [])-bracket _  ""      = error "Mismatched opening bracket"-bracket [] (']':_) = error "Mismatched closing bracket"---- Match a closing bracket: Pop a forward continuation, push backwards-bracket (c:cs) (']': xs) = (branch n c, n:bs) where-  (n, bs) = bracket cs xs---- Match an opening bracket: Pop a backwards continuation, push forwards-bracket cs ('[': xs) = (branch b n, bs) where-  (n, b:bs) = bracket (n:cs) xs---- Match any other symbol in the trivial way-bracket cs (x:xs) = over _1 (f x >>) (bracket cs xs) where-  f '+' = memory.focus += 1-  f '-' = memory.focus -= 1-  f '>' = memory %= wrapRight-  f '<' = memory %= wrapLeft-  f ',' = do-    memory.focus <~ uses input head-    input %= tail-  f '.' = do-    x <- use (memory.focus)-    tell [x]-  f _   = return ()---- | Initial memory configuration-initial :: Input -> MachineState-initial i = MachineState i (zipper (replicate memoryCellNum 0) & fromWithin traverse)--interpret :: Input -> Program -> Output-interpret i = execWriter . flip execStateT (initial i)---- | Zipper helpers-wrapRight, wrapLeft :: (a :>> b) -> (a :>> b)-wrapRight = liftM2 fromMaybe leftmost rightward-wrapLeft  = liftM2 fromMaybe rightmost leftward---- Main program action to actually run this stuff--main :: IO ()-main = do-  as <- getArgs-  case as of-    -- STDIN is program-    [ ] -> do-      hSetBuffering stdin  NoBuffering-      hSetBuffering stdout NoBuffering-      getContents >>= eval noInput--    -- STDIN is input-    [f] -> join $ eval <$> getInput <*> readFile f--    -- Malformed command line-    _ -> putStrLn "Usage: brainfuck [program]"--eval :: Input -> String -> IO ()-eval i = mapM_ putByte . interpret i . compile-  where putByte = BS.putStr . BS.pack . return---- | EOF is represented as 0-getInput :: IO Input-getInput = f <$> BS.getContents-  where f s = BS.unpack s ++ repeat 0--noInput :: Input-noInput = repeat 0
examples/Pong.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Main--- Copyright   :  (C) 2012 Edward Kmett, nand`+-- Copyright   :  (C) 2012 Edward Kmett, Niklas Haas -- License     :  BSD-style (see the file LICENSE) -- Maintainer  :  Edward Kmett <ekmett@gmail.com> -- Stability   :  provisional
− examples/bf-examples/99bottles.bf 
@@ -1,60 +0,0 @@-99 Bottles of Beer in Urban Mueller's BrainF*** (The actual
-name is impolite)
-
-by Ben Olmstead
-
-ANSI C interpreter available on the internet; due to
-constraints in comments the address below needs to have the
-stuff in parenthesis replaced with the appropriate symbol:
-
-http://www(dot)cats(dash)eye(dot)com/cet/soft/lang/bf/
-
-Believe it or not this language is indeed Turing complete!
-Combines the speed of BASIC with the ease of INTERCAL and
-the readability of an IOCCC entry!
-
->+++++++++[<+++++++++++>-]<[>[-]>[-]<<[>+>+<<-]>>[<<+>>-]>>>
-[-]<<<+++++++++<[>>>+<<[>+>[-]<<-]>[<+>-]>[<<++++++++++>>>+<
--]<<-<-]+++++++++>[<->-]>>+>[<[-]<<+>>>-]>[-]+<<[>+>-<<-]<<<
-[>>+>+<<<-]>>>[<<<+>>>-]>[<+>-]<<-[>[-]<[-]]>>+<[>[-]<-]<+++
-+++++[<++++++<++++++>>-]>>>[>+>+<<-]>>[<<+>>-]<[<<<<<.>>>>>-
-]<<<<<<.>>[-]>[-]++++[<++++++++>-]<.>++++[<++++++++>-]<++.>+
-++++[<+++++++++>-]<.><+++++..--------.-------.>>[>>+>+<<<-]>
->>[<<<+>>>-]<[<<<<++++++++++++++.>>>>-]<<<<[-]>++++[<+++++++
-+>-]<.>+++++++++[<+++++++++>-]<--.---------.>+++++++[<------
----->-]<.>++++++[<+++++++++++>-]<.+++..+++++++++++++.>++++++
-++[<---------->-]<--.>+++++++++[<+++++++++>-]<--.-.>++++++++
-[<---------->-]<++.>++++++++[<++++++++++>-]<++++.-----------
--.---.>+++++++[<---------->-]<+.>++++++++[<+++++++++++>-]<-.
->++[<----------->-]<.+++++++++++..>+++++++++[<---------->-]<
------.---.>>>[>+>+<<-]>>[<<+>>-]<[<<<<<.>>>>>-]<<<<<<.>>>+++
-+[<++++++>-]<--.>++++[<++++++++>-]<++.>+++++[<+++++++++>-]<.
-><+++++..--------.-------.>>[>>+>+<<<-]>>>[<<<+>>>-]<[<<<<++
-++++++++++++.>>>>-]<<<<[-]>++++[<++++++++>-]<.>+++++++++[<++
-+++++++>-]<--.---------.>+++++++[<---------->-]<.>++++++[<++
-+++++++++>-]<.+++..+++++++++++++.>++++++++++[<---------->-]<
--.---.>+++++++[<++++++++++>-]<++++.+++++++++++++.++++++++++.
-------.>+++++++[<---------->-]<+.>++++++++[<++++++++++>-]<-.
--.---------.>+++++++[<---------->-]<+.>+++++++[<++++++++++>-
-]<--.+++++++++++.++++++++.---------.>++++++++[<---------->-]
-<++.>+++++[<+++++++++++++>-]<.+++++++++++++.----------.>++++
-+++[<---------->-]<++.>++++++++[<++++++++++>-]<.>+++[<----->
--]<.>+++[<++++++>-]<..>+++++++++[<--------->-]<--.>+++++++[<
-++++++++++>-]<+++.+++++++++++.>++++++++[<----------->-]<++++
-.>+++++[<+++++++++++++>-]<.>+++[<++++++>-]<-.---.++++++.----
----.----------.>++++++++[<----------->-]<+.---.[-]<<<->[-]>[
--]<<[>+>+<<-]>>[<<+>>-]>>>[-]<<<+++++++++<[>>>+<<[>+>[-]<<-]
->[<+>-]>[<<++++++++++>>>+<-]<<-<-]+++++++++>[<->-]>>+>[<[-]<
-<+>>>-]>[-]+<<[>+>-<<-]<<<[>>+>+<<<-]>>>[<<<+>>>-]<>>[<+>-]<
-<-[>[-]<[-]]>>+<[>[-]<-]<++++++++[<++++++<++++++>>-]>>>[>+>+
-<<-]>>[<<+>>-]<[<<<<<.>>>>>-]<<<<<<.>>[-]>[-]++++[<++++++++>
--]<.>++++[<++++++++>-]<++.>+++++[<+++++++++>-]<.><+++++..---
------.-------.>>[>>+>+<<<-]>>>[<<<+>>>-]<[<<<<++++++++++++++
-.>>>>-]<<<<[-]>++++[<++++++++>-]<.>+++++++++[<+++++++++>-]<-
--.---------.>+++++++[<---------->-]<.>++++++[<+++++++++++>-]
-<.+++..+++++++++++++.>++++++++[<---------->-]<--.>+++++++++[
-<+++++++++>-]<--.-.>++++++++[<---------->-]<++.>++++++++[<++
-++++++++>-]<++++.------------.---.>+++++++[<---------->-]<+.
->++++++++[<+++++++++++>-]<-.>++[<----------->-]<.+++++++++++
-..>+++++++++[<---------->-]<-----.---.+++.---.[-]<<<]
-
− examples/bf-examples/brainfuck.bf 
@@ -1,6 +0,0 @@->>>+[[-]>>[-]++>+>+++++++[<++++>>++<-]++>>+>+>+++++[>++>++++++<<-]+>>>,<++[[>[-->>]<[>>]<<-]<[<]<+>>[>]>[<+>-[[<+>-]>]<[[[-]<]++<-[<+++++++++>[<->-]>>]>>]]<<-]<]<[[<]>[[>]>>[>>]+[<<]<[<]<+>>-]>[>]+[->>]<<<<[[<<]<[<]+<<[+>+<<-[>-->+<<-[>-+<[>>+<<-]]]>[<+>-]<]++>>-->[>]>>[>>]]<<[>>+<[[<]<]>[[<<]<[<]+[-<+>>-[<<+>++>--[<->[<<+>>-]]]<[>+<-]>]>[>]>]>[>>]>>]<<[>>+>>+>>]<<[->>>>>>>>]<<[>.>>>>>>>]<<[->->>>>>]<<[>,>>>]<<[>+>]<<[+<<]<]
− examples/bf-examples/cat.bf 
@@ -1,1 +0,0 @@-,[.,]
− examples/bf-examples/helloworld.bf 
@@ -1,23 +0,0 @@-Source: Wikipedia--+++++ +++++             initialize counter (cell #0) to 10-[                       use loop to set the next four cells to 70/100/30/10-    > +++++ ++              add  7 to cell #1-    > +++++ +++++           add 10 to cell #2-    > +++                   add  3 to cell #3-    > +                     add  1 to cell #4-    <<<< -                  decrement counter (cell #0)-]-> ++ .                  print 'H'-> + .                   print 'e'-+++++ ++ .              print 'l'-.                       print 'l'-+++ .                   print 'o'-> ++ .                  print ' '-<< +++++ +++++ +++++ .  print 'W'-> .                     print 'o'-+++ .                   print 'r'------ - .               print 'l'------ --- .             print 'd'-> + .                   print '!'-> .                     print '\n'
− examples/bf-examples/rot13.bf 
@@ -1,23 +0,0 @@-,-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>++++++++++++++<--[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>>+++++[<----->-]<<--[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>++++++++++++++<--[>+<-[>+<-[>+<-[>+<-[>+<--[>++++++++++++++<--[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>>+++++[<----->-]<<--[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-[>+<--[>++++++++++++++<--[>+<-]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]-]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]>.[-]<,]--of course any function char f(char) can be made easily on the same principle--[Daniel B Cristofani (cristofdathevanetdotcom)-http://www.hevanet.com/cristofd/brainfuck/]
− examples/bf-examples/triangle.bf 
@@ -1,33 +0,0 @@-[ This program prints Sierpinski triangle on 80-column display. ]-                                >-                               + +-                              +   +-                             [ < + +-                            +       +-                           + +     + +-                          >   -   ]   >-                         + + + + + + + +-                        [               >-                       + +             + +-                      <   -           ]   >-                     > + + >         > > + >-                    >       >       +       <-                   < <     < <     < <     < <-                  <   [   -   [   -   >   +   <-                 ] > [ - < + > > > . < < ] > > >-                [                               [-               - >                             + +-              +   +                           +   +-             + + [ >                         + + + +-            <       -                       ]       >-           . <     < [                     - >     + <-          ]   +   >   [                   -   >   +   +-         + + + + + + + +                 < < + > ] > . [-        -               ]               >               ]-       ] +             < <             < [             - [-      -   >           +   <           ]   +           >   [-     - < + >         > > - [         - > + <         ] + + >-    [       -       <       -       >       ]       <       <-   < ]     < <     < <     ] +     + +     + +     + +     + +-  +   .   +   +   +   .   [   -   ]   <   ]   +   +   +   +   +- * * * * * M a d e * B y : * N Y Y R I K K I * 2 0 0 2 * * * * *
examples/lens-examples.cabal view
@@ -4,7 +4,7 @@ license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE-author:        nand+author:        Niklas Haas maintainer:    Edward A. Kmett <ekmett@gmail.com> stability:     provisional homepage:      http://github.com/ekmett/lens/@@ -23,9 +23,6 @@ flag pong   default: True -flag brainfuck-  default: True- executable lens-pong   if !flag(pong)     buildable: False@@ -38,29 +35,3 @@     mtl        >= 2.0.1 && < 2.2,     random     == 1.0.*   main-is: Pong.hs--executable lens-brainfuck-  if !flag(brainfuck)-    buildable: False--  build-depends:-    base,-    lens,-    free       >= 3.0,-    bytestring,-    mtl        >= 2.0.1 && < 2.2,-    streams    >= 3.0-  main-is: Brainfuck.hs--executable lens-brainfuck-final-  if !flag(brainfuck)-    buildable: False--  build-depends:-    base,-    lens,-    free       >= 3.0,-    bytestring,-    mtl        >= 2.0.1 && < 2.2,-    streams    >= 3.0-  main-is: BrainfuckFinal.hs
lens-properties/src/Control/Lens/Properties.hs view
@@ -44,8 +44,8 @@                   .&. do as <- arbitrary                          bs <- arbitrary                          t <- arbitrary-                         property $ traverse_compose l (\x -> as++[x]++bs)-                                                       (\x -> if t then Just x else Nothing)+                         return $ traverse_compose l (\x -> as++[x]++bs)+                                                     (\x -> if t then Just x else Nothing)   --------------------------------------------------------------------------------
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.1.2.1+version:       4.2 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -12,7 +12,7 @@ copyright:     Copyright (C) 2012-2014 Edward A. Kmett build-type:    Custom -- build-tools:   cpphs-tested-with:   GHC == 7.6.3+tested-with:   GHC == 7.4.1, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2 synopsis:      Lenses, Folds and Traversals description:   This package comes \"Batteries Included\" with many useful lenses for the types@@ -96,7 +96,6 @@   examples/lens-examples.cabal   examples/*.hs   examples/*.lhs-  examples/bf-examples/*.bf   images/*.png   lens-properties/CHANGELOG.markdown   lens-properties/LICENSE@@ -183,6 +182,7 @@ library   build-depends:     aeson                     >= 0.7      && < 0.8,+    attoparsec                >= 0.10     && < 0.13,     array                     >= 0.3.0.2  && < 0.6,     base                      >= 4.3      && < 5,     bifunctors                >= 4        && < 5,@@ -196,22 +196,21 @@     ghc-prim,     hashable                  >= 1.1.2.3  && < 1.3,     exceptions                >= 0.1.1    && < 1,-    mtl                       >= 2.0.1    && < 2.2,+    mtl                       >= 2.0.1    && < 2.3,     parallel                  >= 3.1.0.1  && < 3.3,     primitive                 >= 0.4.0.1  && < 0.6,     profunctors               >= 4        && < 5,     reflection                >= 1.1.6    && < 2,-    scientific                >= 0.2      && < 0.4,+    scientific                >= 0.3.2    && < 0.4,     semigroupoids             >= 4        && < 5,     semigroups                >= 0.8.4    && < 1,     split                     >= 0.2      && < 0.3,     tagged                    >= 0.4.4    && < 1,     template-haskell          >= 2.4      && < 2.11,     text                      >= 0.11     && < 1.2,-    transformers              >= 0.2      && < 0.4,+    transformers              >= 0.2      && < 0.5,     transformers-compat       >= 0.1      && < 1,     unordered-containers      >= 0.2      && < 0.3,-    utf8-string               >= 0.3.7    && < 0.4,     vector                    >= 0.9      && < 0.11,     void                      >= 0.5      && < 1,     zlib                      >= 0.5.4    && < 0.6
src/Control/Lens/Action.hs view
@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Action@@ -94,6 +98,11 @@ -- -- >>> ["ab","cd","ef"]^!!folded.acts -- ["ace","acf","ade","adf","bce","bcf","bde","bdf"]+--+-- [1,2]^!!folded.act (\i -> putStr (show i ++ ": ") >> getLine).each.to succ+-- 1: aa+-- 2: bb+-- "bbcc" (^!!) :: Monad m => s -> Acting m [a] s a -> m [a] a ^!! l = getEffect (l (Effect #. return . return) a) {-# INLINE (^!!) #-}@@ -133,6 +142,10 @@ -- -- >>> (1,"hello")^!_2.acts.to succ -- "ifmmp"+--+-- (1,getLine)^!!_2.acts.folded.to succ+-- aa+-- "bb" acts :: IndexPreservingAction m (m a) a acts = act id {-# INLINE acts #-}
src/Control/Lens/Each.hs view
@@ -7,6 +7,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FunctionalDependencies #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif  #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1
src/Control/Lens/Empty.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE DefaultSignatures #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif  ------------------------------------------------------------------------------- -- |
src/Control/Lens/Indexed.hs view
@@ -33,6 +33,7 @@   , Conjoined(..)   , Indexed(..)   , (<.), (<.>), (.>)+  , selfIndex   , reindexed   , icompose   , indexing@@ -77,6 +78,7 @@ import Control.Applicative.Backwards import Control.Monad (void, liftM) import Control.Monad.Trans.State.Lazy as Lazy+import Control.Monad.Free import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Internal.Fold@@ -110,6 +112,10 @@ -- | Compose an 'Indexed' function with a non-indexed function. -- -- Mnemonically, the @<@ points to the indexing we want to preserve.+--+-- >>> let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])]+-- >>> nestedMap^..(itraversed<.itraversed).withIndex+-- [(1,"one,ten"),(1,"one,twenty"),(2,"two,thirty"),(2,"two,forty")] (<.) :: Indexable i p => (Indexed i s t -> r) -> ((a -> b) -> s -> t) -> p a b -> r (<.) f g h = f . Indexed $ g . indexed h {-# INLINE (<.) #-}@@ -122,10 +128,26 @@ -- -- @f '.' g@ (and @f '.>' g@) gives you the index of @g@ unless @g@ is index-preserving, like a -- 'Prism', 'Iso' or 'Equality', in which case it'll pass through the index of @f@.+--+-- >>> let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])]+-- >>> nestedMap^..(itraversed.>itraversed).withIndex+-- [(10,"one,ten"),(20,"one,twenty"),(30,"two,thirty"),(40,"two,forty")] (.>) :: (st -> r) -> (kab -> st) -> kab -> r (.>) = (.) {-# INLINE (.>) #-} +-- | Use a value itself as its own index. This is essentially an indexed version of 'id'.+--+-- Note: When used to modify the value, this can break the index requirements assumed by 'indices' and similar,+-- so this is only properly an 'IndexedGetter', but it can be used as more.+--+-- @+-- 'selfIndex' :: 'IndexedGetter' a a b+-- @+selfIndex :: Indexable a p => p a fb -> a -> fb+selfIndex f a = indexed f a a+{-# INLINE selfIndex #-}+ -- | Remap the index. reindexed :: Indexable j p => (i -> j) -> (Indexed i a b -> r) -> p a b -> r reindexed ij f g = f . Indexed $ indexed g . ij@@ -134,6 +156,10 @@ -- | Composition of 'Indexed' functions. -- -- Mnemonically, the @\<@ and @\>@ points to the fact that we want to preserve the indices.+--+-- >>> let nestedMap = (fmap Map.fromList . Map.fromList) [(1, [(10, "one,ten"), (20, "one,twenty")]), (2, [(30, "two,thirty"), (40,"two,forty")])]+-- >>> nestedMap^..(itraversed<.>itraversed).withIndex+-- [((1,10),"one,ten"),((1,20),"one,twenty"),((2,30),"two,thirty"),((2,40),"two,forty")] (<.>) :: Indexable (i, j) p => (Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> p a b -> r f <.> g = icompose (,) f g {-# INLINE (<.>) #-}@@ -236,6 +262,11 @@ #endif    -- | The 'IndexedFold' of a 'FoldableWithIndex' container.+  --+  -- 'ifolded'.'asIndex' is a fold over the keys of a 'FoldableWithIndex'.+  --+  -- >>> Data.Map.fromList [(2, "hello"), (1, "world")]^..ifolded.asIndex+  -- [1,2]   ifolded :: IndexedFold i (f a) a   ifolded = conjoined folded $ \f -> coerce . getFolding . ifoldMap (\i -> Folding #. indexed f i)   {-# INLINE ifolded #-}@@ -436,7 +467,7 @@ -- When you don't need access to the indices in the result, then 'Data.Foldable.toList' is more flexible in what it accepts. -- -- @--- 'Data.Foldable.toList' ≡ 'Data.List.map' 'fst' '.' 'itoList'+-- 'Data.Foldable.toList' ≡ 'Data.List.map' 'snd' '.' 'itoList' -- @ itoList :: FoldableWithIndex i f => f a -> [(i,a)] itoList = ifoldr (\i c -> ((i,c):)) []@@ -456,6 +487,10 @@ -- @ class (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i t | t -> i where   -- | Traverse an indexed container.+  --+  -- @+  -- 'itraverse' ≡ 'itraverseOf' 'itraversed'+  -- @   itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) #ifndef HLINT   default itraverse :: Applicative f => (Int -> a -> f b) -> t a -> f (t b)@@ -693,6 +728,21 @@   itraverse _ (MagmaPure x)    = pure (MagmaPure x)   itraverse f (MagmaFmap xy x) = MagmaFmap xy <$> itraverse f x   itraverse f (Magma i a)      = Magma i <$> f i a+  {-# INLINE itraverse #-}++instance FunctorWithIndex i f => FunctorWithIndex [i] (Free f) where+  imap f (Pure a) = Pure $ f [] a+  imap f (Free s) = Free $ imap (\i -> imap (f . (:) i)) s+  {-# INLINE imap #-}++instance FoldableWithIndex i f => FoldableWithIndex [i] (Free f) where+  ifoldMap f (Pure a) = f [] a+  ifoldMap f (Free s) = ifoldMap (\i -> ifoldMap (f . (:) i)) s+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex i f => TraversableWithIndex [i] (Free f) where+  itraverse f (Pure a) = Pure <$> f [] a+  itraverse f (Free s) = Free <$> itraverse (\i -> itraverse (f . (:) i)) s   {-# INLINE itraverse #-}  -------------------------------------------------------------------------------
src/Control/Lens/Internal/ByteString.hs view
@@ -3,6 +3,9 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleContexts #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif
src/Control/Lens/Internal/Reflection.hs view
@@ -64,7 +64,9 @@ import Data.Typeable import Data.Reflection +#ifdef HLINT {-# ANN module "HLint: ignore Avoid lambda" #-}+#endif  class Typeable s => B s where   reflectByte :: proxy s -> IntPtr
src/Control/Lens/Internal/Zoom.hs view
@@ -6,7 +6,7 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal.Zoom@@ -44,6 +44,7 @@ import Control.Monad.Trans.RWS.Lazy as Lazy import Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.Trans.List import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe@@ -69,6 +70,7 @@ type instance Zoomed (ListT m) = FocusingOn [] (Zoomed m) type instance Zoomed (MaybeT m) = FocusingMay (Zoomed m) type instance Zoomed (ErrorT e m) = FocusingErr e (Zoomed m)+type instance Zoomed (ExceptT e m) = FocusingErr e (Zoomed m)  ------------------------------------------------------------------------------ -- Focusing
src/Control/Lens/Iso.hs view
@@ -255,6 +255,14 @@ -- -- >>> fromList [("hello",fromList [("world","!!!")])] & at "hello" . non Map.empty . at "world" .~ Nothing -- fromList []+--+-- It can also be used in reverse to exclude a given value:+--+-- >>> non 0 # rem 10 4+-- Just 2+--+-- >>> non 0 # rem 10 5+-- Nothing non :: Eq a => a -> Iso' (Maybe a) a non = non' . only {-# INLINE non #-}
src/Control/Lens/Lens.hs view
@@ -628,7 +628,7 @@  -- | Modify the target of a 'Lens', but return the old value. ----- When you do not need the result of the addition, ('Control.Lens.Setter.%~') is more flexible.+-- When you do not need the old value, ('Control.Lens.Setter.%~') is more flexible. -- -- @ -- ('<<%~') ::             'Lens' s t a b      -> (a -> b) -> s -> (a, t)@@ -639,9 +639,9 @@ (<<%~) l = l . lmap (\a -> (a, a)) . second' {-# INLINE (<<%~) #-} --- | Modify the target of a 'Lens', but return the old value.+-- | Replace the target of a 'Lens', but return the old value. ----- When you do not need the old value, ('Control.Lens.Setter.%~') is more flexible.+-- When you do not need the old value, ('Control.Lens.Setter..~') is more flexible. -- -- @ -- ('<<.~') ::             'Lens' s t a b      -> b -> s -> (a, t)@@ -652,42 +652,170 @@ l <<.~ b = l $ \a -> (a, b) {-# INLINE (<<.~) #-} +-- | Increment the target of a numerically valued 'Lens' and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.+~') is more flexible.+--+-- >>> (a,b) & _1 <<+~ c+-- (a,(a + c,b))+--+-- >>> (a,b) & _2 <<+~ c+-- (b,(a,b + c))+--+-- @+-- ('<<+~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s)+-- ('<<+~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s)+-- @ (<<+~) :: Num a => Optical' (->) q ((,) a) s a -> a -> q s (a, s) l <<+~ b = l $ \a -> (a, a + b) {-# INLINE (<<+~) #-} +-- | Decrement the target of a numerically valued 'Lens' and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.-~') is more flexible.+--+-- >>> (a,b) & _1 <<-~ c+-- (a,(a - c,b))+--+-- >>> (a,b) & _2 <<-~ c+-- (b,(a,b - c))+--+-- @+-- ('<<-~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s)+-- ('<<-~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s)+-- @ (<<-~) :: Num a => Optical' (->) q ((,) a) s a -> a -> q s (a, s) l <<-~ b = l $ \a -> (a, a - b) {-# INLINE (<<-~) #-} +-- | Multiply the target of a numerically valued 'Lens' and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.-~') is more flexible.+--+-- >>> (a,b) & _1 <<*~ c+-- (a,(a * c,b))+--+-- >>> (a,b) & _2 <<*~ c+-- (b,(a,b * c))+--+-- @+-- ('<<*~') :: 'Num' a => 'Lens'' s a -> a -> s -> (a, s)+-- ('<<*~') :: 'Num' a => 'Iso'' s a -> a -> s -> (a, s)+-- @ (<<*~) :: Num a => Optical' (->) q ((,) a) s a -> a -> q s (a, s) l <<*~ b = l $ \a -> (a, a * b) {-# INLINE (<<*~) #-} +-- | Divide the target of a numerically valued 'Lens' and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.//~') is more flexible.+--+-- >>> (a,b) & _1 <<//~ c+-- (a,(a / c,b))+--+-- >>> ("Hawaii",10) & _2 <<//~ 2+-- (10.0,("Hawaii",5.0))+--+-- @+-- ('<<//~') :: Fractional a => 'Lens'' s a -> a -> s -> (a, s)+-- ('<<//~') :: Fractional a => 'Iso'' s a -> a -> s -> (a, s)+-- @ (<<//~) :: Fractional a => Optical' (->) q ((,) a) s a -> a -> q s (a, s) l <<//~ b = l $ \a -> (a, a / b) {-# INLINE (<<//~) #-} +-- | Raise the target of a numerically valued 'Lens' to a non-negative power and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.^~') is more flexible.+--+-- @+-- ('<<^~') :: ('Num' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s)+-- ('<<^~') :: ('Num' a, 'Integral' e) => 'Iso'' s a -> e -> s -> (a, s)+-- @ (<<^~) :: (Num a, Integral e) => Optical' (->) q ((,) a) s a -> e -> q s (a, s) l <<^~ e = l $ \a -> (a, a ^ e) {-# INLINE (<<^~) #-} +-- | Raise the target of a fractionally valued 'Lens' to an integral power and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.^^~') is more flexible.+--+-- @+-- ('<<^^~') :: ('Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> s -> (a, s)+-- ('<<^^~') :: ('Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> S -> (a, s)+-- @ (<<^^~) :: (Fractional a, Integral e) => Optical' (->) q ((,) a) s a -> e -> q s (a, s) l <<^^~ e = l $ \a -> (a, a ^^ e) {-# INLINE (<<^^~) #-} +-- | Raise the target of a floating-point valued 'Lens' to an arbitrary power and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.**~') is more flexible.+--+-- >>> (a,b) & _1 <<**~ c+-- (a,(a**c,b))+--+-- >>> (a,b) & _2 <<**~ c+-- (b,(a,b**c))+--+-- @+-- ('<<**~') :: 'Floating' a => 'Lens'' s a -> a -> s -> (a, s)+-- ('<<**~') :: 'Floating' a => 'Iso'' s a -> a -> s -> (a, s)+-- @ (<<**~) :: Floating a => Optical' (->) q ((,) a) s a -> a -> q s (a, s) l <<**~ e = l $ \a -> (a, a ** e) {-# INLINE (<<**~) #-} +-- | Logically '||' the target of a 'Bool'-valued 'Lens' and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.||~') is more flexible.+--+-- >>> (False,6) & _1 <<||~ True+-- (False,(True,6))+--+-- >>> ("hello",True) & _2 <<||~ False+-- (True,("hello",True))+--+-- @+-- ('<<||~') :: 'Lens'' s 'Bool' -> 'Bool' -> s -> ('Bool', s)+-- ('<<||~') :: 'Iso'' s 'Bool' -> 'Bool' -> s -> ('Bool', s)+-- @ (<<||~) :: Optical' (->) q ((,) Bool) s Bool -> Bool -> q s (Bool, s) l <<||~ b = l $ \a -> (a, b || a) {-# INLINE (<<||~) #-} +-- | Logically '&&' the target of a 'Bool'-valued 'Lens' and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.&&~') is more flexible.+--+-- >>> (False,6) & _1 <<&&~ True+-- (False,(False,6))+--+-- >>> ("hello",True) & _2 <<&&~ False+-- (True,("hello",False))+--+-- @+-- ('<<&&~') :: 'Lens'' s Bool -> Bool -> s -> (Bool, s)+-- ('<<&&~') :: 'Iso'' s Bool -> Bool -> s -> (Bool, s)+-- @ (<<&&~) :: Optical' (->) q ((,) Bool) s Bool -> Bool -> q s (Bool, s) l <<&&~ b = l $ \a -> (a, b && a) {-# INLINE (<<&&~) #-} +-- | Modify the target of a monoidally valued 'Lens' by 'mappend'ing a new value and return the old value.+--+-- When you do not need the old value, ('Control.Lens.Setter.<>~') is more flexible.+--+-- >>> (Sum a,b) & _1 <<<>~ Sum c+-- (Sum {getSum = a},(Sum {getSum = a + c},b))+--+-- >>> _2 <<<>~ ", 007" $ ("James", "Bond")+-- ("Bond",("James","Bond, 007"))+--+-- @+-- ('<<<>~') :: 'Monoid' r => 'Lens'' s r -> r -> s -> (r, s)+-- ('<<<>~') :: 'Monoid' r => 'Iso'' s r -> r -> s -> (r, s)+-- @ (<<<>~) :: Monoid r => Optical' (->) q ((,) r) s r -> r -> q s (r, s) l <<<>~ b = l $ \a -> (a, a `mappend` b) {-# INLINE (<<<>~) #-}@@ -853,8 +981,8 @@ l <<%= f = l %%= lmap (\a -> (a,a)) (second' f) {-# INLINE (<<%=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by a user supplied--- function and return the /old/ value that was replaced.+-- | Replace the target of a 'Lens' into your 'Monad'\'s state with a user supplied+-- value and return the /old/ value that was replaced. -- -- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the old values -- present.@@ -870,42 +998,132 @@ l <<.= b = l %%= \a -> (a,b) {-# INLINE (<<.=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by adding a value+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.+=') is more flexible.+--+-- @+-- ('<<+=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a+-- ('<<+=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a+-- @ (<<+=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a l <<+= n = l %%= \a -> (a, a + n) {-# INLINE (<<+=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by subtracting a value+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.-=') is more flexible.+--+-- @+-- ('<<-=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a+-- ('<<-=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a+-- @ (<<-=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a l <<-= n = l %%= \a -> (a, a - n) {-# INLINE (<<-=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by multipling a value+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.*=') is more flexible.+--+-- @+-- ('<<*=') :: ('MonadState' s m, 'Num' a) => 'Lens'' s a -> a -> m a+-- ('<<*=') :: ('MonadState' s m, 'Num' a) => 'Iso'' s a -> a -> m a+-- @ (<<*=) :: (MonadState s m, Num a) => LensLike' ((,) a) s a -> a -> m a l <<*= n = l %%= \a -> (a, a * n) {-# INLINE (<<*=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\s state by dividing by a value+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.//=') is more flexible.+--+-- @+-- ('<<//=') :: ('MonadState' s m, 'Fractional' a) => 'Lens'' s a -> a -> m a+-- ('<<//=') :: ('MonadState' s m, 'Fractional' a) => 'Iso'' s a -> a -> m a+-- @ (<<//=) :: (MonadState s m, Fractional a) => LensLike' ((,) a) s a -> a -> m a l <<//= n = l %%= \a -> (a, a / n) {-# INLINE (<<//=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by raising it by a non-negative power+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.^=') is more flexible.+--+-- @+-- ('<<^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Lens'' s a -> e -> m a+-- ('<<^=') :: ('MonadState' s m, 'Num' a, 'Integral' e) => 'Iso'' s a -> a -> m a+-- @ (<<^=) :: (MonadState s m, Num a, Integral e) => LensLike' ((,) a) s a -> e -> m a l <<^= n = l %%= \a -> (a, a ^ n) {-# INLINE (<<^=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by raising it by an integral power+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.^^=') is more flexible.+--+-- @+-- ('<<^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Lens'' s a -> e -> m a+-- ('<<^^=') :: ('MonadState' s m, 'Fractional' a, 'Integral' e) => 'Iso'' s a -> e -> m a+-- @ (<<^^=) :: (MonadState s m, Fractional a, Integral e) => LensLike' ((,) a) s a -> e -> m a l <<^^= n = l %%= \a -> (a, a ^^ n) {-# INLINE (<<^^=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by raising it by an arbitrary power+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.**=') is more flexible.+--+-- @+-- ('<<**=') :: ('MonadState' s m, 'Floating' a) => 'Lens'' s a -> a -> m a+-- ('<<**=') :: ('MonadState' s m, 'Floating' a) => 'Iso'' s a -> a -> m a+-- @ (<<**=) :: (MonadState s m, Floating a) => LensLike' ((,) a) s a -> a -> m a l <<**= n = l %%= \a -> (a, a ** n) {-# INLINE (<<**=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by taking its logical '||' with a value+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.||=') is more flexible.+--+-- @+-- ('<<||=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m 'Bool'+-- ('<<||=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m 'Bool'+-- @ (<<||=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool l <<||= b = l %%= \a -> (a, a || b) {-# INLINE (<<||=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by taking its logical '&&' with a value+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.&&=') is more flexible.+--+-- @+-- ('<<&&=') :: 'MonadState' s m => 'Lens'' s 'Bool' -> 'Bool' -> m 'Bool'+-- ('<<&&=') :: 'MonadState' s m => 'Iso'' s 'Bool' -> 'Bool' -> m 'Bool'+-- @ (<<&&=) :: MonadState s m => LensLike' ((,) Bool) s Bool -> Bool -> m Bool l <<&&= b = l %%= \a -> (a, a && b) {-# INLINE (<<&&=) #-} +-- | Modify the target of a 'Lens' into your 'Monad'\'s state by 'mappend'ing a value+-- and return the /old/ value that was replaced.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.<>=') is more flexible.+--+-- @+-- ('<<<>=') :: ('MonadState' s m, 'Monoid' r) => 'Lens'' s r -> r -> m r+-- ('<<<>=') :: ('MonadState' s m, 'Monoid' r) => 'Iso'' s r -> r -> m r+-- @ (<<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,) r) s r -> r -> m r l <<<>= b = l %%= \a -> (a, a `mappend` b) {-# INLINE (<<<>=) #-}
src/Control/Lens/Level.hs view
@@ -1,5 +1,9 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Level
src/Control/Lens/Plated.hs view
@@ -72,7 +72,7 @@   , contexts, contextsOf, contextsOn, contextsOnOf   , holes, holesOn, holesOnOf   , para, paraOf-  , (...)+  , (...), deep    -- * Compos   -- $compos@@ -265,6 +265,19 @@ (...) :: (Applicative f, Plated c) => LensLike f s t c c -> Over p f c c a b -> Over p f s t a b l ... m = l . plate . m {-# INLINE (...) #-}+++-- | Try to apply a traversal to all transitive descendants of a 'Plated' container, but+-- do not recurse through matching descendants.+--+-- @+-- 'deep' :: 'Plated' s => 'Fold' s a                 -> 'Fold' s a+-- 'deep' :: 'Plated' s => 'IndexedFold' s a          -> 'IndexedFold' s a+-- 'deep' :: 'Plated' s => 'Traversal' s s a b        -> 'Traversal' s s a b+-- 'deep' :: 'Plated' s => 'IndexedTraversal' s s a b -> 'IndexedTraversal' s s a b+-- @+deep :: (Conjoined p, Applicative f, Plated s) => Traversing p f s s a b -> Over p f s s a b+deep = deepOf plate  ------------------------------------------------------------------------------- -- Children
src/Control/Lens/Reified.hs view
@@ -18,10 +18,11 @@ import Control.Arrow import qualified Control.Category as Cat import Control.Comonad+import Control.Lens.Action import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Internal.Indexed-import Control.Lens.Traversal (ignored)+import Control.Lens.Traversal (ignored,beside) import Control.Lens.Type import Control.Monad import Control.Monad.Reader.Class@@ -456,6 +457,100 @@   second' l = IndexedFold $ \f (c,s) ->     coerce $ runIndexedFold l (dimap ((,) c) coerce f) s   {-# INLINE second' #-}++------------------------------------------------------------------------------+-- MonadicFold+------------------------------------------------------------------------------++-- | Reify a 'MonadicFold' so it can be stored safely in a container.+--+newtype ReifiedMonadicFold m s a = MonadicFold { runMonadicFold :: MonadicFold m s a }++instance Profunctor (ReifiedMonadicFold m) where+  dimap f g l = MonadicFold (to f . runMonadicFold l . to g)+  {-# INLINE dimap #-}+  rmap g l = MonadicFold (runMonadicFold l . to g)+  {-# INLINE rmap #-}+  lmap f l = MonadicFold (to f . runMonadicFold l)+  {-# INLINE lmap #-}++instance Strong (ReifiedMonadicFold m) where+  first' l = MonadicFold $ \f (s,c) ->+    coerce $ runMonadicFold l (dimap (flip (,) c) coerce f) s+  {-# INLINE first' #-}+  second' l = MonadicFold $ \f (c,s) ->+    coerce $ runMonadicFold l (dimap ((,) c) coerce f) s+  {-# INLINE second' #-}++instance Choice (ReifiedMonadicFold m) where+  left' (MonadicFold l) = MonadicFold $+    to tuplify.beside (folded.l.to Left) (folded.to Right)+    where+      tuplify (Left lval) = (Just lval,Nothing)+      tuplify (Right rval) = (Nothing,Just rval)+  {-# INLINE left' #-}++instance Cat.Category (ReifiedMonadicFold m) where+  id = MonadicFold id+  l . r = MonadicFold (runMonadicFold r . runMonadicFold l)+  {-# INLINE (.) #-}++instance Arrow (ReifiedMonadicFold m) where+  arr f = MonadicFold (to f)+  {-# INLINE arr #-}+  first = first'+  {-# INLINE first #-}+  second = second'+  {-# INLINE second #-}++instance ArrowChoice (ReifiedMonadicFold m) where+  left = left'+  {-# INLINE left #-}+  right = right'+  {-# INLINE right #-}++instance ArrowApply (ReifiedMonadicFold m) where+  app = MonadicFold $ \cHandler (argFold,b) ->+     runMonadicFold (pure b >>> argFold) cHandler (argFold,b)+  {-# INLINE app #-}++instance Functor (ReifiedMonadicFold m s) where+  fmap f l = MonadicFold (runMonadicFold l.to f)+  {-# INLINE fmap #-}++instance Apply (ReifiedMonadicFold m s) where+  mf <.> ma = mf &&& ma >>> (MonadicFold $ to (uncurry ($)))+  {-# INLINE (<.>) #-}++instance Applicative (ReifiedMonadicFold m s) where+  pure a = MonadicFold $ folding $ \_ -> [a]+  {-# INLINE pure #-}+  mf <*> ma = mf <.> ma+  {-# INLINE (<*>) #-}++instance Alternative (ReifiedMonadicFold m s) where+  empty = MonadicFold ignored+  {-# INLINE empty #-}+  MonadicFold ma <|> MonadicFold mb = MonadicFold $ to (\x->(x,x)).beside ma mb+  {-# INLINE (<|>) #-}++instance Semigroup (ReifiedMonadicFold m s a) where+  (<>) = (<|>)+  {-# INLINE (<>) #-}++instance Monoid (ReifiedMonadicFold m s a) where+  mempty = MonadicFold ignored+  {-# INLINE mempty #-}+  mappend = (<|>)+  {-# INLINE mappend #-}++instance Alt (ReifiedMonadicFold m s) where+  (<!>) = (<|>)+  {-# INLINE (<!>) #-}++instance Plus (ReifiedMonadicFold m s) where+  zero = MonadicFold ignored+  {-# INLINE zero #-}  ------------------------------------------------------------------------------ -- Setter
src/Control/Lens/TH.hs view
@@ -305,10 +305,10 @@ -- -- @ -- x :: 'Lens'' FooBar 'Int'--- x f (Foo a b) = (\a\' -> Foo a\' b) \<$\> f a+-- x f (Foo a b) = (\\a\' -> Foo a\' b) \<$\> f a -- x f (Bar a)   = Bar \<$\> f a -- y :: 'Traversal'' FooBar 'Int'--- y f (Foo a b) = (\b\' -> Foo a  b\') \<$\> f b+-- y f (Foo a b) = (\\b\' -> Foo a  b\') \<$\> f b -- y _ c\@(Bar _) = pure c -- @ --@@ -332,9 +332,13 @@ -- -- @ -- class HasFoo t where---   foo :: 'Control.Lens.Type.Simple' 'Lens' t Foo--- instance HasFoo Foo where foo = 'id'--- fooX, fooY :: HasFoo t => 'Control.Lens.Type.Simple' 'Lens' t 'Int'+--   foo :: 'Lens'' t Foo+--   fooX :: 'Lens'' t 'Int'+--   fooX = foo . go where go f (Foo x y) = (\\x\' -> Foo x' y) \<$\> f x+--   fooY :: 'Lens'' t 'Int'+--   fooY = foo . go where go f (Foo x y) = (\\y\' -> Foo x y') \<$\> f y+-- instance HasFoo Foo where+--   foo = id -- @ -- -- @@@ -506,7 +510,7 @@ -- -- @ -- declareIso [d|---   newtype WrappedInt = Wrap { unrwap :: 'Int' }+--   newtype WrappedInt = Wrap { unwrap :: 'Int' } --   newtype 'List' a = 'List' [a] --   |] -- @
src/Control/Lens/Traversal.hs view
@@ -88,6 +88,7 @@   , taking   , dropping   , failing+  , deepOf    -- * Indexed Traversals @@ -241,6 +242,7 @@ -- @ -- 'traverseOf' ≡ 'id' -- 'itraverseOf' l ≡ 'traverseOf' l '.' 'Indexed'+-- 'itraverseOf' 'itraversed' ≡ 'itraverse' -- @ -- --@@ -1198,3 +1200,19 @@   xs -> unsafeOuts b <$> traverse (corep pafb) xs   where b = l sell s infixl 5 `failing`++-- | Try the second traversal. If it returns no entries, try again with for all entries from the first traversal, recursively.+--+-- @+-- 'deepOf' :: 'Fold' s s          -> 'Fold' s a                   -> 'Fold' s a+-- 'deepOf' :: 'Traversal'' s s    -> 'Traversal'' s a             -> 'Traversal'' s a+-- 'deepOf' :: 'Traversal' s t s t -> 'Traversal' s t a b          -> 'Traversal' s t a b+-- 'deepOf' :: 'Fold' s s          -> 'IndexedFold' i s a          -> 'IndexedFold' i s a+-- 'deepOf' :: 'Traversal' s t s t -> 'IndexedTraversal' i s t a b -> 'IndexedTraversal' i s t a b+-- @+deepOf :: (Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b+deepOf r l pafb = go+  where go s = case pins b of+          [] -> r go s+          xs -> unsafeOuts b <$> traverse (corep pafb) xs+          where b = l sell s
src/Control/Lens/Tuple.hs view
@@ -89,6 +89,9 @@ instance Field1 (Identity a) (Identity b) a b where   _1 f (Identity a) = Identity <$> f a +instance Field1 ((f :*: g) p) ((f' :*: g) p) (f p) (f' p) where+  _1 f (l :*: r) = (:*: r) <$> f l+ -- | @ -- '_1' k ~(a,b) = (\\a' -> (a',b)) 'Data.Functor.<$>' k a -- @@@ -150,6 +153,9 @@   _2 = ix proxyN1   {-# INLINE _2 #-} #endif++instance Field2 ((f :*: g) p) ((f :*: g') p) (g p) (g' p) where+  _2 f (l :*: r) = (l :*:) <$> f r  -- | @ -- '_2' k ~(a,b) = (\\b' -> (a,b')) 'Data.Functor.<$>' k b
src/Control/Lens/Type.hs view
@@ -213,6 +213,10 @@ -- directly as a 'Control.Lens.Traversal.Traversal'. -- -- The 'Control.Lens.Traversal.Traversal' laws are still required to hold.+--+-- In addition, the index @i@ should satisfy the requirement that it stays+-- unchanged even when modifying the value @a@, otherwise traversals like+-- 'indices' break the 'Traversal' laws. type IndexedTraversal i s t a b = forall p f. (Indexable i p, Applicative f) => p a (f b) -> s -> f t  -- | @@@ -510,6 +514,8 @@  -- | A 'MonadicFold' is a 'Fold' enriched with access to a 'Monad' for side-effects. --+-- A 'MonadicFold' can use side-effects to produce parts of the structure being folded (e.g. reading them from file).+-- -- Every 'Fold' can be used as a 'MonadicFold', that simply ignores the access to the 'Monad'. -- -- You can compose a 'MonadicFold' with another 'MonadicFold' using ('Prelude..') from the @Prelude@.@@ -575,6 +581,14 @@  -- | @ -- type 'LensLike' f s t a b = 'Optical' (->) (->) f s t a b+-- @+--+-- @+-- type 'Over' p f s t a b = 'Optical' p (->) f s t a b+-- @+--+-- @+-- type 'Optic' p f s t a b = 'Optical' p p f s t a b -- @ type Optical p q f s t a b = p a (f b) -> q s (f t)
src/Control/Lens/Wrapped.hs view
@@ -12,6 +12,7 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Wrapped@@ -96,6 +97,10 @@ import           Data.Sequence as Seq hiding (length) import           Data.Set as Set import           Data.Tagged+import           Data.Vector as Vector+import           Data.Vector.Primitive as Prim+import           Data.Vector.Unboxed as Unboxed+import           Data.Vector.Storable as Storable  -- $setup -- >>> :set -XNoOverloadedStrings@@ -119,7 +124,7 @@  -- | Work under a newtype wrapper. ----- >>> Const "hello" & _Wrapped %~ length & getConst+-- >>> Const "hello" & _Wrapped %~ Prelude.length & getConst -- 5 -- -- @@@ -386,6 +391,32 @@   _Wrapped' = iso Foldable.toList Seq.fromList   {-# INLINE _Wrapped' #-} +-- * vector++instance (t ~ Vector.Vector a') => Rewrapped (Vector.Vector a) t+instance Wrapped (Vector.Vector a) where+  type Unwrapped (Vector.Vector a) = [a]+  _Wrapped' = iso Vector.toList Vector.fromList+  {-# INLINE _Wrapped' #-}++instance (Prim a, t ~ Prim.Vector a') => Rewrapped (Prim.Vector a) t+instance Prim a => Wrapped (Prim.Vector a) where+  type Unwrapped (Prim.Vector a) = [a]+  _Wrapped' = iso Prim.toList Prim.fromList+  {-# INLINE _Wrapped' #-}++instance (Unbox a, t ~ Unboxed.Vector a') => Rewrapped (Unboxed.Vector a) t+instance Unbox a => Wrapped (Unboxed.Vector a) where+  type Unwrapped (Unboxed.Vector a) = [a]+  _Wrapped' = iso Unboxed.toList Unboxed.fromList+  {-# INLINE _Wrapped' #-}++instance (Storable a, t ~ Storable.Vector a') => Rewrapped (Storable.Vector a) t+instance Storable a => Wrapped (Storable.Vector a) where+  type Unwrapped (Storable.Vector a) = [a]+  _Wrapped' = iso Storable.toList Storable.fromList+  {-# INLINE _Wrapped' #-}+ -- * semigroups  instance (t ~ S.Min b) => Rewrapped (S.Min a) t@@ -632,7 +663,7 @@ -- -- As with '_Wrapping', the user supplied function for the newtype is /ignored/. ----- >>> alaf Sum foldMap length ["hello","world"]+-- >>> alaf Sum foldMap Prelude.length ["hello","world"] -- 10 alaf :: (Profunctor p, Rewrapping s t) => (Unwrapped s -> s) -> (p r t -> e -> s) -> p r (Unwrapped t) -> e -> Unwrapped s alaf = auf . _Unwrapping
src/Control/Lens/Zoom.hs view
@@ -7,7 +7,12 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +#ifndef MIN_VERSION_mtl+#define MIN_VERSION_mtl(x,y,z) 1+#endif+ ------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Zoom@@ -37,6 +42,9 @@ import Control.Monad.Trans.RWS.Lazy as Lazy import Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.Error+#if MIN_VERSION_mtl(2,2,0)+import Control.Monad.Trans.Except+#endif import Control.Monad.Trans.List import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe@@ -141,6 +149,12 @@ instance (Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t where   zoom l = ErrorT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runErrorT   {-# INLINE zoom #-}++#if MIN_VERSION_mtl(2,2,0)+instance Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t where+  zoom l = ExceptT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runExceptT+  {-# INLINE zoom #-}+#endif  -- TODO: instance Zoom m m a a => Zoom (ContT r m) (ContT r m) a a where
src/Data/Aeson/Lens.hs view
@@ -36,16 +36,21 @@  import Control.Lens import Data.Aeson-import Data.Scientific+import Data.Aeson.Parser (value)+import Data.Attoparsec.ByteString.Lazy (maybeResult, parse)+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.ByteString.Lazy.UTF8 as UTF8 hiding (decode) import Data.Data import Data.HashMap.Strict (HashMap)-import Data.Text+import Data.Text as Text+import Data.Text.Encoding import Data.Vector (Vector) import Prelude hiding (null)  -- $setup+-- >>> import Data.ByteString.Char8 as Strict.Char8 -- >>> :set -XOverloadedStrings  ------------------------------------------------------------------------------@@ -72,7 +77,7 @@   -- >>> "[10.2]" ^? nth 0 . _Double   -- Just 10.2   _Double :: Prism' t Double-  _Double = _Number.iso realToFrac realToFrac+  _Double = _Number.iso Scientific.toRealFloat realToFrac   {-# INLINE _Double #-}    -- |@@ -83,6 +88,9 @@   --   -- >>> "[10.5]" ^? nth 0 . _Integer   -- Just 10+  --+  -- >>> "42" ^? _Integer+  -- Just 42   _Integer :: Prism' t Integer   _Integer = _Number.iso floor fromIntegral   {-# INLINE _Integer #-}@@ -95,7 +103,8 @@   _Number = id   {-# INLINE _Number #-} -instance AsNumber ByteString+instance AsNumber Strict.ByteString+instance AsNumber Lazy.ByteString instance AsNumber String  ------------------------------------------------------------------------------@@ -157,6 +166,9 @@   --   -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String   -- Nothing+  --+  -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")]+  -- "{\"key\":\"value\"}"   _String :: Prism' t Text   _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v)   {-# INLINE _String #-}@@ -166,6 +178,12 @@   --   -- "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool   -- Nothing+  --+  -- >>> _Bool # True+  -- "true"+  --+  -- >>> _Bool # False+  -- "false"   _Bool :: Prism' t Bool   _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v)   {-# INLINE _Bool #-}@@ -175,6 +193,9 @@   --   -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null   -- Nothing+  --+  -- >>> _Null # ()+  -- "null"   _Null :: Prism' t ()   _Null = _Primitive.prism (const NullPrim) (\v -> case v of NullPrim -> Right (); _ -> Left v)   {-# INLINE _Null #-}@@ -202,7 +223,8 @@   _Null = prism (const Null) (\v -> case v of Null -> Right (); _ -> Left v)   {-# INLINE _Null #-} -instance AsPrimitive ByteString+instance AsPrimitive Strict.ByteString+instance AsPrimitive Lazy.ByteString instance AsPrimitive String  instance AsPrimitive Primitive where@@ -239,6 +261,9 @@   --   -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object   -- Nothing+  --+  -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")] :: String+  -- "{\"key\":\"value\"}"   _Object :: Prism' t (HashMap Text Value)   _Object = _Value.prism Object (\v -> case v of Object o -> Right o; _ -> Left v)   {-# INLINE _Object #-}@@ -254,12 +279,16 @@   _Value = id   {-# INLINE _Value #-} -instance AsValue ByteString where+instance AsValue Strict.ByteString where   _Value = _JSON   {-# INLINE _Value #-} +instance AsValue Lazy.ByteString where+  _Value = _JSON+  {-# INLINE _Value #-}+ instance AsValue String where-  _Value = iso UTF8.fromString UTF8.toString._Value+  _Value = utf8._JSON   {-# INLINE _Value #-}  -- |@@ -277,10 +306,10 @@  -- | An indexed Traversal into Object properties ----- >>> "{\"a\": 4, \"b\": 7}" ^@.. members+-- > "{\"a\": 4, \"b\": 7}" ^@.. members -- [("a",Number 4.0),("b",Number 7.0)] ----- >>> "{\"a\": 4, \"b\": 7}" & members . _Number *~ 10+-- > "{\"a\": 4, \"b\": 7}" & members . _Number *~ 10 -- "{\"a\":40,\"b\":70}" members :: AsValue t => IndexedTraversal' Text t Value members = _Object . itraversed@@ -311,16 +340,28 @@ values = _Array . traversed {-# INLINE values #-} +utf8 :: Iso' String Strict.ByteString+utf8 = iso (encodeUtf8 . Text.pack) (Text.unpack . decodeUtf8)+ class AsJSON t where-  -- | A Prism into 'Value' on lazy 'ByteString's.+  -- | '_JSON' is a 'Prism' from something containing JSON to something encoded in that structure   _JSON :: (FromJSON a, ToJSON a) => Prism' t a +instance AsJSON Strict.ByteString where+  _JSON = lazy._JSON+  {-# INLINE _JSON #-}+ instance AsJSON Lazy.ByteString where-  _JSON = prism' encode decode+  _JSON = prism' encode decodeValue+    where+      decodeValue :: (FromJSON a) => Lazy.ByteString -> Maybe a+      decodeValue s = maybeResult (parse value s) >>= \x -> case fromJSON x of+        Success v -> Just v+        _         -> Nothing   {-# INLINE _JSON #-}  instance AsJSON String where-  _JSON = iso UTF8.fromString UTF8.toString._JSON+  _JSON = utf8._JSON   {-# INLINE _JSON #-}  instance AsJSON Value where@@ -328,3 +369,37 @@     Success y -> Right y;     _         -> Left x   {-# INLINE _JSON #-}++------------------------------------------------------------------------------+-- Some additional tests for prismhood; see https://github.com/ekmett/lens/issues/439.+------------------------------------------------------------------------------++-- $LazyByteStringTests+-- >>> "42" ^? (_JSON :: Prism' Lazy.ByteString Value)+-- Just (Number 42.0)+--+-- >>> preview (_Integer :: Prism' Lazy.ByteString Integer) "42"+-- Just 42+--+-- >>> Lazy.unpack (review (_Integer :: Prism' Lazy.ByteString Integer) 42)+-- "42"++-- $StrictByteStringTests+-- >>> "42" ^? (_JSON :: Prism' Strict.ByteString Value)+-- Just (Number 42.0)+--+-- >>> preview (_Integer :: Prism' Strict.ByteString Integer) "42"+-- Just 42+--+-- >>> Strict.Char8.unpack (review (_Integer :: Prism' Strict.ByteString Integer) 42)+-- "42"++-- $StringTests+-- >>> "42" ^? (_JSON :: Prism' String Value)+-- Just (Number 42.0)+--+-- >>> preview (_Integer :: Prism' String Integer) "42"+-- Just 42+--+-- >>> review (_Integer :: Prism' String Integer) 42+-- "42"
src/Data/Map/Lens.hs view
@@ -55,3 +55,4 @@ -- >>> import Control.Lens -- >>> import Data.Monoid -- >>> import qualified Data.Map as Map+-- >>> :set -XNoOverloadedStrings
src/Data/Text/Lazy/Lens.hs view
@@ -16,6 +16,7 @@ ---------------------------------------------------------------------------- module Data.Text.Lazy.Lens   ( packed, unpacked+  , _Text   , text   , builder   , utf8@@ -62,6 +63,18 @@ unpacked :: Iso' Text String unpacked = iso Text.unpack Text.pack {-# INLINE unpacked #-}++-- | This is an alias for 'unpacked' that makes it clearer how to use it with @('#')@.+--+-- @+-- '_Text' = 'from' 'packed'+-- @+--+-- >>> _Text # "hello" -- :: Text+-- "hello"+_Text :: Iso' Text String+_Text = from packed+{-# INLINE _Text #-}  -- | Convert between lazy 'Text' and 'Builder' . --
src/Data/Text/Lens.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-} #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif@@ -14,7 +16,9 @@ -- ---------------------------------------------------------------------------- module Data.Text.Lens-  ( IsText(..), unpacked+  ( IsText(..)+  , unpacked+  , _Text   ) where  import           Control.Lens@@ -51,6 +55,14 @@   text = unpacked . traversed   {-# INLINE text #-} +instance IsText String where+  packed = id+  {-# INLINE packed #-}+  text = indexing traverse+  {-# INLINE text #-}+  builder = Lazy.packed . builder+  {-# INLINE builder #-}+ -- | This isomorphism can be used to 'unpack' (or 'pack') both strict or lazy 'Text'. -- -- @@@ -68,6 +80,18 @@ unpacked = from packed {-# INLINE unpacked #-} +-- | This is an alias for 'unpacked' that makes it clearer how to use it with @('#')@.+--+-- @+-- '_Text' = 'from' 'packed'+-- @+--+-- >>> _Text # "hello" :: Strict.Text+-- "hello"+_Text :: IsText t => Iso' t String+_Text = from packed+{-# INLINE _Text #-}+ instance IsText Strict.Text where   packed = Strict.packed   {-# INLINE packed #-}@@ -83,4 +107,3 @@   {-# INLINE builder #-}   text = Lazy.text   {-# INLINE text #-}-
src/Data/Text/Strict/Lens.hs view
@@ -18,6 +18,7 @@   , builder   , text   , utf8+  , _Text   ) where  import Control.Lens@@ -64,6 +65,15 @@ -- @ unpacked :: Iso' Text String unpacked = iso unpack pack+{-# INLINE unpacked #-}++-- | This is an alias for 'unpacked' that makes it more obvious how to use it with '#'+--+-- >> _Text # "hello" -- :: Text+-- "hello"+_Text :: Iso' Text String+_Text = unpacked+{-# INLINE _Text #-}  -- | Convert between strict 'Text' and 'Builder' . --
src/GHC/Generics/Lens.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeOperators #-}@@ -29,6 +30,57 @@ ---------------------------------------------------------------------------- module GHC.Generics.Lens   ( module Generics.Deriving.Lens+  , _V1+  , _U1+  , _Par1+  , _Rec1+  , _K1+  , _M1+  , _L1+  , _R1   ) where +import Control.Lens import Generics.Deriving.Lens+import GHC.Generics++_V1 :: Over p f (V1 s) (V1 t) a b+_V1 _ = absurd where+  absurd !_a = undefined+{-# INLINE _V1 #-}++_U1 :: Iso (U1 p) (U1 q) () ()+_U1 = iso (const ()) (const U1)+{-# INLINE _U1 #-}++_Par1 :: Iso (Par1 p) (Par1 q) p q+_Par1 = iso unPar1 Par1+{-# INLINE _Par1 #-}++_Rec1 :: Iso (Rec1 f p) (Rec1 g q) (f p) (g q)+_Rec1 = iso unRec1 Rec1+{-# INLINE _Rec1 #-}++_K1 :: Iso (K1 i c p) (K1 j d q) c d+_K1 = iso unK1 K1+{-# INLINE _K1 #-}++_M1 :: Iso (M1 i c f p) (M1 j d g q) (f p) (g q)+_M1 = iso unM1 M1+{-# INLINE _M1 #-}++_L1 :: Prism' ((f :+: g) a) (f a)+_L1 = prism remitter reviewer+  where+  remitter = L1+  reviewer (L1 l) = Right l+  reviewer x = Left x+{-# INLINE _L1 #-}++_R1 :: Prism' ((f :+: g) a) (g a)+_R1 = prism remitter reviewer+  where+  remitter = R1+  reviewer (R1 l) = Right l+  reviewer x = Left x+{-# INLINE _R1 #-}
src/Numeric/Lens.hs view
@@ -46,6 +46,8 @@  -- | A prism that shows and reads integers in base-2 through base-36 --+-- Note: This is an improper prism, since leading 0s are stripped when reading.+-- -- >>> "100" ^? base 16 -- Just 256 --@@ -159,8 +161,8 @@ -- -- Note: This errors for n = 0 ----- >>> au (exponentiating 2._Unwrapping Sum) (foldMapOf each) (3,4)--- 5.0+-- >>> au (exponentiating 2._Unwrapping Sum) (foldMapOf each) (3,4) == 5+-- True exponentiating :: (Floating a, Eq a) => a -> Iso' a a exponentiating 0 = error "Numeric.Lens.exponentiating: exponent 0" exponentiating n = iso (**n) (**recip n)