Permalink
Browse files

doctest 0.9 (see #46), renamed `|>` to `%` (see #17)

  • Loading branch information...
1 parent 054b6b0 commit 310cebb51321d57c845c10dbf4ba2148ada081fc @ekmett committed Sep 11, 2012
Showing with 91 additions and 89 deletions.
  1. +3 −1 CHANGELOG.markdown
  2. +2 −2 lens.cabal
  3. +1 −1 src/Control/Lens.hs
  4. +7 −7 src/Control/Lens/Combinators.hs
  5. +16 −16 src/Control/Lens/TH.hs
  6. +1 −1 src/Data/Sequence/Lens.hs
  7. +61 −61 tests/hunit.hs
View
@@ -1,6 +1,8 @@
-2.8.1
+2.9
-----
* Added `<<%~`, `<<.~`, `<<%=` and `<<.=` for accessing the old values targeted by a `Lens` (or a summary of those targeted by a `Traversal`)
+* Renamed `|>` to `%`, as `%~` is the lensed version of `%`.
+* Upgraded to `doctest` 0.9, which lets us factor out common `$setup` for our doctests
2.8
---
View
@@ -1,6 +1,6 @@
name: lens
category: Data, Lenses
-version: 2.8.1
+version: 2.9
license: BSD3
cabal-version: >= 1.8
license-file: LICENSE
@@ -37,7 +37,7 @@ description:
.
The core of this hierarchy looks like:
.
- <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.8.png>>
+ <<https://github.com/ekmett/lens/wiki/images/Hierarchy-2.9.png>>
.
You can compose any two elements of the hierarchy above using (.) from the Prelude, and you can
use any element of the hierarchy as any type it links to above it.
View
@@ -41,7 +41,7 @@
--
-- <http://github.com/ekmett/lens/wiki>
--
--- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.8.png>>
+-- <<http://github.com/ekmett/lens/wiki/images/Hierarchy-2.9.png>>
----------------------------------------------------------------------------
module Control.Lens
( module Control.Lens.Type
@@ -9,24 +9,24 @@
--
-------------------------------------------------------------------------------
module Control.Lens.Combinators
- ( (|>)
+ ( (%)
, (<$!>), (<$!)
) where
infixr 4 <$!>, <$!
-infixl 1 |>
+infixl 1 %
-- | Passes the result of the left side to the function on the right side (forward pipe operator).
--
--- This is the flipped version of ('$'), which is more common in languages like F# where it is needed
+-- This is the flipped version of ('$'), which is more common in languages like F# as (@|>@) where it is needed
-- for inference. Here it is supplied for notational convenience and given a precedence that allows it
-- to be nested inside uses of ('$').
--
--- >>> "hello" |> length |> succ
+-- >>> "hello" % length % succ
-- 6
-(|>) :: a -> (a -> b) -> b
-a |> f = f a
-{-# INLINE (|>) #-}
+(%) :: a -> (a -> b) -> b
+a % f = f a
+{-# INLINE (%) #-}
-- | A strict version of ('Data.Functor.<$>') for monads.
--
View
@@ -169,21 +169,21 @@ defaultRules = LensRules top field (const Nothing) $
-- for isomorphisms and traversals, and not making any classes.
lensRules :: LensRules
lensRules = defaultRules
- |> lensIso .~ const Nothing
- |> lensClass .~ const Nothing
- |> handleSingletons .~ True
- |> partialLenses .~ False
- |> buildTraversals .~ True
+ % lensIso .~ const Nothing
+ % lensClass .~ const Nothing
+ % handleSingletons .~ True
+ % partialLenses .~ False
+ % buildTraversals .~ True
-- | Rules for making lenses and traversals that precompose another lens.
classyRules :: LensRules
classyRules = defaultRules
- |> lensIso .~ const Nothing
- |> handleSingletons .~ False
- |> lensClass .~ classy
- |> classRequired .~ True
- |> partialLenses .~ False
- |> buildTraversals .~ True
+ % lensIso .~ const Nothing
+ % handleSingletons .~ False
+ % lensClass .~ classy
+ % classRequired .~ True
+ % partialLenses .~ False
+ % buildTraversals .~ True
where
classy :: String -> Maybe (String, String)
classy n@(a:as) = Just ("Has" ++ n, toLower a:as)
@@ -192,8 +192,8 @@ classyRules = defaultRules
-- | Rules for making an isomorphism from a data type
isoRules :: LensRules
isoRules = defaultRules
- |> singletonRequired .~ True
- |> singletonAndField .~ True
+ % singletonRequired .~ True
+ % singletonAndField .~ True
-- | Build lenses (and traversals) with a sensible default configuration.
--
@@ -253,7 +253,7 @@ makeIso = makeLensesWith isoRules
-- > makeLensesFor [("_foo", "fooLens"), ("baz", "lbaz")] ''Foo
-- > makeLensesFor [("_barX", "bar"), ("_barY", "bar)] ''Bar
makeLensesFor :: [(String, String)] -> Name -> Q [Dec]
-makeLensesFor fields = makeLensesWith $ lensRules |> lensField .~ (`Prelude.lookup` fields)
+makeLensesFor fields = makeLensesWith $ lensRules % lensField .~ (`Prelude.lookup` fields)
-- | Derive lenses and traversals, using a named wrapper class, and specifying
-- explicit pairings of @(fieldName, traversalName)@.
@@ -263,8 +263,8 @@ makeLensesFor fields = makeLensesWith $ lensRules |> lensField .~ (`Prelude.look
-- > makeClassyFor "HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo
makeClassyFor :: String -> String -> [(String, String)] -> Name -> Q [Dec]
makeClassyFor clsName funName fields = makeLensesWith $ classyRules
- |> lensClass .~ const (Just (clsName,funName))
- |> lensField .~ (`Prelude.lookup` fields)
+ % lensClass .~ const (Just (clsName,funName))
+ % lensField .~ (`Prelude.lookup` fields)
-- | Build lenses with a custom configuration.
makeLensesWith :: LensRules -> Name -> Q [Dec]
@@ -19,7 +19,7 @@ module Data.Sequence.Lens
) where
import Control.Applicative
-import Control.Lens as Lens hiding ((|>))
+import Control.Lens as Lens
import Data.Monoid
import Data.Sequence as Seq
View
@@ -80,85 +80,85 @@ case_read_state_record_field_and_apply_function =
where test = use $ points.to last.to (vectorFrom origin).x
case_write_record_field =
- (trig |> box.high.y .~ 6)
- @?= trig { _box = (trig |> _box)
- { _high = (trig |> _box |> _high)
+ (trig % box.high.y .~ 6)
+ @?= trig { _box = (trig % _box)
+ { _high = (trig % _box % _high)
{ _y = 6 } } }
case_write_state_record_field = do
- let trig' = trig { _box = (trig |> _box)
- { _high = (trig |> _box |> _high)
+ let trig' = trig { _box = (trig % _box)
+ { _high = (trig % _box % _high)
{ _y = 6 } } }
runState test trig @?= ((), trig')
where
test = box.high.y .= 6
case_write_record_field_and_access_new_value =
- (trig |> box.high.y <.~ 6)
- @?= (6, trig { _box = (trig |> _box)
- { _high = (trig |> _box |> _high)
+ (trig % box.high.y <.~ 6)
+ @?= (6, trig { _box = (trig % _box)
+ { _high = (trig % _box % _high)
{ _y = 6 } } })
case_write_state_record_field_and_access_new_value = do
- let trig' = trig { _box = (trig |> _box)
- { _high = (trig |> _box |> _high)
+ let trig' = trig { _box = (trig % _box)
+ { _high = (trig % _box % _high)
{ _y = 6 } } }
runState test trig @?= (6, trig')
where
test = box.high.y <.= 6
case_write_record_field_and_access_old_value =
- (trig |> box.high.y <<.~ 6)
- @?= (7, trig { _box = (trig |> _box)
- { _high = (trig |> _box |> _high)
+ (trig % box.high.y <<.~ 6)
+ @?= (7, trig { _box = (trig % _box)
+ { _high = (trig % _box % _high)
{ _y = 6 } } })
case_write_state_record_field_and_access_old_value = do
- let trig' = trig { _box = (trig |> _box)
- { _high = (trig |> _box |> _high)
+ let trig' = trig { _box = (trig % _box)
+ { _high = (trig % _box % _high)
{ _y = 6 } } }
runState test trig @?= (7, trig')
where
test = box.high.y <<.= 6
case_modify_record_field =
- (trig |> box.low.y %~ (+ 2))
- @?= trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 2) } } }
+ (trig % box.low.y %~ (+ 2))
+ @?= trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 2) } } }
case_modify_state_record_field = do
- let trig' = trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 2) } } }
+ let trig' = trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 2) } } }
runState test trig @?= ((), trig')
where
test = box.low.y %= (+ 2)
case_modify_record_field_and_access_new_value =
- (trig |> box.low.y <%~ (+ 2))
- @?= (2, trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 2) } } })
+ (trig % box.low.y <%~ (+ 2))
+ @?= (2, trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 2) } } })
case_modify_state_record_field_and_access_new_value = do
- let trig' = trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 2) } } }
+ let trig' = trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 2) } } }
runState test trig @?= (2, trig')
where
test = box.low.y <%= (+ 2)
case_modify_record_field_and_access_old_value =
- (trig |> box.low.y <<%~ (+ 2))
- @?= (0, trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 2) } } })
+ (trig % box.low.y <<%~ (+ 2))
+ @?= (0, trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 2) } } })
case_modify_state_record_field_and_access_old_value = do
- let trig' = trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 2) } } }
+ let trig' = trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 2) } } }
runState test trig @?= (0, trig')
where
test = box.low.y <<%= (+ 2)
@@ -168,54 +168,54 @@ case_modify_record_field_and_access_side_result = do
where
test = box.high %%= modifyAndCompute
modifyAndCompute point =
- (point ^. x, point |> y +~ 2)
- trig' = trig { _box = (trig |> _box)
- { _high = (trig |> _box |> _high)
- { _y = ((trig |> _box |> _high |> _y) + 2) } } }
+ (point ^. x, point % y +~ 2)
+ trig' = trig { _box = (trig % _box)
+ { _high = (trig % _box % _high)
+ { _y = ((trig % _box % _high % _y) + 2) } } }
case_increment_record_field =
- (trig |> box.low.y +~ 1) -- And similarly for -~ *~ //~ ^~ ^^~ **~ ||~ &&~
- @?= trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 1) } } }
+ (trig % box.low.y +~ 1) -- And similarly for -~ *~ //~ ^~ ^^~ **~ ||~ &&~
+ @?= trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 1) } } }
case_increment_state_record_field =
runState test trig @?= ((), trig')
where
test = box.low.y += 1
- trig' = trig { _box = (trig |> _box)
- { _low = (trig |> _box |> _low)
- { _y = ((trig |> _box |> _low |> _y) + 1) } } }
+ trig' = trig { _box = (trig % _box)
+ { _low = (trig % _box % _low)
+ { _y = ((trig % _box % _low % _y) + 1) } } }
case_append_to_record_field =
- (trig |> points ++~ [ origin ])
- @?= trig { _points = (trig |> _points) ++ [ origin ] }
+ (trig % points ++~ [ origin ])
+ @?= trig { _points = (trig % _points) ++ [ origin ] }
case_append_to_state_record_field = do
runState test trig @?= ((), trig')
where
test = points ++= [ origin ]
- trig' = trig { _points = (trig |> _points) ++ [ origin ] }
+ trig' = trig { _points = (trig % _points) ++ [ origin ] }
case_append_to_record_field_and_access_new_value =
- (trig |> points <++~ [ origin ])
- @?= (_points trig ++ [ origin ], trig { _points = (trig |> _points) ++ [ origin ] })
+ (trig % points <++~ [ origin ])
+ @?= (_points trig ++ [ origin ], trig { _points = (trig % _points) ++ [ origin ] })
case_append_to_state_record_field_and_access_new_value = do
runState test trig @?= (_points trig ++ [ origin ], trig')
where
test = points <++= [ origin ]
- trig' = trig { _points = (trig |> _points) ++ [ origin ] }
+ trig' = trig { _points = (trig % _points) ++ [ origin ] }
case_append_to_record_field_and_access_old_value =
- (trig |> points <<%~ (++[origin]))
- @?= (_points trig, trig { _points = (trig |> _points) ++ [ origin ] })
+ (trig % points <<%~ (++[origin]))
+ @?= (_points trig, trig { _points = (trig % _points) ++ [ origin ] })
case_append_to_state_record_field_and_access_old_value = do
runState test trig @?= (_points trig, trig')
where
test = points <<%= (++[origin])
- trig' = trig { _points = (trig |> _points) ++ [ origin ] }
+ trig' = trig { _points = (trig % _points) ++ [ origin ] }
case_read_maybe_map_entry = trig^.labels.at origin @?= Just "Origin"
@@ -229,32 +229,32 @@ case_read_state_map_entry = runState test trig @?= ("Origin", trig)
where test = use $ labels.traverseAt origin
case_modify_map_entry =
- (trig |> labels.traverseAt origin %~ List.map toUpper)
+ (trig % labels.traverseAt origin %~ List.map toUpper)
@?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "ORIGIN")
, (Point { _x = 4, _y = 7 }, "Peak") ] }
case_insert_maybe_map_entry =
- (trig |> labels.at (Point { _x = 8, _y = 0 }) .~ Just "Right")
+ (trig % labels.at (Point { _x = 8, _y = 0 }) .~ Just "Right")
@?= trig { _labels = fromList [ (Point { _x = 0, _y = 0 }, "Origin")
, (Point { _x = 4, _y = 7 }, "Peak")
, (Point { _x = 8, _y = 0 }, "Right") ] }
case_delete_maybe_map_entry =
- (trig |> labels.at origin .~ Nothing)
+ (trig % labels.at origin .~ Nothing)
@?= trig { _labels = fromList [ (Point { _x = 4, _y = 7 }, "Peak") ] }
case_read_list_entry =
(trig^.points.element 0)
@?= origin
case_write_list_entry =
- (trig |> points.element 0 .~ Point { _x = 2, _y = 0 })
+ (trig % points.element 0 .~ Point { _x = 2, _y = 0 })
@?= trig { _points = [ Point { _x = 2, _y = 0 }
, Point { _x = 4, _y = 7 }
, Point { _x = 8, _y = 0 } ] }
case_write_through_list_entry =
- (trig |> points.element 0 . x .~ 2)
+ (trig % points.element 0 . x .~ 2)
@?= trig { _points = [ Point { _x = 2, _y = 0 }
, Point { _x = 4, _y = 7 }
, Point { _x = 8, _y = 0 } ] }

0 comments on commit 310cebb

Please sign in to comment.