Added a whole bunch of stuff.

Author: joneshf

bower.json

@@ -36,6 +36,7 @@
     "purescript-bifunctors": "~0.0.4"
   },
   "devDependencies": {
-    "purescript-easy-ffi": "~1.0.1"
+    "purescript-easy-ffi": "~1.0.1",
+    "purescript-quickcheck": "~0.1.3"
   }
 }

gulpfile.js

@@ -2,37 +2,38 @@
 
 var gulp        = require('gulp')
   , purescript  = require('gulp-purescript')
+  , run         = require('gulp-run')
   , runSequence = require('run-sequence')
   ;
 
-var paths = {
-    src: 'src/**/*.purs',
-    bowerSrc: [
-      'bower_components/purescript-*/src/**/*.purs',
-      'bower_components/purescript-*/src/**/*.purs.hs'
-    ],
-    dest: '',
-    docs: {
-        'Control.Lens': {
-            dest: 'src/Control/README.md',
-            src: 'src/Control/Lens.purs'
-        },
-        'Control.Lens.*': {
-            dest: 'src/Control/Lens/README.md',
-            src: 'src/Control/Lens/*.purs'
-        }
-    }
-};
+var paths =
+    { src: 'src/**/*.purs'
+    , bowerSrc: [ 'bower_components/purescript-*/src/**/*.purs'
+                ]
+    , dest: ''
+    , docs: { 'Control.Lens': { dest: 'src/Control/README.md'
+                              , src: 'src/Control/Lens.purs'
+                              }
+            , 'Control.Lens.*': { dest: 'src/Control/Lens/README.md'
+                                , src: 'src/Control/Lens/*.purs'
+                                }
+            }
+    , test: 'test/**/*.purs'
+    };
 
-var options = {};
+var options =
+    { test: { main: 'Test.Control.Lens'
+            , verboseErrors: true
+            }
+    };
 
-var compile = function(compiler) {
-    var psc = compiler(options);
+var compile = function(compiler, src, opts) {
+    var psc = compiler(opts);
     psc.on('error', function(e) {
         console.error(e.message);
         psc.end();
     });
-    return gulp.src([paths.src].concat(paths.bowerSrc))
+    return gulp.src(src.concat(paths.bowerSrc))
         .pipe(psc)
         .pipe(gulp.dest(paths.dest));
 };
@@ -51,11 +52,11 @@ function docs (target) {
 }
 
 gulp.task('make', function() {
-    return compile(purescript.pscMake);
+    return compile(purescript.pscMake, [paths.src], {});
 });
 
 gulp.task('browser', function() {
-    return compile(purescript.psc);
+    return compile(purescript.psc, [paths.src], {});
 });
 
 gulp.task('docs-Control.Lens', docs('Control.Lens'));
@@ -71,4 +72,9 @@ gulp.task('watch-make', function() {
     gulp.watch(paths.src, function() {runSequence('make', 'docs')});
 });
 
+gulp.task('test', function() {
+    return compile(purescript.psc, [paths.src, paths.test], options.test)
+        .pipe(run('node').exec());
+});
+
 gulp.task('default', function() {runSequence('make', 'docs')});

src/Control/Lens.purs

@@ -4,7 +4,20 @@ module Control.Lens
   , Index()
   , IxValue()
   , at
+  , contains
   , ix
+  -- Cons
+  , (<|), (|>)
+  , _Cons
+  , _Snoc
+  , _cons
+  , head
+  , init
+  , last
+  , snoc
+  , tail
+  , uncons
+  , unsnoc
   -- Fold
   , (^..), (^?)
   , filtered
@@ -38,6 +51,11 @@ module Control.Lens
   , lens
   -- Prism
   , clonePrism
+  , is
+  , isn't
+  , matching
+  , nearly
+  , only
   , prism
   , prism'
   , withPrism
@@ -128,6 +146,7 @@ module Control.Lens
   )  where
 
   import qualified Control.Lens.At as At
+  import qualified Control.Lens.Cons as Cons
   import qualified Control.Lens.Fold as Fold
   import qualified Control.Lens.Getter as Getter
   import qualified Control.Lens.Indexed as Indexed
@@ -142,8 +161,25 @@ module Control.Lens
   -- At
   type Index a b   = At.Index a b
   type IxValue a b = At.IxValue a b
-  at = At.at
-  ix = At.ix
+  at       = At.at
+  contains = At.contains
+  ix       = At.ix
+
+  -- Cons
+  infixr 5 <|
+  infixl 5 |>
+  (<|)   = Cons.(<|)
+  (|>)   = Cons.(|>)
+  _Cons  = Cons._Cons
+  _Snoc  = Cons._Snoc
+  _cons  = Cons._cons
+  head   = Cons.head
+  init   = Cons.init
+  last   = Cons.last
+  snoc   = Cons.snoc
+  tail   = Cons.tail
+  uncons = Cons.uncons
+  unsnoc = Cons.unsnoc
 
   -- Fold
   infixl 8 ^..
@@ -192,6 +228,11 @@ module Control.Lens
 
   -- Prism
   clonePrism = Prism.clonePrism
+  is         = Prism.is
+  isn't      = Prism.isn't
+  matching   = Prism.matching
+  nearly     = Prism.nearly
+  only       = Prism.only
   prism      = Prism.prism
   prism'     = Prism.prism'
   withPrism  = Prism.withPrism

src/Control/Lens/At.purs

@@ -1,9 +1,11 @@
 module Control.Lens.At
   ( At
+  , Contains
   , Ixed
   , Index()
   , IxValue()
   , at
+  , contains
   , ix
   ) where
 
@@ -12,8 +14,10 @@ module Control.Lens.At
   import Control.Lens.Type (LensP(), TraversalP())
   import Control.Monad.Identity (Identity(..))
 
+  import Data.Array (delete, elemIndex, snoc, updateAt)
   import Data.Maybe (maybe, Maybe(..))
   import Data.Traversable (sequence, traverse)
+  import Data.Tuple (snd)
 
   import qualified Data.Map as M
   import qualified Data.Set as S

src/Control/Lens/Cons.purs

@@ -0,0 +1,83 @@
+module Control.Lens.Cons
+  ( Cons
+  , Snoc
+  , (<|)
+  , (|>)
+  , _Cons
+  , _Snoc
+  , _cons
+  , head
+  , init
+  , last
+  , snoc
+  , tail
+  , uncons
+  , unsnoc
+  ) where
+
+  import Control.Lens.Equality (simply)
+  import Control.Lens.Fold ((^?))
+  import Control.Lens.Prism (prism)
+  import Control.Lens.Review (review)
+  import Control.Lens.Tuple (_1, _2)
+  import Control.Lens.Type (Prism(), TraversalP())
+  import Control.Monad.Reader.Class (MonadReader)
+
+  import Data.Either (Either(..))
+  import Data.Maybe (Maybe())
+  import Data.Profunctor (dimap)
+  import Data.Tuple (curry, snd, uncurry, Tuple(..))
+
+  import Prelude hiding (cons)
+
+  import qualified Data.Array as A
+  import qualified Data.Array.Unsafe as AU
+
+  infixr 5 <|
+  infixl 5 |>
+
+  class Cons s t a b where
+    _Cons :: Prism (s a) (t b) (Tuple a (s a)) (Tuple b (t b))
+
+  instance consArray :: Cons [] [] a b where
+    _Cons = prism (uncurry (:)) \xs -> case xs of
+      (x:xs') -> Right (Tuple x xs')
+      []      -> Left  []
+
+  class Snoc s t a b where
+    _Snoc :: Prism (s a) (t b) (Tuple (s a) a) (Tuple (t b) b)
+
+  instance snocArray :: Snoc [] [] a b where
+    _Snoc = prism (uncurry A.snoc) \xs -> case xs of
+      [] -> Left  []
+      _  -> Right (Tuple (AU.init xs) (AU.last xs))
+
+  (<|) :: forall a s. (Cons s s a a) => a -> s a -> s a
+  (<|) = curry (simply review _Cons)
+
+  _cons :: forall a s. (Cons s s a a) => a -> s a -> s a
+  _cons = (<|)
+
+  uncons :: forall a s. (Cons s s a a) => s a -> Maybe (Tuple a (s a))
+  uncons xs = xs ^? _Cons
+
+  head :: forall a s. (Cons s s a a) => TraversalP (s a) a
+  head = _Cons <<< _1
+
+  tail :: forall a s. (Cons s s a a) => TraversalP (s a) (s a)
+  tail = _Cons <<< _2
+
+  (|>) :: forall a s. (Snoc s s a a) => s a -> a -> s a
+  (|>) = curry (simply review _Snoc)
+
+  snoc :: forall a s. (Snoc s s a a) => s a -> a -> s a
+  snoc = curry (simply review _Snoc)
+
+  unsnoc :: forall a s. (Snoc s s a a) => s a -> Maybe (Tuple (s a) a)
+  unsnoc xs = xs ^? _Snoc
+
+  init :: forall a s. (Snoc s s a a) => TraversalP (s a) (s a)
+  init = _Snoc <<< _1
+
+  last :: forall a s. (Snoc s s a a) => TraversalP (s a) a
+  last = _Snoc <<< _2

src/Control/Lens/Equality.purs

@@ -0,0 +1,6 @@
+module Control.Lens.Equality where
+
+  import Control.Lens.Type (OpticP())
+
+  simply :: forall p f s a r. (OpticP p f s a -> r) -> OpticP p f s a -> r
+  simply = id

src/Control/Lens/Prism.purs

@@ -2,6 +2,11 @@ module Control.Lens.Prism
   ( APrism()
   , APrismP()
   , clonePrism
+  , is
+  , isn't
+  , matching
+  , nearly
+  , only
   , prism
   , prism'
   , withPrism
@@ -14,6 +19,7 @@ module Control.Lens.Prism
   import Control.Lens.Internal.Prism (Market(..))
   import Control.Lens.Type (Lens(), Prism(), PrismP())
   import Control.Monad.Identity (runIdentity, Identity(..))
+  import Control.MonadPlus (guard)
 
   import Data.Profunctor (dimap, lmap, Profunctor)
   import Data.Profunctor.Choice (right', Choice)
@@ -27,6 +33,21 @@ module Control.Lens.Prism
   clonePrism :: forall f p s t a b. (Applicative f, Choice p) => APrism  s t a b -> p a (f b) -> p s (f t)
   clonePrism stab = withPrism stab prism
 
+  is :: forall s t a b. APrism s t a b -> s -> Boolean
+  is stab s = either (const false) (const true) $ matching stab s
+
+  isn't :: forall s t a b. APrism s t a b -> s -> Boolean
+  isn't stab s = not $ is stab s
+
+  matching :: forall s t a b. APrism s t a b -> s -> Either t a
+  matching stab = withPrism stab \_ s -> s
+
+  nearly :: forall a. a -> (a -> Boolean) -> PrismP a Unit
+  nearly x p = prism' (\_ -> x) $ guard <<< p
+
+  only :: forall a. (Eq a) => a -> PrismP a Unit
+  only x = nearly x ((==) x)
+
   -- outside :: forall f p r s t a b. (Profunctor p, Representable p f) => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)
   -- outside stab = withPrism stab \b2t s2Eta f ft ->
   --   (\fa -> tabulate $ either (rep ft) (rep fa) <<< s2Eta) <$> f (lmap b2t ft)