Merge pull request #11 from jonsterling/ix-and-at

Add ix, at, contains

Author: paf31

bower.json

@@ -20,8 +20,10 @@
   "dependencies": {
     "purescript-const": "~0.5.0",
     "purescript-identity": "~0.4.0",
-    "purescript-profunctor": "~0.3.0",
     "purescript-lists": "~0.7.0",
+    "purescript-maps": "~0.5.2",
+    "purescript-profunctor": "~0.3.0",
+    "purescript-sets": "~0.5.1",
     "purescript-unsafe-coerce": "~0.1.0"
   }
 }

docs/Data/Lens/At.md

@@ -0,0 +1,19 @@
+## Module Data.Lens.At
+
+#### `At`
+
+``` purescript
+class (Index m a b) <= At m a b where
+  at :: a -> LensP m (Maybe b)
+```
+
+##### Instances
+``` purescript
+instance atIdentity :: At (Identity a) Unit a
+instance atMaybe :: At (Maybe a) Unit a
+instance atSet :: (Ord v) => At (Set v) v Unit
+instance atMap :: (Ord k) => At (Map k v) k v
+instance atStrMap :: At (StrMap v) String v
+```
+
+

docs/Data/Lens/Fold.md

@@ -218,7 +218,7 @@ Filters on a predicate.
 #### `replicated`
 
 ``` purescript
-replicated :: forall r a b t f. (Applicative f, Contravariant f) => Int -> Optic (Star f) a b a t
+replicated :: forall a b t f. (Applicative f, Contravariant f) => Int -> Optic (Star f) a b a t
 ```
 
 Replicates the elements of a fold.

docs/Data/Lens/Index.md

@@ -0,0 +1,21 @@
+## Module Data.Lens.Index
+
+#### `Index`
+
+``` purescript
+class Index m a b where
+  ix :: a -> TraversalP m b
+```
+
+##### Instances
+``` purescript
+instance indexArr :: (Eq i) => Index (i -> a) i a
+instance indexMaybe :: Index (Maybe a) Unit a
+instance indexIdentity :: Index (Identity a) Unit a
+instance indexArray :: Index (Array a) Int a
+instance indexSet :: (Ord a) => Index (Set a) a Unit
+instance indexMap :: (Ord k) => Index (Map k v) k v
+instance indexStrMap :: Index (StrMap v) String v
+```
+
+

docs/Data/Lens/Internal/Wander.md

@@ -6,7 +6,7 @@ This module defines the `Wander` type class, which is used to define `Traversal`
 
 ``` purescript
 class (Strong p, Choice p) <= Wander p where
-  wander :: forall f s t a b. (forall f. (Applicative f) => (a -> f b) -> s -> f t) -> p a b -> p s t
+  wander :: forall s t a b. (forall f. (Applicative f) => (a -> f b) -> s -> f t) -> p a b -> p s t
 ```
 
 Class for profunctors that support polymorphic traversals.

docs/Data/Lens/Setter.md

@@ -41,63 +41,63 @@ Synonym for `set`.
 #### `(+~)`
 
 ``` purescript
-(+~) :: forall s t a a. (Semiring a) => Setter s t a a -> a -> s -> t
+(+~) :: forall s t a. (Semiring a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_
 
 #### `(*~)`
 
 ``` purescript
-(*~) :: forall s t a a. (Semiring a) => Setter s t a a -> a -> s -> t
+(*~) :: forall s t a. (Semiring a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_
 
 #### `(-~)`
 
 ``` purescript
-(-~) :: forall s t a a. (Ring a) => Setter s t a a -> a -> s -> t
+(-~) :: forall s t a. (Ring a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_
 
 #### `(//~)`
 
 ``` purescript
-(//~) :: forall s t a a. (DivisionRing a) => Setter s t a a -> a -> s -> t
+(//~) :: forall s t a. (DivisionRing a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_
 
 #### `(||~)`
 
 ``` purescript
-(||~) :: forall s t a a. (BooleanAlgebra a) => Setter s t a a -> a -> s -> t
+(||~) :: forall s t a. (BooleanAlgebra a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_
 
 #### `(&&~)`
 
 ``` purescript
-(&&~) :: forall s t a a. (BooleanAlgebra a) => Setter s t a a -> a -> s -> t
+(&&~) :: forall s t a. (BooleanAlgebra a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_
 
 #### `(<>~)`
 
 ``` purescript
-(<>~) :: forall s t a a. (Semigroup a) => Setter s t a a -> a -> s -> t
+(<>~) :: forall s t a. (Semigroup a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_
 
 #### `(++~)`
 
 ``` purescript
-(++~) :: forall s t a a. (Semigroup a) => Setter s t a a -> a -> s -> t
+(++~) :: forall s t a. (Semigroup a) => Setter s t a a -> a -> s -> t
 ```
 
 _right-associative / precedence 4_

docs/Data/Lens/Types.md

@@ -102,6 +102,12 @@ type Traversal s t a b = forall p. (Wander p) => Optic p s t a b
 
 A traversal.
 
+#### `TraversalP`
+
+``` purescript
+type TraversalP s a = Traversal s s a a
+```
+
 #### `Getter`
 
 ``` purescript

src/Data/Lens/At.purs

@@ -0,0 +1,45 @@
+module Data.Lens.At
+  ( At
+  , at
+  ) where
+
+import Prelude
+
+import Data.Identity (runIdentity, Identity(..))
+import Data.Map as M
+import Data.Maybe (Maybe(..), maybe)
+import Data.Set as S
+import Data.StrMap as SM
+import Data.Tuple
+
+import Data.Lens (LensP(), lens)
+import Data.Lens.Index (Index)
+
+class (Index m a b) <= At m a b where
+  at :: a -> LensP m (Maybe b)
+
+instance atIdentity :: At (Identity a) Unit a where
+  at _ = lens (Just <<< runIdentity) (flip maybe Identity)
+
+instance atMaybe :: At (Maybe a) Unit a where
+  at _ = lens id \_ -> id
+
+instance atSet :: (Ord v) => At (S.Set v) v Unit where
+  at x = lens get (flip update)
+    where
+      get xs =
+        if S.member x xs
+           then Just unit
+           else Nothing
+      update Nothing = S.delete x
+      update (Just _) = S.insert x
+
+instance atMap :: (Ord k) => At (M.Map k v) k v where
+  at k =
+    lens (M.lookup k) \m ->
+      maybe (M.delete k m) \v -> M.insert k v m
+
+instance atStrMap :: At (SM.StrMap v) String v where
+  at k =
+    lens (SM.lookup k) \m ->
+      maybe (SM.delete k m) \ v -> SM.insert k v m

src/Data/Lens/Index.purs

@@ -0,0 +1,61 @@
+module Data.Lens.Index
+  ( Index
+  , ix
+  ) where
+
+import Prelude
+
+import Data.Identity (Identity(..))
+import Data.Map as M
+import Data.Maybe (maybe, fromMaybe, Maybe(..))
+import Data.Set as S
+import Data.StrMap as SM
+import Data.Array as A
+
+import Data.Traversable (traverse)
+import Data.Lens.Internal.Wander
+import Data.Lens.Types (TraversalP())
+
+class Index m a b where
+  ix :: a -> TraversalP m b
+
+instance indexArr :: (Eq i) => Index (i -> a) i a where
+  ix i =
+    wander \coalg f ->
+      coalg (f i) <#> \a j ->
+        if i == j then a else f j
+
+instance indexMaybe :: Index (Maybe a) Unit a where
+  ix _ = wander traverse
+
+instance indexIdentity :: Index (Identity a) Unit a where
+  ix _ = wander traverse
+
+instance indexArray :: Index (Array a) Int a where
+  ix n =
+    wander \coalg xs ->
+      xs A.!! n #
+        maybe
+          (pure xs)
+          (coalg >>> map \x -> fromMaybe xs (A.updateAt n x xs))
+
+instance indexSet :: (Ord a) => Index (S.Set a) a Unit where
+  ix x =
+    wander \coalg ->
+      pure <<< S.insert x
+
+instance indexMap :: (Ord k) => Index (M.Map k v) k v where
+  ix k =
+    wander \coalg m ->
+      M.lookup k m #
+        maybe
+          (pure m)
+          (coalg >>> map \v -> M.insert k v m)
+
+instance indexStrMap :: Index (SM.StrMap v) String v where
+  ix k =
+    wander \coalg m ->
+      SM.lookup k m #
+        maybe
+          (pure m)
+          (coalg >>> map \v -> SM.insert k v m)

src/Data/Lens/Types.purs

@@ -44,6 +44,7 @@ type APrismP s a = APrism s s a a
 
 -- | A traversal.
 type Traversal s t a b = forall p. (Wander p) => Optic p s t a b
+type TraversalP s a = Traversal s s a a
 
 -- | A getter.
 type Getter s t a b = Fold a s t a b