Skip to content
This repository
Browse code

Added the indexed Kleene store and cloneTraversal

  • Loading branch information...
commit cfb8df9ca8c4acda54e803dbb16312ca7d2da0d0 1 parent 4580320
Edward Kmett authored August 15, 2012
5  CHANGELOG.markdown
Source Rendered
... ...
@@ -1,3 +1,8 @@
  1
+2.3.1
  2
+-----
  3
+* Added the indexed `Kleene` store to `Control.Lens.Internal`
  4
+* Added `cloneTraversal` to `Control.Lens.Traversal`
  5
+
1 6
 2.3
2 7
 ---
3 8
 * Added missing `{-# INLINE #-}` pragmas
2  lens.cabal
... ...
@@ -1,6 +1,6 @@
1 1
 name:          lens
2 2
 category:      Data, Lenses
3  
-version:       2.3
  3
+version:       2.3.1
4 4
 license:       BSD3
5 5
 cabal-version: >= 1.8
6 6
 license-file:  LICENSE
27  src/Control/Lens/Internal.hs
@@ -27,8 +27,11 @@ module Control.Lens.Internal
27 27
   , getMax
28 28
   , ElementOf(..)
29 29
   , ElementOfResult(..)
  30
+  , Kleene(..)
  31
+  , kleene
30 32
   ) where
31 33
 
  34
+
32 35
 import Control.Applicative
33 36
 import Control.Category
34 37
 import Control.Monad
@@ -153,3 +156,27 @@ instance Functor f => Applicative (ElementOf f) where
153 156
       Searching k a -> Searching k (f a)
154 157
       NotFound e    -> NotFound e
155 158
     NotFound e -> NotFound e
  159
+
  160
+
  161
+-- | The "Indexed Kleene Store comonad", aka the 'indexed cartesian store comonad' or an indexed 'FunList'.
  162
+--
  163
+-- This is used to characterize a 'Control.Lens.Traversal.Traversal'.
  164
+--
  165
+-- <http://twanvl.nl/blog/haskell/non-regular1>
  166
+
  167
+data Kleene c d a
  168
+  = Done a
  169
+  | More (Kleene c d (d -> a)) c
  170
+
  171
+instance Functor (Kleene c d) where
  172
+  fmap f (Done a) = Done (f a)
  173
+  fmap f (More k b) = More (fmap (f .) k)  b
  174
+
  175
+instance Applicative (Kleene c d) where
  176
+  pure = Done
  177
+  Done f   <*> m = fmap f m
  178
+  More k c <*> m = More (flip <$> k <*> m) c
  179
+
  180
+kleene :: Applicative f => (c -> f d) -> Kleene c d b -> f b
  181
+kleene _ (Done b) = pure b
  182
+kleene f (More k c) = f c <**> kleene f k
11  src/Control/Lens/Traversal.hs
@@ -44,6 +44,8 @@ module Control.Lens.Traversal
44 44
   -- * Common Traversals
45 45
   , Traversable(traverse)
46 46
   , traverseNothing
  47
+  -- * Cloning Traversals
  48
+  , cloneTraversal
47 49
 
48 50
   -- * Simple
49 51
   , SimpleTraversal
@@ -317,3 +319,12 @@ traverseNothing :: Traversal a a c d
317 319
 traverseNothing = const pure
318 320
 {-# INLINE traverseNothing #-}
319 321
 
  322
+------------------------------------------------------------------------------
  323
+-- Cloning Traversals
  324
+------------------------------------------------------------------------------
  325
+
  326
+-- | A traversal is completely characterized by its behavior on the indexed
  327
+-- "Kleene store" comonad.
  328
+cloneTraversal :: Applicative f => ((c -> Kleene c d d) -> a -> Kleene c d b) -> (c -> f d) -> a -> f b
  329
+cloneTraversal l f = kleene f . l (More (Done id))
  330
+{-# INLINE cloneTraversal #-}

0 notes on commit cfb8df9

Please sign in to comment.
Something went wrong with that request. Please try again.