summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcmk <>2019-11-04 05:32:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-11-04 05:32:00 (GMT)
commit46cc0f7ba79150e494b6d7ca91f03f3f0900a252 (patch)
tree06fc5ea0214f3fd26d68c3b35aa89069ba816e4a
version 0.0.0.10.0.0.1
-rw-r--r--ChangeLog.md5
-rw-r--r--LICENSE14
-rw-r--r--profunctor-optics.cabal80
-rw-r--r--src/Data/Profunctor/Optic.hs33
-rw-r--r--src/Data/Profunctor/Optic/Cofold.hs75
-rw-r--r--src/Data/Profunctor/Optic/Cotraversal.hs29
-rw-r--r--src/Data/Profunctor/Optic/Fold.hs369
-rw-r--r--src/Data/Profunctor/Optic/Fold0.hs166
-rw-r--r--src/Data/Profunctor/Optic/Grate.hs180
-rw-r--r--src/Data/Profunctor/Optic/Iso.hs278
-rw-r--r--src/Data/Profunctor/Optic/Lens.hs198
-rw-r--r--src/Data/Profunctor/Optic/Operator.hs18
-rw-r--r--src/Data/Profunctor/Optic/Prelude.hs29
-rw-r--r--src/Data/Profunctor/Optic/Prism.hs523
-rw-r--r--src/Data/Profunctor/Optic/Property.hs172
-rw-r--r--src/Data/Profunctor/Optic/Setter.hs273
-rw-r--r--src/Data/Profunctor/Optic/Traversal.hs65
-rw-r--r--src/Data/Profunctor/Optic/Traversal0.hs163
-rw-r--r--src/Data/Profunctor/Optic/Type.hs484
-rw-r--r--src/Data/Profunctor/Optic/View.hs333
-rw-r--r--src/Data/Profunctor/Orphan.hs61
21 files changed, 3548 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..0fa6e83
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for dioids
+
+## 0.0.1 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..4948990
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,14 @@
+BSD 3-Clause License
+
+Copyright Christopher McKinlay (c) 2019
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/profunctor-optics.cabal b/profunctor-optics.cabal
new file mode 100644
index 0000000..dc72d12
--- /dev/null
+++ b/profunctor-optics.cabal
@@ -0,0 +1,80 @@
+cabal-version: >= 1.10
+
+name: profunctor-optics
+version: 0.0.0.1
+synopsis: Profunctor optics
+description: A profunctor optics library compatible with the typeclasses in 'profunctors'.
+category: Data, Lenses
+homepage: https://github.com/cmk/profunctor-extras
+bug-reports: https://github.com/cmk/profunctor-extras/issues
+author: Chris McKinlay
+maintainer: Chris McKinlay
+copyright: 2019 Chris McKinlay
+license: BSD3
+license-file: LICENSE
+build-type: Simple
+extra-source-files: ChangeLog.md
+
+source-repository head
+ type: git
+ location: https://github.com/cmk/profunctor-extras
+
+library
+ exposed-modules:
+ Data.Profunctor.Optic
+ Data.Profunctor.Optic.Type
+ Data.Profunctor.Optic.Operator
+ Data.Profunctor.Optic.Iso
+ Data.Profunctor.Optic.View
+ Data.Profunctor.Optic.Setter
+ Data.Profunctor.Optic.Lens
+ Data.Profunctor.Optic.Prism
+ Data.Profunctor.Optic.Grate
+ Data.Profunctor.Optic.Fold
+ Data.Profunctor.Optic.Fold0
+ Data.Profunctor.Optic.Cofold
+ Data.Profunctor.Optic.Traversal
+ Data.Profunctor.Optic.Traversal0
+ Data.Profunctor.Optic.Cotraversal
+ Data.Profunctor.Optic.Prelude
+ Data.Profunctor.Optic.Property
+ Data.Profunctor.Orphan
+
+ default-language: Haskell2010
+
+ hs-source-dirs:
+ src
+ default-extensions:
+ ConstraintKinds
+ RankNTypes
+ MultiParamTypeClasses
+ OverloadedStrings
+ TupleSections
+ FlexibleContexts
+ FlexibleInstances
+ ExistentialQuantification
+ NoImplicitPrelude
+ QuantifiedConstraints
+ ScopedTypeVariables
+ TupleSections
+ TypeOperators
+ TypeApplications
+ TypeFamilies
+
+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates
+ build-depends:
+ base >=4.9 && <5.0
+ , adjunctions
+ , bifunctors
+ , comonad
+ , connections
+ , contravariant
+ , distributive
+ , foldl
+ , mtl
+ , profunctor-misc
+ , profunctors
+ , recursion-schemes
+ , rings
+ , semigroupoids
+ , unliftio-core
diff --git a/src/Data/Profunctor/Optic.hs b/src/Data/Profunctor/Optic.hs
new file mode 100644
index 0000000..ae9dd1b
--- /dev/null
+++ b/src/Data/Profunctor/Optic.hs
@@ -0,0 +1,33 @@
+module Data.Profunctor.Optic (
+ module Type
+ , module Operator
+ , module Property
+ , module Iso
+ , module View
+ , module Setter
+ , module Lens
+ , module Prism
+ , module Grate
+ , module Fold
+ , module Fold0
+ , module Cofold
+ , module Traversal
+ , module Traversal0
+ , module Cotraversal
+) where
+
+import Data.Profunctor.Optic.Type as Type
+import Data.Profunctor.Optic.Operator as Operator
+import Data.Profunctor.Optic.Property as Property
+import Data.Profunctor.Optic.Iso as Iso
+import Data.Profunctor.Optic.View as View
+import Data.Profunctor.Optic.Setter as Setter
+import Data.Profunctor.Optic.Lens as Lens
+import Data.Profunctor.Optic.Prism as Prism
+import Data.Profunctor.Optic.Grate as Grate
+import Data.Profunctor.Optic.Fold as Fold
+import Data.Profunctor.Optic.Fold0 as Fold0
+import Data.Profunctor.Optic.Cofold as Cofold
+import Data.Profunctor.Optic.Traversal as Traversal
+import Data.Profunctor.Optic.Traversal0 as Traversal0
+import Data.Profunctor.Optic.Cotraversal as Cotraversal
diff --git a/src/Data/Profunctor/Optic/Cofold.hs b/src/Data/Profunctor/Optic/Cofold.hs
new file mode 100644
index 0000000..035b907
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Cofold.hs
@@ -0,0 +1,75 @@
+module Data.Profunctor.Optic.Cofold where
+
+import Data.Functor.Foldable (Corecursive, Base)
+import Data.Profunctor.Optic.Cotraversal
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Optic.View
+import Data.Profunctor.Optic.Type
+import qualified Data.List as L (unfoldr)
+import qualified Data.Functor.Foldable as F
+
+---------------------------------------------------------------------
+-- 'Cofold'
+---------------------------------------------------------------------
+
+-- | Transform a Van Laarhoven 'Cofold' into a profunctor 'Cofold'.
+--
+cofoldVL :: (forall f. Functor f => (f a -> b) -> f s -> t) -> Cofold t b
+cofoldVL f = coercel . lower f . coercel
+{-# INLINE cofoldVL #-}
+
+-- | TODO: Document
+--
+cofolded :: Distributive f => (b -> t) -> Cofold (f t) b
+cofolded f = cotraversed . from f
+{-# INLINE cofolded #-}
+
+-- | Build a 'Cofold' from a 'Review'.
+--
+toCofold :: AReview t b -> Cofold t b
+toCofold = from . review
+{-# INLINE toCofold #-}
+
+-- | Build a 'Review' from a 'Cofold'.
+--
+fromCofold :: ACofold b t b -> Review t b
+fromCofold = cloneReview
+{-# INLINE fromCofold #-}
+
+---------------------------------------------------------------------
+-- 'CofoldRep'
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+acofold :: ((r -> b) -> r -> t) -> ACofold r t b
+acofold = between (Costar . (. getConst)) ((. Const) . runCostar)
+{-# INLINE acofold #-}
+
+-- | TODO: Document
+--
+acofold' :: ACofold b [t] (Maybe (t, b))
+acofold' = acofold L.unfoldr
+{-# INLINE acofold' #-}
+
+-- | TODO: Document
+--
+corecursing :: Corecursive t => ACofold b t (Base t b)
+corecursing = acofold F.unfold
+{-# INLINE corecursing #-}
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+cofoldMapOf :: ACofold r t b -> (r -> b) -> r -> t
+cofoldMapOf = between ((. Const) . runCostar) (Costar . (. getConst))
+{-# INLINE cofoldMapOf #-}
+
+-- | TODO: Document
+--
+cofoldOf :: AReview t b -> b -> t
+cofoldOf = flip cofoldMapOf id
+{-# INLINE cofoldOf #-}
diff --git a/src/Data/Profunctor/Optic/Cotraversal.hs b/src/Data/Profunctor/Optic/Cotraversal.hs
new file mode 100644
index 0000000..9bf087a
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Cotraversal.hs
@@ -0,0 +1,29 @@
+module Data.Profunctor.Optic.Cotraversal where
+
+import Data.Profunctor.Optic.Type
+import Data.Profunctor.Optic.Prelude
+
+---------------------------------------------------------------------
+-- 'Cotraversal'
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+cotraversed :: Distributive f => Cotraversal (f a) (f b) a b
+cotraversed = lower cotraverse
+
+-- | Transform a Van Laarhoven 'Cotraversal' into a profunctor 'Cotraversal'.
+--
+cotraversalVL :: (forall f. Functor f => (f a -> b) -> f s -> t) -> Cotraversal s t a b
+cotraversalVL = lower
+
+---------------------------------------------------------------------
+-- Operators
+---------------------------------------------------------------------
+
+-- ^ @
+-- 'cotraverseOf' $ 'Data.Profuncto.Optic.Grate.grate' (flip 'Data.Distributive.cotraverse' id) ≡ 'Data.Distributive.cotraverse'
+-- @
+--
+cotraverseOf :: Optic (Costar f) s t a b -> (f a -> b) -> (f s -> t)
+cotraverseOf = between runCostar Costar
diff --git a/src/Data/Profunctor/Optic/Fold.hs b/src/Data/Profunctor/Optic/Fold.hs
new file mode 100644
index 0000000..ac4fe53
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Fold.hs
@@ -0,0 +1,369 @@
+module Data.Profunctor.Optic.Fold where
+
+import Control.Foldl (EndoM(..))
+import Control.Monad ((<=<))
+import Data.Foldable (Foldable, foldMap, traverse_)
+import Data.Functor.Foldable (Recursive, Base)
+import Data.Monoid
+import Data.Prd (Prd(..), Min(..), Max(..))
+import Data.Prd.Lattice (Lattice(..))
+import Data.Semiring (Semiring(..))
+import Data.Profunctor.Optic.Prelude hiding (min, max, join)
+import Data.Profunctor.Optic.Traversal
+import Data.Profunctor.Optic.Type
+import Data.Profunctor.Optic.View (to, view, cloneView)
+import qualified Control.Foldl as L
+import qualified Data.Functor.Foldable as F
+import qualified Data.Prd as Prd
+import qualified Data.Semiring as Rng
+import qualified Prelude as Pre
+
+---------------------------------------------------------------------
+-- 'Fold'
+---------------------------------------------------------------------
+
+-- | Transform a Van Laarhoven 'Fold' into a profunctor 'Fold'.
+--
+foldVL :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> Fold s a
+foldVL f = coercer . lift f . coercer
+{-# INLINE foldVL #-}
+
+-- | Obtain a 'Fold' using a 'Traversable' functor.
+--
+-- @
+-- 'folded' f ≡ 'lift' 'traverse' . 'to' f
+-- @
+--
+folded :: Traversable f => (s -> a) -> Fold (f s) a
+folded f = traversed . to f
+{-# INLINE folded #-}
+
+-- | Obtain a 'Fold' by lifting an operation that returns a 'Foldable' result.
+--
+-- @
+-- 'folding' ('toListOf' o) ≡ o
+-- @
+--
+-- This can be useful to lift operations from @Data.List@ and elsewhere into a 'Fold'.
+--
+-- >>> [1,2,3,4] ^.. folding tail
+-- [2,3,4]
+--
+--
+-- See 'Data.Profunctor.Optic.Property'.
+--
+folding :: Foldable f => (s -> f a) -> Fold s a
+folding f = coercer . lmap f . lift traverse_
+{-# INLINE folding #-}
+
+-- | TODO: Document
+--
+folding' :: Foldable f => Fold (f a) a
+folding' = folding id
+{-# INLINE folding' #-}
+
+-- | Build a 'Fold' from a 'View'.
+--
+toFold :: AView s a -> Fold0 s a
+toFold = to . view
+{-# INLINE toFold #-}
+
+-- | Build a monoidal 'View' from a 'Fold'.
+--
+fromFold :: Monoid a => AFold a s a -> View s a
+fromFold = cloneView
+{-# INLINE fromFold #-}
+
+---------------------------------------------------------------------
+-- 'FoldRep'
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+afold :: Monoid r => ((a -> r) -> s -> r) -> AFold r s a
+afold = between (Star . (Const .)) ((getConst .) . runStar)
+
+-- | TODO: Document
+--
+afold' :: Foldable f => AFold r (f a) a
+afold' = afold foldMap
+
+{-
+import Data.Functor.Foldable (ListF(..))
+
+fromListF :: Num a => ListF a (Sum a) -> Sum a
+fromListF Nil = mempty
+fromListF (Cons a r) = Sum a <> r
+
+foldMapOf (recursing) fromListF $ [1..5]
+Sum {getSum = 15}
+-}
+
+-- | TODO: Document
+--
+recursing :: Recursive s => AFold a s (Base s a)
+recursing = afold F.fold
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | Map parts of a structure to a monoid and combine the results.
+--
+-- @
+-- 'Data.Foldable.foldMap' = 'foldMapOf' 'folding''
+-- @
+--
+-- >>> foldMapOf both id (["foo"], ["bar", "baz"])
+-- ["foo","bar","baz"]
+--
+-- @
+-- 'foldMapOf' :: 'Iso'' s a -> (a -> r) -> s -> r
+-- 'foldMapOf' :: 'Lens'' s a -> (a -> r) -> s -> r
+-- 'foldMapOf' :: 'Monoid' r => 'Prism'' s a -> (a -> r) -> s -> r
+-- 'foldMapOf' :: 'Monoid' r => 'Traversal'' s a -> (a -> r) -> s -> r
+-- 'foldMapOf' :: 'Monoid' r => 'Traversal0'' s a -> (a -> r) -> s -> r
+-- 'foldMapOf' :: 'Monoid' r => 'Fold' s a -> (a -> r) -> s -> r
+-- 'foldMapOf' :: 'Semigroup' r => 'Fold1' s a -> (a -> r) -> s -> r
+-- @
+--
+foldMapOf :: Monoid r => AFold r s a -> (a -> r) -> s -> r
+foldMapOf = between ((getConst .) . runStar) (Star . (Const .))
+
+-- | Collect the foci of a `Fold` into a list.
+--
+toListOf :: AFold (Endo [a]) s a -> s -> [a]
+toListOf o = foldsr o (:) []
+
+-- | TODO: Document
+--
+foldOf :: Monoid a => AFold a s a -> s -> a
+foldOf = flip foldMapOf id
+
+-- ^ @
+-- toPureOf :: Fold s a -> s -> [a]
+-- toPureOf :: Applicative f => Setter s t a b -> s -> f a
+-- @
+toPureOf :: Applicative f => Monoid (f a) => AFold (f a) s a -> s -> f a
+toPureOf o = foldMapOf o pure
+
+---------------------------------------------------------------------
+-- Common 'Fold's
+---------------------------------------------------------------------
+
+-- | Compute the result of an expression in a unital semiring.
+--
+-- @
+-- 'unital' ≡ 'summed' . 'multiplied'
+-- @
+--
+-- >>> foldOf unital [[1, 2], [3, 4 :: Int]]
+-- 14
+--
+unital :: Foldable f => Foldable g => Monoid r => Semiring r => AFold r (f (g a)) a
+unital = summed . multiplied -- afold Rng.unital
+
+-- | Compute the monoidal summed of a 'Fold'.
+--
+-- >>> 1 <> 2 <> 3 <> 4 :: Int
+-- 10
+--
+-- >>> foldOf summed [1,2,3,4 :: Int]
+-- 10
+--
+summed :: Foldable f => Monoid r => AFold r (f a) a
+summed = afold foldMap
+
+-- | Compute the multiplied of a 'Fold'.
+--
+-- >>> 1 >< 2 >< 3 >< 4 :: Int
+-- 24
+--
+-- >>> foldOf multiplied [1,2,3,4 :: Int]
+-- 24
+--
+-- 'summed' and 'multiplied' compose just as they do in arithmetic:
+--
+-- >>> 1 >< 2 <> 3 >< 4 :: Int
+-- 14
+--
+-- >>> foldOf (summed . multiplied) [[1, 2], [3, (4 :: Int)]]
+-- 14
+--
+-- >>> 1 <> 2 >< 3 <> 4 :: Int
+-- 21
+--
+-- >>> foldOf (multiplied . summed) [[1, 2], [3, (4 :: Int)]]
+-- 21
+--
+multiplied :: Foldable f => Monoid r => Semiring r => AFold r (f a) a
+multiplied = afold Rng.product
+
+-- | Precompose with a Moore machine.
+--
+premapped :: Handler b a -> L.Fold a c -> L.Fold b c
+premapped o (L.Fold h z k) = L.Fold (foldsl' o h) z k
+
+-- | Precompose with an effectful Moore machine.
+--
+premappedM :: Monad m => HandlerM m b a -> L.FoldM m a c -> L.FoldM m b c
+premappedM o (L.FoldM h z k) = L.FoldM (foldsM' o h) z k
+
+---------------------------------------------------------------------
+-- Derived operators
+---------------------------------------------------------------------
+
+infixl 8 ^..
+
+-- | Infix version of 'toListOf'.
+--
+-- @
+-- 'Data.Foldable.toList' xs ≡ xs '^..' 'folded'
+-- ('^..') ≡ 'flip' 'toListOf'
+-- @
+--
+-- >>> [[1,2],[3]] ^.. id
+-- [[[1,2],[3]]]
+-- >>> [[1,2],[3]] ^.. traversed
+-- [[1,2],[3]]
+-- >>> [[1,2],[3]] ^.. traversed . traversed
+-- [1,2,3]
+--
+-- >>> (1,2) ^.. bitraversed
+-- [1,2]
+--
+-- @
+-- ('^..') :: s -> 'View' s a -> [a]
+-- ('^..') :: s -> 'Fold' s a -> [a]
+-- ('^..') :: s -> 'Lens'' s a -> [a]
+-- ('^..') :: s -> 'Iso'' s a -> [a]
+-- ('^..') :: s -> 'Traversal'' s a -> [a]
+-- ('^..') :: s -> 'Prism'' s a -> [a]
+-- ('^..') :: s -> 'Traversal0'' s a -> [a]
+-- @
+--
+(^..) :: s -> AFold (Endo [a]) s a -> [a]
+(^..) = flip toListOf
+{-# INLINE (^..) #-}
+
+-- | Right fold lift a 'Fold'.
+--
+-- >>> foldsr'' folded (<>) (zero :: Int) [1..5]
+-- 15
+--
+foldsr :: AFold (Endo r) s a -> (a -> r -> r) -> r -> s -> r
+foldsr p f r = (`appEndo` r) . foldMapOf p (Endo . f)
+
+-- | Left fold lift a 'Fold'.
+--
+foldsl :: AFold (Dual (Endo c)) s a -> (c -> a -> c) -> c -> s -> c
+foldsl p f r = (`appEndo` r) . getDual . foldMapOf p (Dual . Endo . flip f)
+
+-- | Fold lift the elements of a structure, associating to the left, but strictly.
+--
+-- @
+-- 'Data.Foldable.foldl'' ≡ 'foldsl'' 'folded'
+-- @
+--
+-- @
+-- 'foldsl'' :: 'Iso'' s a -> (c -> a -> c) -> c -> s -> c
+-- 'foldsl'' :: 'Lens'' s a -> (c -> a -> c) -> c -> s -> c
+-- 'foldsl'' :: 'View' s a -> (c -> a -> c) -> c -> s -> c
+-- 'foldsl'' :: 'Fold' s a -> (c -> a -> c) -> c -> s -> c
+-- 'foldsl'' :: 'Traversal'' s a -> (c -> a -> c) -> c -> s -> c
+-- 'foldsl'' :: 'Traversal0'' s a -> (c -> a -> c) -> c -> s -> c
+-- @
+--
+foldsl' :: AFold (Endo (Endo c)) s a -> (c -> a -> c) -> c -> s -> c
+foldsl' o f c s = foldsr o f' (Endo id) s `appEndo` c
+ where f' x (Endo k) = Endo $ \z -> k $! f z x
+{-# INLINE foldsl' #-}
+
+-- | A strict monadic left fold.
+--
+foldsM' :: Monad m => AFold (Endo (EndoM m r)) s a -> (r -> a -> m r) -> r -> s -> m r
+foldsM' o f c s = foldsr o f' mempty s `appEndoM` c
+ where f' x (EndoM k) = EndoM $ \z -> (f $! z) x >>= k
+
+-- | TODO: Document
+--
+endo :: AFold (Endo (a -> a)) s (a -> a) -> s -> a -> a
+endo o = foldsr o (.) id
+
+-- | TODO: Document
+--
+endoM :: Monad m => AFold (Endo (a -> m a)) s (a -> m a) -> s -> a -> m a
+endoM o = foldsr o (<=<) pure
+
+-- | TODO: Document
+--
+all :: AFold All s a -> (a -> Bool) -> s -> Bool
+all o p = getAll . foldMapOf o (All . p)
+
+-- | TODO: Document
+--
+any :: AFold Any s a -> (a -> Bool) -> s -> Bool
+any o p = getAny . foldMapOf o (Any . p)
+
+-- | Determine whether a `Fold` contains a given element.
+elem :: Eq a => AFold Any s a -> a -> s -> Bool
+elem p a = any p (== a)
+
+-- | Determine whether a `Fold` not contains a given element.
+notElem :: Eq a => AFold All s a -> a -> s -> Bool
+notElem p a = all p (/= a)
+
+-- | Determine whether a `Fold` has at least one focus.
+--
+has :: AFold Any s a -> s -> Bool
+has p = getAny . foldMapOf p (const (Any True))
+
+-- | Determine whether a `Fold` does not have a focus.
+--
+hasnt :: AFold All s a -> s -> Bool
+hasnt p = getAll . foldMapOf p (const (All False))
+
+-- | TODO: Document
+--
+null :: AFold All s a -> s -> Bool
+null o = all o (const False)
+
+-- | Find the minimum of a totally ordered set.
+--
+min :: Ord a => AFold (Endo (Endo a)) s a -> a -> s -> a
+min o = foldsl' o Pre.min
+
+-- | Find the maximum of a totally ordered set.
+--
+max :: Ord a => AFold (Endo (Endo a)) s a -> a -> s -> a
+max o = foldsl' o Pre.max
+
+-- | Find the (partial) minimum of a partially ordered set.
+--
+pmin :: Eq a => Prd a => AFold (Endo (EndoM Maybe a)) s a -> a -> s -> Maybe a
+pmin o = foldsM' o Prd.pmin
+
+-- | Find the (partial) minimum of a partially ordered set.
+--
+pmax :: Eq a => Prd a => AFold (Endo (EndoM Maybe a)) s a -> a -> s -> Maybe a
+pmax o = foldsM' o Prd.pmax
+
+-- | Find the (partial) join of a sublattice.
+--
+join :: Lattice a => AFold (Endo (Endo a)) s a -> a -> s -> a
+join o = foldsl' o (\/)
+
+-- | Find the join of a sublattice or return the bottom element.
+--
+join' :: Lattice a => Min a => AFold (Endo (Endo a)) s a -> s -> a
+join' o = join o minimal
+
+-- | Find the (partial) meet of a sublattice.
+--
+meet :: Lattice a => AFold (Endo (Endo a)) s a -> a -> s -> a
+meet o = foldsl' o (/\)
+
+-- | Find the meet of a sublattice or return the top element.
+--
+meet' :: Lattice a => Max a => AFold (Endo (Endo a)) s a -> s -> a
+meet' o = meet o maximal
diff --git a/src/Data/Profunctor/Optic/Fold0.hs b/src/Data/Profunctor/Optic/Fold0.hs
new file mode 100644
index 0000000..403d9dd
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Fold0.hs
@@ -0,0 +1,166 @@
+module Data.Profunctor.Optic.Fold0 where
+
+import Control.Monad.Reader as Reader
+import Control.Monad.State as State
+import Data.Maybe
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Optic.Prism (_Just)
+import Data.Profunctor.Optic.Type
+import Data.Profunctor.Optic.View (to)
+
+---------------------------------------------------------------------
+-- 'Fold0'
+---------------------------------------------------------------------
+
+-- | Build a 'Fold0' from an arbitrary function.
+--
+-- @
+-- 'fold0' ('toMaybeOf' o) ≡ o
+-- 'fold0' ('view' o) ≡ o . '_Just'
+-- @
+--
+-- >>> [Just 1, Nothing] ^.. folding id . fold0 id
+-- [1]
+--
+fold0 :: (s -> Maybe a) -> Fold0 s a
+fold0 f = to (\s -> maybe (Left s) Right (f s)) . pright
+{-# INLINE fold0 #-}
+
+infixl 3 `failing` -- Same as (<|>)
+
+-- | Try the first 'Fold0'. If it returns no entry, try the second one.
+--
+failing :: AFold0 a s a -> AFold0 a s a -> Fold0 s a
+failing a b = fold0 $ \s -> maybe (preview b s) Just (preview a s)
+{-# INLINE failing #-}
+
+-- | Build a 'Fold0' from a 'View'.
+--
+-- @
+-- 'toFold0' o ≡ o . '_Just'
+-- 'toFold0' o ≡ 'fold0' ('view' o)
+-- @
+--
+toFold0 :: View s (Maybe a) -> Fold0 s a
+toFold0 = (. _Just)
+{-# INLINE toFold0 #-}
+
+-- | Build a 'View' from a 'Fold0'
+--
+fromFold0 :: Monoid a => AFold0 a s a -> View s (Maybe a)
+fromFold0 = to . preview
+{-# INLINE fromFold0 #-}
+
+---------------------------------------------------------------------
+-- 'Fold0Rep'
+---------------------------------------------------------------------
+
+newtype Fold0Rep r a b = Fold0Rep { runFold0Rep :: a -> Maybe r }
+
+type AFold0 r s a = Optic' (Fold0Rep r) s a
+
+instance Functor (Fold0Rep r a) where
+ fmap _ (Fold0Rep p) = Fold0Rep p
+
+instance Contravariant (Fold0Rep r a) where
+ contramap _ (Fold0Rep p) = Fold0Rep p
+
+instance Profunctor (Fold0Rep r) where
+ dimap f _ (Fold0Rep p) = Fold0Rep (p . f)
+
+instance Choice (Fold0Rep r) where
+ left' (Fold0Rep p) = Fold0Rep (either p (const Nothing))
+ right' (Fold0Rep p) = Fold0Rep (either (const Nothing) p)
+
+instance Cochoice (Fold0Rep r) where
+ unleft (Fold0Rep k) = Fold0Rep (k . Left)
+ unright (Fold0Rep k) = Fold0Rep (k . Right)
+
+instance Strong (Fold0Rep r) where
+ first' (Fold0Rep p) = Fold0Rep (p . fst)
+ second' (Fold0Rep p) = Fold0Rep (p . snd)
+
+instance Sieve (Fold0Rep r) (Pre r) where
+ sieve = (Pre .) . runFold0Rep
+
+instance Representable (Fold0Rep r) where
+ type Rep (Fold0Rep r) = Pre r
+ tabulate = Fold0Rep . (getPre .)
+ {-# INLINE tabulate #-}
+
+-- | 'Pre' is 'Maybe' with a phantom type variable.
+--
+newtype Pre a b = Pre { getPre :: Maybe a } deriving (Eq, Ord, Show)
+
+instance Functor (Pre a) where fmap _ (Pre p) = Pre p
+
+instance Contravariant (Pre a) where contramap _ (Pre p) = Pre p
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+previewOf :: Optic' (Fold0Rep r) s a -> (a -> Maybe r) -> s -> Maybe r
+previewOf = between runFold0Rep Fold0Rep
+
+-- | TODO: Document
+--
+toMaybeOf :: AFold0 a s a -> s -> Maybe a
+toMaybeOf = flip previewOf Just
+
+---------------------------------------------------------------------
+-- Derived operators
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+preview :: MonadReader s m => AFold0 a s a -> m (Maybe a)
+preview o = Reader.asks $ toMaybeOf o
+
+-- | TODO: Document
+--
+preuse :: MonadState s m => AFold0 a s a -> m (Maybe a)
+preuse o = State.gets $ preview o
+
+infixl 8 ^?
+
+-- | An infix variant of 'preview''.
+--
+-- @
+-- ('^?') ≡ 'flip' 'preview''
+-- @
+--
+-- Perform a safe 'head' of a 'Fold' or 'Traversal' or retrieve 'Just'
+-- the result from a 'View' or 'Lens'.
+--
+-- When using a 'Traversal' as a partial 'Lens', or a 'Fold' as a partial
+-- 'View' this can be a convenient way to extract the optional value.
+--
+-- >>> Left 4 ^? _L
+-- Just 4
+--
+-- >>> Right 4 ^? _L
+-- Nothing
+--
+(^?) :: s -> AFold0 a s a -> Maybe a
+s ^? o = toMaybeOf o s
+
+-- | Check to see if this 'Fold0' doesn't match.
+--
+-- >>> is _Just Nothing
+-- False
+--
+is :: AFold0 a s a -> s -> Bool
+is k s = isJust (preview k s)
+{-# INLINE is #-}
+
+-- | Check to see if this 'Fold0' doesn't match.
+--
+-- >>> isnt _Just Nothing
+-- True
+--
+isnt :: AFold0 a s a -> s -> Bool
+isnt k s = not (isJust (preview k s))
+{-# INLINE isnt #-}
diff --git a/src/Data/Profunctor/Optic/Grate.hs b/src/Data/Profunctor/Optic/Grate.hs
new file mode 100644
index 0000000..3f486be
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Grate.hs
@@ -0,0 +1,180 @@
+
+module Data.Profunctor.Optic.Grate where
+
+import Control.Monad.Reader
+import Control.Monad.Cont
+import Control.Monad.IO.Unlift
+import Data.Distributive
+import Data.Profunctor.Optic.Iso
+import Data.Profunctor.Optic.Type
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Rep (unfirstCorep)
+import qualified Data.Functor.Rep as F
+import qualified Control.Exception as Ex
+
+---------------------------------------------------------------------
+-- 'Grate'
+---------------------------------------------------------------------
+
+-- | Build a 'Grate' from a nested continuation.
+--
+-- \( \quad \mathsf{Grate}\;S\;A = \exists I, S \cong I \to A \)
+--
+-- The resulting optic is the corepresentable counterpart to 'Lens', and sits between 'Iso' and 'Setter'.
+--
+-- See <https://www.cs.ox.ac.uk/jeremy.gibbons/publications/proyo.pdf> section 4.6
+--
+-- /Caution/: In order for the 'Grate' to be well-defined, you must ensure that the two grate laws hold:
+--
+-- * @grate ($ s) ≡ s@
+--
+-- * @grate (\k -> h (k . sabt)) ≡ sabt (\k -> h ($ k))@
+--
+-- See 'Data.Profunctor.Optic.Property'.
+--
+grate :: (((s -> a) -> b) -> t) -> Grate s t a b
+grate sabt = dimap (flip ($)) sabt . closed
+
+-- | Construct a 'Grate' from a pair of inverses.
+--
+inverting :: (s -> a) -> (b -> t) -> Grate s t a b
+inverting sa bt = grate $ \sab -> bt (sab sa)
+
+-- | TODO: Document
+--
+cloneGrate :: AGrate s t a b -> Grate s t a b
+cloneGrate k = withGrate k grate
+
+---------------------------------------------------------------------
+-- 'GrateRep'
+---------------------------------------------------------------------
+
+-- | The 'GrateRep' profunctor precisely characterizes 'Grate'.
+--
+newtype GrateRep a b s t = GrateRep { unGrateRep :: ((s -> a) -> b) -> t }
+
+type AGrate s t a b = Optic (GrateRep a b) s t a b
+
+type AGrate' s a = AGrate s s a a
+
+instance Profunctor (GrateRep a b) where
+ dimap f g (GrateRep z) = GrateRep $ \d -> g (z $ \k -> d (k . f))
+
+instance Closed (GrateRep a b) where
+ closed (GrateRep z) = GrateRep $ \f x -> z $ \k -> f $ \g -> k (g x)
+
+instance Costrong (GrateRep a b) where
+ unfirst = unfirstCorep
+
+instance Cosieve (GrateRep a b) (PCont a b) where
+ cosieve (GrateRep f) (PCont g) = f g
+
+instance Corepresentable (GrateRep a b) where
+ type Corep (GrateRep a b) = PCont a b
+
+ cotabulate f = GrateRep $ f . PCont
+
+reviewGrate :: GrateRep a b s t -> b -> t
+reviewGrate (GrateRep e) b = e (const b)
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | TODO: Document, replace with GrateLike
+--
+withGrate :: AGrate s t a b -> ((((s -> a) -> b) -> t) -> r) -> r
+withGrate x k = case x (GrateRep $ \f -> f id) of GrateRep sabt -> k sabt
+
+-- | Set all fields to the given value.
+--
+constOf :: AGrate s t a b -> b -> t
+constOf x b = withGrate x $ \grt -> grt (const b)
+
+-- | Zip over a 'Grate'.
+--
+-- @\f -> zipWithOf closed (zipWithOf closed f) === zipWithOf (closed . closed)@
+--
+zipWithOf :: AGrate s t a b -> (a -> a -> b) -> s -> s -> t
+zipWithOf x comb s1 s2 = withGrate x $ \grt -> grt $ \get -> comb (get s1) (get s2)
+
+-- | Zip over a 'Grate'.
+--
+zip3WithOf :: AGrate s t a b -> (a -> a -> a -> b) -> (s -> s -> s -> t)
+zip3WithOf x comb s1 s2 s3 = withGrate x $ \grt -> grt $ \get -> comb (get s1) (get s2) (get s3)
+
+-- | Zip over a 'Grate'.
+--
+zip4WithOf :: AGrate s t a b -> (a -> a -> a -> a -> b) -> (s -> s -> s -> s -> t)
+zip4WithOf x comb s1 s2 s3 s4 = withGrate x $ \grt -> grt $ \get -> comb (get s1) (get s2) (get s3) (get s4)
+
+-- | Transform a profunctor grate into a Van Laarhoven grate.
+--
+-- This is a more restricted version of 'cotraverseOf'
+--
+zipFWithOf :: Functor f => AGrate s t a b -> (f a -> b) -> f s -> t
+zipFWithOf x comb fs = withGrate x $ \grt -> grt $ \get -> comb (fmap get fs)
+
+---------------------------------------------------------------------
+-- Common grates
+---------------------------------------------------------------------
+
+-- | Access the contents of a distributive functor.
+--
+distributed :: Distributive f => Grate (f a) (f b) a b
+distributed = grate $ \f -> cotraverse f id
+
+-- | A 'Grate' accessing the contents of a representable functor.
+--
+represented :: F.Representable f => Grate (f a) (f b) a b
+represented = dimap F.index F.tabulate . closed
+
+-- | TODO: Document
+--
+applied :: Grate a (b -> c) (a , b) c
+applied = lmap (,) . closed
+
+-- | Provide an initial value to a 'Semigroup'.
+--
+pointed :: Semigroup a => a -> Grate' a a
+pointed = parametrized (<>)
+
+-- | Depend on a silent configuration parameter.
+--
+-- >>> zipWithOf (parametrized (+) 1) (*) 2 2
+-- 9
+--
+parametrized :: (x -> a -> a) -> x -> Grate' a a
+parametrized f x = dimap (flip f) ($ x) . closed
+
+-- | TODO: Document
+--
+masked :: MonadUnliftIO m => Grate (m a) (m b) (m a) (m b)
+masked = grate mask
+ where
+ mask f = withRunInIO $ \run -> Ex.mask $ \unmask -> run $ f $ liftIO . unmask . run
+
+-- | TODO: Document
+--
+unlifted :: MonadUnliftIO m => Grate (m a) (m b) (IO a) (IO b)
+unlifted = grate withRunInIO
+
+-- | Access the range of a 'ReaderT'.
+--
+forwarded :: Distributive m => Grate (ReaderT r m a) (ReaderT r m b) a b
+forwarded = distributed
+
+-- | TODO: Document
+--
+continued :: Grate a (Cont r a) r r
+continued = grate cont
+
+-- | Translate between different 'Star's.
+--
+starred :: Grate (Star f a b) (Star g s t) (a -> f b) (s -> g t)
+starred = grate $ \o -> Star $ o runStar
+
+-- | Translate between different 'Costar's.
+--
+costarred :: Grate (Costar f a b) (Costar g s t) (f a -> b) (g s -> t)
+costarred = grate $ \o -> Costar $ o runCostar
diff --git a/src/Data/Profunctor/Optic/Iso.hs b/src/Data/Profunctor/Optic/Iso.hs
new file mode 100644
index 0000000..2001ac5
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Iso.hs
@@ -0,0 +1,278 @@
+module Data.Profunctor.Optic.Iso where
+
+import Control.Monad (join)
+import Data.Foldable
+import Data.Maybe (fromMaybe)
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Optic.Type
+
+---------------------------------------------------------------------
+-- 'Equality'
+---------------------------------------------------------------------
+
+-- | Constrain excessive polymorphism.
+--
+-- e.g turn an 'Optic' into an 'Optic'':
+--
+-- @
+-- foo . (simple :: As Int) . bar
+-- @
+--
+simple :: As a
+simple = id
+
+---------------------------------------------------------------------
+-- 'Iso'
+---------------------------------------------------------------------
+
+-- | Build an 'Iso' invert two inverses.
+--
+-- /Caution/: In order for the generated iso family to be well-defined,
+-- you must ensure that the two isomorphism laws hold:
+--
+-- * @sa . bt ≡ id@
+--
+-- * @bt . sa ≡ id@
+--
+iso :: (s -> a) -> (b -> t) -> Iso s t a b
+iso = dimap
+
+-- | Invert an isomorphism.
+--
+-- @
+-- 'invert' ('invert' l) ≡ l
+-- @
+--
+invert :: AIso s t a b -> Iso b a t s
+invert l = withIso l $ \sa bt -> iso bt sa
+{-# INLINE invert #-}
+
+-- | Convert invert 'AIso' back to any 'Iso'.
+cloneIso :: AIso s t a b -> Iso s t a b
+cloneIso k = withIso k iso
+{-# INLINE cloneIso #-}
+
+---------------------------------------------------------------------
+-- 'IsoRep'
+---------------------------------------------------------------------
+
+-- | The 'IsoRep' profunctor precisely characterizes an 'Iso'.
+data IsoRep a b s t = IsoRep (s -> a) (b -> t)
+
+-- | When you see this as an argument to a function, it expects an 'Iso'.
+type AIso s t a b = Optic (IsoRep a b) s t a b
+
+type AIso' s a = AIso s s a a
+
+instance Functor (IsoRep a b s) where
+ fmap f (IsoRep sa bt) = IsoRep sa (f . bt)
+ {-# INLINE fmap #-}
+
+instance Profunctor (IsoRep a b) where
+ dimap f g (IsoRep sa bt) = IsoRep (sa . f) (g . bt)
+ {-# INLINE dimap #-}
+ lmap f (IsoRep sa bt) = IsoRep (sa . f) bt
+ {-# INLINE lmap #-}
+ rmap f (IsoRep sa bt) = IsoRep sa (f . bt)
+ {-# INLINE rmap #-}
+
+instance Sieve (IsoRep a b) (PStore a b) where
+ sieve (IsoRep sa bt) s = PStore (sa s) bt
+
+instance Cosieve (IsoRep a b) (PCont a b) where
+ cosieve (IsoRep sa bt) (PCont sab) = bt (sab sa)
+
+data PStore a b t = PStore a (b -> t)
+
+values :: PStore a b t -> b -> t
+values (PStore _ bt) = bt
+
+info :: PStore a b t -> a
+info (PStore a _) = a
+
+instance Functor (PStore a b) where
+ fmap f (PStore a bt) = PStore a (f . bt)
+ {-# INLINE fmap #-}
+
+instance Profunctor (PStore a) where
+ dimap f g (PStore a bt) = PStore a (g . bt . f)
+ {-# INLINE dimap #-}
+
+instance a ~ b => Foldable (PStore a b) where
+ foldMap f (PStore b bt) = f . bt $ b
+
+newtype PCont a b s = PCont { runPCont :: (s -> a) -> b }
+
+instance Functor (PCont a b) where
+ fmap st (PCont sab) = PCont $ \ta -> sab (ta . st)
+
+runPCont' :: PCont a b a -> b
+runPCont' (PCont f) = f id
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | Extract the two functions, one invert @s -> a@ and
+-- one invert @b -> t@ that characterize an 'Iso'.
+withIso :: AIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
+withIso x k = case x (IsoRep id id) of IsoRep sa bt -> k sa bt
+{-# INLINE withIso #-}
+
+cycleOf :: AIso s t a b -> (t -> s) -> b -> a
+cycleOf x = withIso x $ \sa bt ts -> sa . ts . bt
+
+au :: AIso s t a b -> ((b -> t) -> e -> s) -> e -> a
+au l = withIso l $ \sa bt f e -> sa (f bt e)
+
+auf :: Profunctor p => AIso s t a b -> (p r a -> e -> b) -> p r s -> e -> t
+auf l = withIso l $ \sa bt f g e -> bt (f (rmap sa g) e)
+
+---------------------------------------------------------------------
+-- Common isos
+---------------------------------------------------------------------
+
+flipped :: Iso (a -> b -> c) (d -> e -> f) (b -> a -> c) (e -> d -> f)
+flipped = iso flip flip
+
+curried :: Iso ((a , b) -> c) ((d , e) -> f) (a -> b -> c) (d -> e -> f)
+curried = iso curry uncurry
+
+-- | Given a function that is its own inverse, this gives you an 'Iso' using it in both directions.
+--
+-- @
+-- 'involuted' ≡ 'Control.Monad.join' 'iso'
+-- @
+--
+-- >>> "live" ^. involuted reverse
+-- "evil"
+--
+-- >>> involuted reverse %~ ('d':) $ "live"
+-- "lived"
+--
+involuted :: (s -> a) -> Iso s a a s
+involuted = join iso
+{-# INLINE involuted #-}
+
+hushed :: Iso (Maybe a) (Maybe b) (() + a) (() + b)
+hushed = iso (maybe (Left ()) Right) (const Nothing ||| Just)
+
+duped :: Iso (Bool -> a) (Bool -> b) (a , a) (b , b)
+duped = iso to fro
+ where
+ to f = (f False, f True)
+ fro p True = fst p
+ fro p False = snd p
+
+coduped :: Iso (Bool , a) (Bool , b) (a + a) (b + b)
+coduped = iso f ((,) False ||| (,) True)
+ where
+ f (False,a) = Left a
+ f (True,a) = Right a
+
+-- | Remove a single value invert a type.
+--
+non :: Eq a => a -> Iso' (Maybe a) a
+non def = iso (fromMaybe def) g
+ where g a | a == def = Nothing
+ | otherwise = Just a
+
+-- | @'anon' a p@ generalizes @'non' a@ to take any value and a predicate.
+--
+-- This function assumes that @p a@ holds @'True'@ and generates an isomorphism between @'Maybe' (a | 'not' (p a))@ and @a@.
+--
+-- >>> Map.empty & at "hello" . anon Map.empty Map.null . at "world" ?~ "!!!"
+-- invertList [("hello",invertList [("world","!!!")])]
+--
+-- >>> invertList [("hello",invertList [("world","!!!")])] & at "hello" . anon Map.empty Map.null . at "world" .~ Nothing
+-- invertList []
+--
+anon :: a -> (a -> Bool) -> Iso' (Maybe a) a
+anon a p = iso (fromMaybe a) go where
+ go b | p b = Nothing
+ | otherwise = Just b
+{-# INLINE anon #-}
+
+liftF
+ :: Functor f
+ => Functor g
+ => AIso s t a b
+ -> Iso (f s) (g t) (f a) (g b)
+liftF l = withIso l $ \sa bt -> iso (fmap sa) (fmap bt)
+
+liftP
+ :: Profunctor p
+ => Profunctor q
+ => AIso s1 t1 a1 b1
+ -> AIso s2 t2 a2 b2
+ -> Iso (p a1 s2) (q b1 t2) (p s1 a2) (q t1 b2)
+liftP f g =
+ withIso f $ \sa1 bt1 ->
+ withIso g $ \sa2 bt2 ->
+ iso (dimap sa1 sa2) (dimap bt1 bt2)
+
+lift2 :: AIso s t a b -> Iso (c , s) (d , t) (c , a) (d , b)
+lift2 x = withIso x $ \sa bt -> between runPaired Paired (dimap sa bt)
+
+liftR :: AIso s t a b -> Iso (c + s) (d + t) (c + a) (d + b)
+liftR x = withIso x $ \sa bt -> between runSplit Split (dimap sa bt)
+
+---------------------------------------------------------------------
+-- 'Paired'
+---------------------------------------------------------------------
+
+newtype Paired p c d a b = Paired { runPaired :: p (c , a) (d , b) }
+
+--fromTambara :: Profunctor p => Tambara p a b -> Paired p d d a b
+--fromTambara = Paired . swapped . runTambara
+
+instance Profunctor p => Profunctor (Paired p c d) where
+ dimap f g (Paired pab) = Paired $ dimap (fmap f) (fmap g) pab
+
+instance Strong p => Strong (Paired p c d) where
+ second' (Paired pab) = Paired . dimap shuffle shuffle . second' $ pab
+ where
+ shuffle (x,(y,z)) = (y,(x,z))
+
+-- ^ @
+-- paired :: Iso s t a b -> Iso s' t' a' b' -> Iso (s, s') (t, t') (a, a') (b, b')
+-- paired :: Lens s t a b -> Lens s' t' a' b' -> Lens (s, s') (t, t') (a, a') (b, b')
+-- @
+--
+paired
+ :: Profunctor p
+ => Optic (Paired p s2 t2) s1 t1 a1 b1
+ -> Optic (Paired p a1 b1) s2 t2 a2 b2
+ -> Optic p (s1 , s2) (t1 , t2) (a1 , a2) (b1 , b2)
+paired x y =
+ dimap swp swp . runPaired . x . Paired . dimap swp swp . runPaired . y . Paired
+
+---------------------------------------------------------------------
+-- 'Split'
+---------------------------------------------------------------------
+
+newtype Split p c d a b = Split { runSplit :: p (Either c a) (Either d b) }
+
+--fromTambaraSum :: Profunctor p => TambaraSum p a b -> Split p d d a b
+--fromTambaraSum = Split . swapped . runTambaraSum
+
+instance Profunctor p => Profunctor (Split p c d) where
+ dimap f g (Split pab) = Split $ dimap (fmap f) (fmap g) pab
+
+instance Choice p => Choice (Split p c d) where
+ right' (Split pab) = Split . dimap shuffle shuffle . right' $ pab
+ where
+ shuffle = Right . Left ||| (Left ||| Right . Right)
+
+-- ^ @
+-- split :: Iso s t a b -> Iso s' t' a' b' -> Iso (Either s s') (Either t t') (Either a a') (Either b b')
+-- split :: Prism s t a b -> Prism s' t' a' b' -> Lens (Either s s') (Either t t') (Either a a') (Either b b')
+-- split :: View s t a b -> View s' t' a' b' -> Review (Either s s') (Either t t') (Either a a') (Either b b')
+-- @
+split
+ :: Profunctor p
+ => Optic (Split p s2 t2) s1 t1 a1 b1
+ -> Optic (Split p a1 b1) s2 t2 a2 b2
+ -> Optic p (s1 + s2) (t1 + t2) (a1 + a2) (b1 + b2)
+split x y =
+ dimap swp' swp' . runSplit . x . Split . dimap swp' swp' . runSplit . y . Split
diff --git a/src/Data/Profunctor/Optic/Lens.hs b/src/Data/Profunctor/Optic/Lens.hs
new file mode 100644
index 0000000..f83678c
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Lens.hs
@@ -0,0 +1,198 @@
+module Data.Profunctor.Optic.Lens where
+
+import Data.Profunctor.Optic.Iso
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Optic.Type
+import Data.Void (Void, absurd)
+import Foreign.C.Types
+import GHC.IO.Exception
+import System.IO
+import qualified Control.Foldl as F
+
+-- $setup
+-- >>> :set -XNoOverloadedStrings
+-- >>> :m + Control.Exception
+-- >>> :m + Data.Profunctor.Optic
+
+---------------------------------------------------------------------
+-- 'Lens'
+---------------------------------------------------------------------
+
+-- | Build a 'Strong' optic from a getter and setter.
+--
+-- \( \quad \mathsf{Lens}\;S\;A = \exists C, S \cong C \times A \)
+--
+-- /Caution/: In order for the generated lens family to be well-defined,
+-- you must ensure that the three lens laws hold:
+--
+-- * @sa (sbt s a) ≡ a@
+--
+-- * @sbt s (sa s) ≡ s@
+--
+-- * @sbt (sbt s a1) a2 ≡ sbt s a2@
+--
+-- See 'Data.Profunctor.Optic.Property'.
+--
+lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
+lens sa sbt = dimap (id &&& sa) (uncurry sbt) . psecond
+
+-- | Build a 'Lens' from its free tensor representation.
+--
+matching :: (s -> (x , a)) -> ((x , b) -> t) -> Lens s t a b
+matching f g = dimap f g . psecond
+
+-- | Transform a Van Laarhoven lens into a profunctor lens.
+--
+vllens :: (forall f. Functor f => (a -> f b) -> s -> f t) -> Lens s t a b
+vllens o = dimap ((info &&& values) . o (flip PStore id)) (uncurry id . swp) . pfirst
+
+-- | Build a 'Costrong' optic from a getter and setter.
+--
+-- * @relens f g ≡ \f g -> re (lens f g)@
+--
+-- * @review $ relens f g ≡ f@
+--
+-- * @set . re $ re (lens f g) ≡ g@
+--
+-- A 'Relens' is a 'Review', so you can specialise types to obtain:
+--
+-- @ 'review' :: 'Relens'' s a -> a -> s @
+--
+relens :: (b -> t) -> (b -> s -> a) -> Relens s t a b
+relens sa sbt = unsecond . dimap (uncurry sbt) (id &&& sa)
+
+-- | TODO: Document
+--
+cloneLens :: ALens s t a b -> Lens s t a b
+cloneLens o = withLens o lens
+
+---------------------------------------------------------------------
+-- 'LensRep'
+---------------------------------------------------------------------
+
+-- | The `LensRep` profunctor precisely characterizes a 'Lens'.
+data LensRep a b s t = LensRep (s -> a) (s -> b -> t)
+
+type ALens s t a b = Optic (LensRep a b) s t a b
+
+type ALens' s a = ALens s s a a
+
+instance Profunctor (LensRep a b) where
+
+ dimap f g (LensRep sa sbt) = LensRep (sa . f) (\s -> g . sbt (f s))
+
+instance Strong (LensRep a b) where
+
+ first' (LensRep sa sbt) =
+ LensRep (\(a, _) -> sa a) (\(s, c) b -> ((sbt s b), c))
+
+ second' (LensRep sa sbt) =
+ LensRep (\(_, a) -> sa a) (\(c, s) b -> (c, (sbt s b)))
+
+instance Sieve (LensRep a b) (PStore a b) where
+ sieve (LensRep sa sbt) s = PStore (sa s) (sbt s)
+
+instance Representable (LensRep a b) where
+ type Rep (LensRep a b) = PStore a b
+
+ tabulate f = LensRep (\s -> info (f s)) (\s -> values (f s))
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+withLens :: ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
+withLens l f = case l (LensRep id $ \_ b -> b) of LensRep x y -> f x y
+
+-- | Analogous to @(***)@ from 'Control.Arrow'
+--
+pairing :: Lens s1 t1 a1 b1 -> Lens s2 t2 a2 b2 -> Lens (s1 , s2) (t1 , t2) (a1 , a2) (b1 , b2)
+pairing = paired
+
+-- | TODO: Document
+--
+lens2 :: (s -> a) -> (s -> b -> t) -> Lens (c, s) (d, t) (c, a) (d, b)
+lens2 f g = between runPaired Paired (lens f g)
+
+---------------------------------------------------------------------
+-- Common lenses
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+_1 :: Lens (a , c) (b , c) a b
+_1 = pfirst
+
+-- | TODO: Document
+--
+_2 :: Lens (c , a) (c , b) a b
+_2 = psecond
+
+-- | TODO: Document
+--
+lower1 :: Iso s t (a , x) (b , x) -> Lens s t a b
+lower1 = (. _1)
+
+-- | TODO: Document
+--
+lower2 :: Iso s t (x , a) (x , b) -> Lens s t a b
+lower2 = (. _2)
+
+-- | There is a `Unit` in everything.
+--
+unit :: Lens' a ()
+unit = lens (const ()) const
+
+-- | There is everything in a `Void`.
+--
+void :: Lens' Void a
+void = lens absurd const
+
+-- | TODO: Document
+--
+ix :: Eq k => k -> Lens' (k -> v) v
+ix k = lens ($ k) (\g v' x -> if (k == x) then v' else g x)
+
+-- | TODO: Document
+--
+foldedl :: Lens s s a b -> s -> F.Fold b a
+foldedl o x = withLens o $ \sa sbt -> F.Fold sbt x sa
+
+-- | TODO: Document
+--
+uncurried :: Lens (a , b) c a (b -> c)
+uncurried = rmap apply . pfirst
+
+----------------------------------------------------------------------------------------------------
+-- IO Exceptions
+----------------------------------------------------------------------------------------------------
+
+-- | Where the error happened.
+--
+location :: Lens' IOException String
+location = lens ioe_location $ \s e -> s { ioe_location = e }
+
+-- | Error type specific information.
+--
+description :: Lens' IOException String
+description = lens ioe_description $ \s e -> s { ioe_description = e }
+
+-- | The handle used by the action flagging this error.
+--
+handle :: Lens' IOException (Maybe Handle)
+handle = lens ioe_handle $ \s e -> s { ioe_handle = e }
+
+-- | 'fileName' the error is related to.
+--
+fileName :: Lens' IOException (Maybe FilePath)
+fileName = lens ioe_filename $ \s e -> s { ioe_filename = e }
+
+-- | 'errno' leading to this error, if any.
+--
+errno :: Lens' IOException (Maybe CInt)
+errno = lens ioe_errno $ \s e -> s { ioe_errno = e }
+
+errorType :: Lens' IOException IOErrorType
+errorType = lens ioe_type $ \s e -> s { ioe_type = e }
diff --git a/src/Data/Profunctor/Optic/Operator.hs b/src/Data/Profunctor/Optic/Operator.hs
new file mode 100644
index 0000000..5afea04
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Operator.hs
@@ -0,0 +1,18 @@
+module Data.Profunctor.Optic.Operator (
+ module Ops
+ , module Misc
+) where
+
+import Data.Function as Ops ((&))
+import Data.Profunctor.Optic.Type as Ops (re)
+import Data.Profunctor.Optic.Iso as Ops (simple, paired, split)
+import Data.Profunctor.Optic.View as Ops ((#), (^.), view, review)
+import Data.Profunctor.Optic.Setter as Ops ((%), (.~), (%~), set, sets, over)
+import Data.Profunctor.Optic.Grate as Ops (constOf, zipWithOf)
+import Data.Profunctor.Optic.Traversal0 as Ops (matchOf, isMatched)
+import Data.Profunctor.Optic.Fold as Ops ((^..), foldMapOf)
+import Data.Profunctor.Optic.Fold0 as Ops ((^?), preview, preuse)
+import Data.Profunctor.Optic.Cofold as Ops (cofoldMapOf)
+import Data.Profunctor.Optic.Traversal as Ops (traverseOf, sequenceOf)
+import Data.Profunctor.Optic.Cotraversal as Ops (cotraverseOf)
+import Data.Profunctor.Misc as Misc
diff --git a/src/Data/Profunctor/Optic/Prelude.hs b/src/Data/Profunctor/Optic/Prelude.hs
new file mode 100644
index 0000000..c551276
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Prelude.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Data.Profunctor.Optic.Prelude (
+ module Export
+) where
+
+import Control.Arrow as Export ((|||),(&&&),(+++),(***))
+import Control.Comonad as Export (Cokleisli(..))
+import Control.Applicative as Export (liftA2, Alternative(..))
+import Control.Category as Export
+import Control.Monad as Export hiding (void)
+import Control.Comonad as Export
+import Data.Bifunctor as Export (Bifunctor (..))
+import Data.Distributive as Export
+import Data.Function as Export ((&))
+import Data.Functor as Export hiding (void)
+import Data.Functor.Const as Export
+import Data.Functor.Compose as Export
+import Data.Functor.Contravariant as Export
+import Data.Functor.Contravariant.Divisible as Export
+import Data.Functor.Identity as Export
+import Data.Profunctor.Types as Export
+import Data.Profunctor.Misc as Export
+import Data.Void as Export
+import Prelude as Export hiding (Foldable(..), (.), id, all, any, min, max, head, tail)
diff --git a/src/Data/Profunctor/Optic/Prism.hs b/src/Data/Profunctor/Optic/Prism.hs
new file mode 100644
index 0000000..5d55302
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Prism.hs
@@ -0,0 +1,523 @@
+module Data.Profunctor.Optic.Prism where
+
+import Control.Exception
+import Control.Monad (guard)
+import Data.Profunctor.Optic.Iso
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Optic.Type
+import GHC.IO.Exception
+import qualified Control.Exception as Ex
+
+---------------------------------------------------------------------
+-- 'Prism'
+---------------------------------------------------------------------
+
+-- | Build a 'Choice' optic from a constructor and a matcher function.
+--
+-- \( \quad \mathsf{Prism}\;S\;A = \exists D, S \cong D + A \)
+--
+-- /Caution/: In order for the generated prism family to be well-defined,
+-- you must ensure that the three prism laws hold:
+--
+-- * @seta (bt b) ≡ Right b@
+--
+-- * @(id ||| bt) (seta s) ≡ s@
+--
+-- * @left seta (seta s) ≡ left Left (seta s)@
+--
+-- See 'Data.Profunctor.Optic.Property'.
+--
+prism :: (s -> t + a) -> (b -> t) -> Prism s t a b
+prism seta bt = dimap seta (id ||| bt) . pright
+
+-- | Create a 'Prism' from a reviewer and a matcher function that produces a 'Maybe'.
+--
+prism' :: (s -> Maybe a) -> (a -> s) -> Prism' s a
+prism' sma as = flip prism as $ \s -> maybe (Left s) Right (sma s)
+
+-- | Build a 'Prism' from its free tensor representation.
+--
+-- Useful for constructing prisms from try and handle functions.
+--
+handling :: (s -> e + a) -> (e + b -> t) -> Prism s t a b
+handling sea ebt = dimap sea ebt . pright
+
+-- | Build a 'Cochoice' optic from a constructor and a matcher function.
+--
+-- * @reprism f g ≡ \f g -> re (prism f g)@
+--
+-- * @view . re $ prism bat _ ≡ bat@
+--
+-- * @matchOf . re . re $ prism _ sa ≡ sa@
+--
+-- A 'Reprism' is a 'View', so you can specialise types to obtain:
+--
+-- @ view :: 'Reprism'' s a -> s -> a @
+--
+reprism :: (b -> a + t) -> (s -> a) -> Reprism s t a b
+reprism beat sa = unright . dimap (id ||| sa) beat
+
+-- | TODO: Document
+--
+clonePrism :: APrism s t a b -> Prism s t a b
+clonePrism o = withPrism o prism
+
+---------------------------------------------------------------------
+-- 'PrismRep'
+---------------------------------------------------------------------
+
+type APrism s t a b = Optic (PrismRep a b) s t a b
+
+type APrism' s a = APrism s s a a
+
+-- | The 'PrismRep' profunctor precisely characterizes a 'Prism'.
+data PrismRep a b s t = PrismRep (s -> t + a) (b -> t)
+
+instance Functor (PrismRep a b s) where
+
+ fmap f (PrismRep seta bt) = PrismRep (either (Left . f) Right . seta) (f . bt)
+ {-# INLINE fmap #-}
+
+instance Profunctor (PrismRep a b) where
+
+ dimap f g (PrismRep seta bt) = PrismRep (either (Left . g) Right . seta . f) (g . bt)
+ {-# INLINE dimap #-}
+
+ lmap f (PrismRep seta bt) = PrismRep (seta . f) bt
+ {-# INLINE lmap #-}
+
+ rmap f (PrismRep seta bt) = PrismRep (either (Left . f) Right . seta) (f . bt)
+ {-# INLINE rmap #-}
+
+instance Choice (PrismRep a b) where
+
+ left' (PrismRep seta bt) = PrismRep (either (either (Left . Left) Right . seta) (Left . Right)) (Left . bt)
+ {-# INLINE left' #-}
+
+ right' (PrismRep seta bt) = PrismRep (either (Left . Left) (either (Left . Right) Right . seta)) (Right . bt)
+ {-# INLINE right' #-}
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+withPrism :: APrism s t a b -> ((s -> t + a) -> (b -> t) -> r) -> r
+withPrism o f = case o (PrismRep Right id) of PrismRep g h -> f g h
+
+-- | Analogous to @(+++)@ from 'Control.Arrow'
+--
+splitting :: Prism s1 t1 a1 b1 -> Prism s2 t2 a2 b2 -> Prism (s1 + s2) (t1 + t2) (a1 + a2) (b1 + b2)
+splitting = split
+
+-- | TODO: Document
+--
+prismr :: (s -> t + a) -> (b -> t) -> Prism (c + s) (d + t) (c + a) (d + b)
+prismr f g = between runSplit Split (prism f g)
+
+-- | Use a 'Prism' to lift part of a structure.
+--
+aside :: APrism s t a b -> Prism (e , s) (e , t) (e , a) (e , b)
+aside k =
+ withPrism k $ \seta bt ->
+ flip prism (fmap bt) $ \(e,s) ->
+ case seta s of
+ Left t -> Left (e,t)
+ Right a -> Right (e,a)
+{-# INLINE aside #-}
+
+-- | Given a pair of prisms, project sums.
+without :: APrism s t a b -> APrism u v c d -> Prism (s + u) (t + v) (a + c) (b + d)
+without k =
+ withPrism k $ \seta bt k' ->
+ withPrism k' $ \uevc dv ->
+ flip prism (bimap bt dv) $ \su ->
+ case su of
+ Left s -> bimap Left Left (seta s)
+ Right u -> bimap Right Right (uevc u)
+{-# INLINE without #-}
+
+-- | 'lift' a 'Prism' through a 'Traversable' functor,
+-- giving a 'Prism' that matches only if all the elements of the container
+-- match the 'Prism'.
+--
+-- >>> [Left 1, Right "foo", Left 4, Right "woot"] ^.. below _R
+-- []
+--
+-- >>> [Right "hail hydra!", Right "foo", Right "blah", Right "woot"] ^.. below _R
+-- [["hail hydra!","foo","blah","woot"]]
+--
+below :: Traversable f => APrism' s a -> Prism' (f s) (f a)
+below k =
+ withPrism k $ \seta bt ->
+ flip prism (fmap bt) $ \s ->
+ case traverse seta s of
+ Left _ -> Left s
+ Right t -> Right t
+{-# INLINE below #-}
+
+---------------------------------------------------------------------
+-- Common prisms
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+_L :: Prism (a + c) (b + c) a b
+_L = pleft
+
+-- | TODO: Document
+--
+_R :: Prism (c + a) (c + b) a b
+_R = pright
+
+-- | Prism for the `Just` constructor of `Maybe`.
+--
+_Just :: Prism (Maybe a) (Maybe b) a b
+_Just = flip prism Just $ maybe (Left Nothing) Right
+
+-- | Prism for the `Nothing` constructor of `Maybe`.
+--
+_Nothing :: Prism (Maybe a) (Maybe b) () ()
+_Nothing = flip prism (const Nothing) $ maybe (Right ()) (const $ Left Nothing)
+
+-- | TODO: Document
+--
+lowerL :: Iso s t (a + c) (b + c) -> Prism s t a b
+lowerL = (. _L)
+
+-- | TODO: Document
+--
+lowerR :: Iso s t (c + a) (c + b) -> Prism s t a b
+lowerR = (. _R)
+
+-- | Obtain a 'Prism' that can be composed with to filter another 'Lens', 'Iso', 'View', 'Fold' (or 'Traversal').
+--
+-- >>> [1..10] ^.. folded . filtered even
+-- [2,4,6,8,10]
+--
+filtered :: (a -> Bool) -> Prism' a a
+filtered f = iso (branch' f) dedup . _R
+
+-- | TODO: Document
+--
+selected :: Eq a => a -> Prism' (a , b) b
+selected x = flip prism ((,) x) $ \kv@(k,v) -> branch (==x) kv v k
+
+-- | Create a 'Prism' from a value and a predicate.
+--
+nearly :: a -> (a -> Bool) -> Prism' a ()
+nearly x f = prism' (guard . f) (const x)
+
+-- | Focus not just on a case, but a specific value of that case.
+--
+only :: Eq a => a -> Prism' a ()
+only x = nearly x (x==)
+
+-- | TODO: Document
+--
+lessThan :: Bounded a => Ord a => a -> Prism' a Ordering
+lessThan x = flip prism' (const x) $ \x' -> if x' < x then Just LT else Nothing
+
+-- | TODO: Document
+--
+excepted :: Exception a => Prism' SomeException a
+excepted = prism' fromException toException
+
+-- | Exceptions that occur in the 'IO' 'Monad'.
+--
+-- An 'IOException' records a more specific error type, a descriptive string and possibly the handle
+-- that was used when the error was flagged.
+--
+_IOException :: Prism' SomeException IOException
+_IOException = excepted
+
+----------------------------------------------------------------------------------------------------
+-- IO Error Types
+----------------------------------------------------------------------------------------------------
+
+-- | TODO: Document
+--
+_AlreadyExists :: Prism' IOErrorType ()
+_AlreadyExists = only AlreadyExists
+
+-- | TODO: Document
+--
+_NoSuchThing :: Prism' IOErrorType ()
+_NoSuchThing = only NoSuchThing
+
+-- | TODO: Document
+--
+_ResourceBusy :: Prism' IOErrorType ()
+_ResourceBusy = only ResourceBusy
+
+-- | TODO: Document
+--
+_ResourceExhausted :: Prism' IOErrorType ()
+_ResourceExhausted = only ResourceExhausted
+
+-- | TODO: Document
+--
+_EOF :: Prism' IOErrorType ()
+_EOF = only EOF
+
+-- | TODO: Document
+--
+_IllegalOperation :: Prism' IOErrorType ()
+_IllegalOperation = only IllegalOperation
+
+-- | TODO: Document
+--
+_PermissionDenied :: Prism' IOErrorType ()
+_PermissionDenied = only PermissionDenied
+
+-- | TODO: Document
+--
+_UserError :: Prism' IOErrorType ()
+_UserError = only UserError
+
+-- | TODO: Document
+--
+_UnsatisfiedConstraints :: Prism' IOErrorType ()
+_UnsatisfiedConstraints = only UnsatisfiedConstraints
+
+-- | TODO: Document
+--
+_SystemError :: Prism' IOErrorType ()
+_SystemError = only SystemError
+
+-- | TODO: Document
+--
+_ProtocolError :: Prism' IOErrorType ()
+_ProtocolError = only ProtocolError
+
+-- | TODO: Document
+--
+_OtherError :: Prism' IOErrorType ()
+_OtherError = only OtherError
+
+-- | TODO: Document
+--
+_InvalidArgument :: Prism' IOErrorType ()
+_InvalidArgument = only InvalidArgument
+
+-- | TODO: Document
+--
+_InappropriateType :: Prism' IOErrorType ()
+_InappropriateType = only InappropriateType
+
+-- | TODO: Document
+--
+_HardwareFault :: Prism' IOErrorType ()
+_HardwareFault = only HardwareFault
+
+-- | TODO: Document
+--
+_UnsupportedOperation :: Prism' IOErrorType ()
+_UnsupportedOperation = only UnsupportedOperation
+
+-- | TODO: Document
+--
+_TimeExpired :: Prism' IOErrorType ()
+_TimeExpired = only TimeExpired
+
+-- | TODO: Document
+--
+_ResourceVanished :: Prism' IOErrorType ()
+_ResourceVanished = only ResourceVanished
+
+-- | TODO: Document
+--
+_Interrupted :: Prism' IOErrorType ()
+_Interrupted = only Interrupted
+
+----------------------------------------------------------------------------------------------------
+-- Async Exceptions
+----------------------------------------------------------------------------------------------------
+
+-- | The current thread's stack exceeded its limit. Since an 'Exception' has
+-- been raised, the thread's stack will certainly be below its limit again,
+-- but the programmer should take remedial action immediately.
+--
+_StackOverflow :: Prism' AsyncException ()
+_StackOverflow = dimap seta (either id id) . right' . rmap (const Ex.StackOverflow)
+ where seta Ex.StackOverflow = Right ()
+ seta t = Left t
+
+-- | The program's heap usage has exceeded its limit.
+--
+-- See 'GHC.IO.Exception' for more information.
+--
+_HeapOverflow :: Prism' AsyncException ()
+_HeapOverflow = dimap seta (either id id) . right' . rmap (const Ex.HeapOverflow)
+ where seta Ex.HeapOverflow = Right ()
+ seta t = Left t
+
+-- | This 'Exception' is raised by another thread calling
+-- 'Control.Concurrent.killThread', or by the system if it needs to terminate
+-- the thread for some reason.
+--
+_ThreadKilled :: Prism' AsyncException ()
+_ThreadKilled = dimap seta (either id id) . right' . rmap (const Ex.ThreadKilled)
+ where seta Ex.ThreadKilled = Right ()
+ seta t = Left t
+
+-- | This 'Exception' is raised by default in the main thread of the program when
+-- the user requests to terminate the program via the usual mechanism(s)
+-- (/e.g./ Control-C in the console).
+--
+_UserInterrupt :: Prism' AsyncException ()
+_UserInterrupt = dimap seta (either id id) . right' . rmap (const Ex.UserInterrupt)
+ where seta Ex.UserInterrupt = Right ()
+ seta t = Left t
+
+----------------------------------------------------------------------------------------------------
+-- Arithmetic exceptions
+----------------------------------------------------------------------------------------------------
+
+-- | Detect arithmetic overflow.
+--
+_Overflow :: Prism' ArithException ()
+_Overflow = dimap seta (either id id) . right' . rmap (const Ex.Overflow)
+ where seta Ex.Overflow = Right ()
+ seta t = Left t
+
+-- | Detect arithmetic underflow.
+--
+_Underflow :: Prism' ArithException ()
+_Underflow = dimap seta (either id id) . right' . rmap (const Ex.Underflow)
+ where seta Ex.Underflow = Right ()
+ seta t = Left t
+
+-- | Detect arithmetic loss of precision.
+--
+_LossOfPrecision :: Prism' ArithException ()
+_LossOfPrecision = dimap seta (either id id) . right' . rmap (const Ex.LossOfPrecision)
+ where seta Ex.LossOfPrecision = Right ()
+ seta t = Left t
+
+-- | Detect division by zero.
+--
+_DivideByZero :: Prism' ArithException ()
+_DivideByZero = dimap seta (either id id) . right' . rmap (const Ex.DivideByZero)
+ where seta Ex.DivideByZero = Right ()
+ seta t = Left t
+
+-- | Detect exceptional denormalized floating pure.
+--
+_Denormal :: Prism' ArithException ()
+_Denormal = dimap seta (either id id) . right' . rmap (const Ex.Denormal)
+ where seta Ex.Denormal = Right ()
+ seta t = Left t
+
+-- | Detect zero denominators.
+--
+-- Added in @base@ 4.6 in response to this libraries discussion:
+--
+-- <http://haskell.1045720.n5.nabble.com/Data-Ratio-and-exceptions-td5711246.html>
+--
+_RatioZeroDenominator :: Prism' ArithException ()
+_RatioZeroDenominator = dimap seta (either id id) . right' . rmap (const Ex.RatioZeroDenominator)
+ where seta Ex.RatioZeroDenominator = Right ()
+ seta t = Left t
+
+----------------------------------------------------------------------------------------------------
+-- Array Exceptions
+----------------------------------------------------------------------------------------------------
+
+-- | Detect attempts to index an array outside its declared bounds.
+--
+_IndexOutOfBounds :: Prism' ArrayException String
+_IndexOutOfBounds = dimap seta (either id id) . right' . rmap Ex.IndexOutOfBounds
+ where seta (Ex.IndexOutOfBounds r) = Right r
+ seta t = Left t
+
+-- | Detect attempts to evaluate an element of an array that has not been initialized.
+--
+_UndefinedElement :: Prism' ArrayException String
+_UndefinedElement = dimap seta (either id id) . right' . rmap Ex.UndefinedElement
+ where seta (Ex.UndefinedElement r) = Right r
+ seta t = Left t
+
+----------------------------------------------------------------------------------------------------
+-- Miscellaneous Exceptions
+----------------------------------------------------------------------------------------------------
+
+trivial :: Profunctor p => t -> Optic' p t ()
+trivial t = const () `dimap` const t
+
+_AssertionFailed :: Prism' Ex.AssertionFailed String
+_AssertionFailed = iso (\(Ex.AssertionFailed a) -> a) Ex.AssertionFailed
+
+-- | Thrown when the runtime system detects that the computation is guaranteed
+-- not to terminate. Note that there is no guarantee that the runtime system
+-- will notice whether any given computation is guaranteed to terminate or not.
+--
+_NonTermination :: Prism' Ex.NonTermination ()
+_NonTermination = trivial Ex.NonTermination
+
+-- | Thrown when the program attempts to call atomically, from the
+-- 'Control.Monad.STM' package, inside another call to atomically.
+--
+_NestedAtomically :: Prism' Ex.NestedAtomically ()
+_NestedAtomically = trivial Ex.NestedAtomically
+
+-- | The thread is blocked on an 'Control.Concurrent.MVar.MVar', but there
+-- are no other references to the 'Control.Concurrent.MVar.MVar' so it can't
+-- ever continue.
+--
+_BlockedIndefinitelyOnMVar :: Prism' Ex.BlockedIndefinitelyOnMVar ()
+_BlockedIndefinitelyOnMVar = trivial Ex.BlockedIndefinitelyOnMVar
+
+-- | The thread is waiting to retry an 'Control.Monad.STM.STM' transaction,
+-- but there are no other references to any TVars involved, so it can't ever
+-- continue.
+--
+_BlockedIndefinitelyOnSTM :: Prism' Ex.BlockedIndefinitelyOnSTM ()
+_BlockedIndefinitelyOnSTM = trivial Ex.BlockedIndefinitelyOnSTM
+
+-- | There are no runnable threads, so the program is deadlocked. The
+-- 'Deadlock' 'Exception' is raised in the main thread only.
+--
+_Deadlock :: Prism' Ex.Deadlock ()
+_Deadlock = trivial Ex.Deadlock
+
+-- | A class method without a definition (neither a default definition,
+-- nor a definition in the appropriate instance) was called.
+--
+_NoMethodError :: Prism' Ex.NoMethodError String
+_NoMethodError = iso (\(Ex.NoMethodError a) -> a) Ex.NoMethodError
+
+-- | A pattern match failed.
+--
+_PatternMatchFail :: Prism' Ex.PatternMatchFail String
+_PatternMatchFail = iso (\(Ex.PatternMatchFail a) -> a) Ex.PatternMatchFail
+
+-- | An uninitialised record field was used.
+--
+_RecConError :: Prism' Ex.RecConError String
+_RecConError = iso (\(Ex.RecConError a) -> a) Ex.RecConError
+
+-- | A record selector was applied to a constructor without the appropriate
+-- field. This can only happen with a datatype with multiple constructors,
+-- where some fields are in one constructor but not another.
+--
+_RecSelError :: Prism' Ex.RecSelError String
+_RecSelError = iso (\(Ex.RecSelError a) -> a) Ex.RecSelError
+
+-- | A record update was performed on a constructor without the
+-- appropriate field. This can only happen with a datatype with multiple
+-- constructors, where some fields are in one constructor but not another.
+--
+_RecUpdError :: Prism' Ex.RecUpdError String
+_RecUpdError = iso (\(Ex.RecUpdError a) -> a) Ex.RecUpdError
+
+-- | Thrown when the user calls 'Prelude.error'.
+--
+_ErrorCall :: Prism' Ex.ErrorCall String
+_ErrorCall = iso (\(Ex.ErrorCall a) -> a) Ex.ErrorCall
+
+-- | This thread has exceeded its allocation limit.
+--
+_AllocationLimitExceeded :: Prism' Ex.AllocationLimitExceeded ()
+_AllocationLimitExceeded = trivial AllocationLimitExceeded
diff --git a/src/Data/Profunctor/Optic/Property.hs b/src/Data/Profunctor/Optic/Property.hs
new file mode 100644
index 0000000..98eb0aa
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Property.hs
@@ -0,0 +1,172 @@
+module Data.Profunctor.Optic.Property where
+
+import Control.Applicative
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Optic.Type
+import Data.Profunctor.Optic.Iso
+--import Data.Profunctor.Optic.View
+import Data.Profunctor.Optic.Setter
+import Data.Profunctor.Optic.Lens
+import Data.Profunctor.Optic.Prism
+--import Data.Profunctor.Optic.Grate
+--import Data.Profunctor.Optic.Fold
+--import Data.Profunctor.Optic.Fold0
+--import Data.Profunctor.Optic.Cofold
+--import Data.Profunctor.Optic.Traversal
+import Data.Profunctor.Optic.Traversal0
+--import Data.Profunctor.Optic.Cotraversal
+
+---------------------------------------------------------------------
+-- 'Iso'
+---------------------------------------------------------------------
+
+iso_fromto' :: Eq s => Iso' s a -> s -> Bool
+iso_fromto' o = withIso o iso_fromto
+
+iso_tofrom' :: Eq a => Iso' s a -> a -> Bool
+iso_tofrom' o = withIso o iso_tofrom
+
+iso_fromto :: Eq s => (s -> a) -> (a -> s) -> s -> Bool
+iso_fromto sa as s = as (sa s) == s
+
+iso_tofrom :: Eq a => (s -> a) -> (a -> s) -> a -> Bool
+iso_tofrom sa as a = sa (as a) == a
+
+---------------------------------------------------------------------
+-- 'Prism'
+---------------------------------------------------------------------
+
+-- If we are able to view an existing focus, then building it will return the original structure.
+prism_tofrom :: Eq s => (s -> s + a) -> (a -> s) -> s -> Bool
+prism_tofrom seta bt s = either id bt (seta s) == s
+
+-- If we build a whole from any focus, that whole must contain a focus.
+prism_fromto :: Eq s => Eq a => (s -> s + a) -> (a -> s) -> a -> Bool
+prism_fromto seta bt a = seta (bt a) == Right a
+
+prism_tofrom' :: Eq s => Prism' s a -> s -> Bool
+prism_tofrom' o = withPrism o prism_tofrom
+
+-- Reviewing a value with a 'Prism' and then previewing returns the value.
+prism_fromto' :: Eq s => Eq a => Prism' s a -> a -> Bool
+prism_fromto' o = withPrism o prism_fromto
+
+---------------------------------------------------------------------
+-- 'Lens'
+---------------------------------------------------------------------
+
+
+-- | A 'Lens' is a valid 'Traversal' with the following additional laws:
+--
+-- * @view o (set o b a) ≡ b@
+--
+-- * @set o (view o a) a ≡ a@
+--
+-- * @set o c (set o b a) ≡ set o c a@
+--
+
+lens_tofrom :: Eq s => (s -> a) -> (s -> a -> s) -> s -> Bool
+lens_tofrom sa sas s = sas s (sa s) == s
+
+lens_fromto :: Eq a => (s -> a) -> (s -> a -> s) -> s -> a -> Bool
+lens_fromto sa sas s a = sa (sas s a) == a
+
+lens_idempotent :: Eq s => (s -> a -> s) -> s -> a -> a -> Bool
+lens_idempotent sas s a1 a2 = sas (sas s a1) a2 == sas s a2
+
+-- | Putting back what you got doesn't change anything.
+lens_tofrom' :: Eq s => Lens' s a -> s -> Bool
+lens_tofrom' o = withLens o lens_tofrom
+
+-- | You get back what you put in.
+lens_fromto' :: Eq a => Lens' s a -> s -> a -> Bool
+lens_fromto' o = withLens o lens_fromto
+
+-- | Setting twice is the same as setting once.
+lens_idempotent' :: Eq s => Lens' s a -> s -> a -> a -> Bool
+lens_idempotent' o = withLens o $ const lens_idempotent
+
+---------------------------------------------------------------------
+-- 'Grate'
+---------------------------------------------------------------------
+
+-- | The 'Grate' laws are that of an algebra for a parameterised continuation monad.
+--
+-- * @grate ($ s) ≡ s@
+--
+-- * @grate (\k -> h (k . sabt)) ≡ sabt (\k -> h ($ k))@
+--
+grate_pure :: Eq s => (((s -> a) -> a) -> s) -> s -> Bool
+grate_pure sabt s = sabt ($ s) == s
+
+grate_pure' :: Eq s => (((s -> a) -> a) -> s) -> s -> a -> Bool
+grate_pure' sabt s a = sabt (const a) == s
+
+---------------------------------------------------------------------
+-- 'Traversal0'
+---------------------------------------------------------------------
+
+atraversal_tofrom :: Eq a => Eq s => (s -> s + a) -> (s -> a -> s) -> s -> a -> Bool
+atraversal_tofrom seta sbt s a = seta (sbt s a) == either (Left . flip const a) Right (seta s)
+
+atraversal_fromto :: Eq s => (s -> s + a) -> (s -> a -> s) -> s -> Bool
+atraversal_fromto seta sbt s = either id (sbt s) (seta s) == s
+
+atraversal_idempotent :: Eq s => (s -> a -> s) -> s -> a -> a -> Bool
+atraversal_idempotent sbt s a1 a2 = sbt (sbt s a1) a2 == sbt s a2
+
+atraversal_tofrom' :: Eq a => Eq s => Traversal0' s a -> s -> a -> Bool
+atraversal_tofrom' o = withTraversal0 o atraversal_tofrom
+
+atraversal_fromto' :: Eq s => Traversal0' s a -> s -> Bool
+atraversal_fromto' o = withTraversal0 o atraversal_fromto
+
+atraversal_idempotent' :: Eq s => Traversal0' s a -> s -> a -> a -> Bool
+atraversal_idempotent' o = withTraversal0 o $ const atraversal_idempotent
+
+---------------------------------------------------------------------
+-- 'Traversal'
+---------------------------------------------------------------------
+
+
+-- | 'Traversal' is a valid 'Setter' with the following additional laws:
+--
+-- * @t pure ≡ pure@
+--
+-- * @fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g)@
+--
+-- These can be restated in terms of 'traverseOf':
+--
+-- * @traverseOf t (Identity . f) ≡ Identity (fmap f)@
+--
+-- * @Compose . fmap (traverseOf t f) . traverseOf t g == traverseOf t (Compose . fmap f . g)@
+--
+-- See also < https://www.cs.ox.ac.uk/jeremy.gibbons/publications/iterator.pdf >
+--
+
+traverse_pure :: forall f s a. (Applicative f, Eq (f s)) => ((a -> f a) -> s -> f s) -> s -> Bool
+traverse_pure o s = o pure s == (pure s :: f s)
+
+--traverse_compose :: (Applicative f, Applicative g, Eq (f (g s))) => Traversal' s a -> (a -> g a) -> (a -> f a) -> s -> Bool
+--traverse_compose t f g s = (fmap (t f) . t g) s == (getCompose . t (Compose . fmap f . g)) s
+
+---------------------------------------------------------------------
+-- 'Setter'
+---------------------------------------------------------------------
+
+-- | A 'Setter' is only legal if the following 3 laws hold:
+--
+-- 1. @set o y (set o x a) ≡ set o y a@
+--
+-- 2. @over o id ≡ id@
+--
+-- 3. @over o f . over o g ≡ over o (f . g)@
+
+setter_id :: Eq s => Setter' s a -> s -> Bool
+setter_id o s = over o id s == s
+
+setter_compose :: Eq s => Setter' s a -> (a -> a) -> (a -> a) -> s -> Bool
+setter_compose o f g s = (over o f . over o g) s == over o (f . g) s
+
+setter_idempotent :: Eq s => Setter' s a -> s -> a -> a -> Bool
+setter_idempotent o s a b = set o b (set o a s) == set o b s
diff --git a/src/Data/Profunctor/Optic/Setter.hs b/src/Data/Profunctor/Optic/Setter.hs
new file mode 100644
index 0000000..b864e57
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Setter.hs
@@ -0,0 +1,273 @@
+{-# LANGUAGE DeriveFunctor #-}
+
+module Data.Profunctor.Optic.Setter where
+
+import Control.Applicative (liftA)
+import Control.Exception (Exception(..), SomeException)
+import Control.Monad.Reader as Reader hiding (lift)
+import Control.Monad.Writer as Writer hiding (lift)
+import Data.Foldable (Foldable, foldMap)
+import Data.Profunctor.Optic.Iso (PStore(..))
+import Data.Profunctor.Optic.Prelude hiding (Bifunctor(..))
+import Data.Profunctor.Optic.Type
+import Data.Semiring
+import qualified Control.Exception as Ex
+
+---------------------------------------------------------------------
+-- Setter
+---------------------------------------------------------------------
+
+-- | Promote a <http://conal.net/blog/posts/semantic-editor-combinators semantic editor combinator> to a modify-only optic.
+--
+-- To demote an optic to a semantic edit combinator, use the section @(l %~)@ or @over l@.
+--
+-- >>> [("The",0),("quick",1),("brown",1),("fox",2)] & setter map . _1 %~ length
+-- [(3,0),(5,1),(5,1),(3,2)]
+--
+-- /Caution/: In order for the generated family to be well-defined, you must ensure that the two functor laws hold:
+--
+-- * @sec id ≡ id@
+--
+-- * @sec f . sec g ≡ sec (f . g)@
+--
+-- See 'Data.Profunctor.Optic.Property'.
+--
+setter :: ((a -> b) -> s -> t) -> Setter s t a b
+setter sec = dimap (flip PStore id) (\(PStore s ab) -> sec ab s) . lift collect
+
+-- | Every 'Grate' is a 'Setter'.
+--
+closing :: (((s -> a) -> b) -> t) -> Setter s t a b
+closing sabt = setter $ \ab s -> sabt $ \sa -> ab (sa s)
+
+infixl 6 %
+
+-- | Sum two SECs
+--
+(%) :: Setter' a a -> Setter' a a -> Setter' a a
+(%) f g = setter $ \h -> (f %~ h) . (g %~ h)
+
+-- >>> toSemiring $ zero % one :: Int
+-- 1
+-- >>> toSemiring $ zero . one :: Int
+-- 0
+toSemiring :: Monoid a => Semiring a => Setter' a a -> a
+toSemiring a = over a (unit <>) mempty
+
+fromSemiring :: Monoid a => Semiring a => a -> Setter' a a
+fromSemiring a = setter $ \ f y -> a >< f mempty <> y
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | Modify the target of a 'Lens' or all the targets of a 'Setter' or 'Traversal'.
+--
+-- @ 'over' l 'id' ≡ 'id' @
+--
+-- @
+-- 'over' l f '.' 'over' l g ≡ 'over' l (f '.' g)
+-- @
+--
+-- >>> over mapped f (over mapped g [a,b,c]) == over mapped (f . g) [a,b,c]
+-- True
+--
+-- >>> over mapped f (Just a)
+-- Just (f a)
+--
+-- >>> over mapped (*10) [1,2,3]
+-- [10,20,30]
+--
+-- >>> over _1 f (a,b)
+-- (f a,b)
+--
+-- >>> over _1 show (10,20)
+-- ("10",20)
+--
+-- @
+-- 'fmap' ≡ 'over' 'mapped'
+-- 'setter' '.' 'over' ≡ 'id'
+-- 'over' '.' 'setter' ≡ 'id'
+-- @
+--
+-- @ 'over' ('cayley' a) ('Data.Semiring.unit' <>) 'Data.Monoid.mempty' ≡ a @
+--
+-- @
+-- over :: Setter s t a b -> (a -> r) -> s -> r
+-- over :: Monoid r => Fold s t a b -> (a -> r) -> s -> r
+-- @
+--
+over :: Optic (->) s t a b -> (a -> b) -> s -> t
+over = id
+
+-- | TODO: Document
+--
+reover :: Optic (Re (->) a b) s t a b -> (t -> s) -> (b -> a)
+reover = re
+
+---------------------------------------------------------------------
+-- Derived operators
+---------------------------------------------------------------------
+
+infixr 4 %~
+
+-- | TODO: Document
+--
+(%~) :: Optic (->) s t a b -> (a -> b) -> s -> t
+(%~) = id
+{-# INLINE (%~) #-}
+
+infixr 4 .~
+
+-- | TODO: Document
+--
+(.~) :: Optic (->) s t a b -> b -> s -> t
+(.~) = set
+{-# INLINE (.~) #-}
+
+-- | Set all referenced fields to the given value.
+--
+-- @ set l y (set l x a) ≡ set l y a @
+--
+set :: Optic (->) s t a b -> b -> s -> t
+set o b = o (const b)
+
+---------------------------------------------------------------------
+-- Common setters
+---------------------------------------------------------------------
+
+-- | The unit SEC
+--
+one :: Monoid a => Semiring a => Setter' a a
+one = setter id
+
+-- | The zero SEC
+--
+zero :: Monoid a => Semiring a => Setter' a a
+zero = setter $ const id
+
+-- | Map contravariantly by setter the input of a 'Profunctor'.
+--
+--
+-- The most common profunctor to use this with is @(->)@.
+--
+-- >>> (dom %~ f) g x
+-- g (f x)
+--
+-- >>> (dom %~ show) length [1,2,3]
+-- 7
+--
+-- >>> (dom %~ f) h x y
+-- h (f x) y
+--
+-- Map setter the second arg of a function:
+--
+-- >>> (mapped . dom %~ f) h x y
+-- h x (f y)
+--
+dom :: Profunctor p => Setter (p b r) (p a r) a b
+dom = setter lmap
+{-# INLINE dom #-}
+
+-- | A grate accessing the codomain of a function.
+--
+-- @
+-- cod @(->) == lowerGrate range
+-- @
+--
+cod :: Profunctor p => Setter (p r a) (p r b) a b
+cod = setter rmap
+
+-- | SEC for monadically transforming a monadic value.
+--
+bound :: Monad m => Setter (m a) (m b) a (m b)
+bound = setter (=<<)
+
+-- | SEC on each value of a functor.
+--
+fmapped :: Functor f => Setter (f a) (f b) a b
+fmapped = setter fmap
+
+-- | TODO: Document
+--
+foldMapped :: Foldable f => Monoid m => Setter (f a) m a m
+foldMapped = setter foldMap
+
+-- | This 'setter' can be used to modify all of the values in an 'Applicative'.
+--
+-- @
+-- 'liftA' ≡ 'setter' 'liftedA'
+-- @
+--
+-- >>> setter liftedA f [a,b,c]
+-- [f a,f b,f c]
+--
+-- >>> set liftedA b (Just a)
+-- Just b
+liftedA :: Applicative f => Setter (f a) (f b) a b
+liftedA = setter liftA
+
+-- | TODO: Document
+--
+liftedM :: Monad m => Setter (m a) (m b) a b
+liftedM = setter liftM
+
+-- | Set a value using an SEC.
+--
+sets :: Setter b (a -> c) a c
+sets = setter const
+
+-- | TODO: Document
+--
+zipped :: Setter (u -> v -> a) (u -> v -> b) a b
+zipped = setter ((.)(.)(.))
+
+-- | TODO: Document
+--
+modded :: Setter (b -> t) (((s -> a) -> b) -> t) s a
+modded = setter $ \sa bt sab -> bt (sab sa)
+
+-- | TODO: Document
+--
+composed :: Setter (s -> a) ((a -> b) -> s -> t) b t
+composed = setter between
+
+-- | Apply a function only when the given predicate holds.
+--
+branched :: (a -> Bool) -> Setter' a a
+branched p = setter $ \f a -> if p a then f a else a
+
+-- | TODO: Document
+--
+branched' :: (k -> Bool) -> Setter' (k -> v) v
+branched' p = setter $ \md f a -> if p a then md (f a) else f a
+
+-- | This 'Setter' can be used to purely map over the 'Exception's an
+-- arbitrary expression might throw; it is a variant of 'mapException' in
+-- the same way that 'mapped' is a variant of 'fmap'.
+--
+-- > 'mapException' ≡ 'over' 'excepted'
+--
+-- This view that every Haskell expression can be regarded as carrying a bag
+-- of 'Exception's is detailed in “A Semantics for Imprecise Exceptions” by
+-- Peyton Jones & al. at PLDI ’99.
+--
+-- The following maps failed assertions to arithmetic overflow:
+--
+-- >>> handleOf _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & (exmapped %~ \ (AssertionFailed _) -> Overflow)
+-- "caught"
+--
+exmapped :: Exception e0 => Exception e1 => Setter s s e0 e1
+exmapped = setter Ex.mapException
+
+-- | A type restricted version of 'mappedException'.
+--
+-- This function avoids the type ambiguity in the input 'Exception' when using 'set'.
+--
+-- The following maps any exception to arithmetic overflow:
+--
+-- >>> handleOf _Overflow (\_ -> return "caught") $ assert False (return "uncaught") & (exmapped' .~ Overflow)
+-- "caught"
+--
+exmapped' :: Exception e => Setter s s SomeException e
+exmapped' = exmapped
diff --git a/src/Data/Profunctor/Optic/Traversal.hs b/src/Data/Profunctor/Optic/Traversal.hs
new file mode 100644
index 0000000..86a1f69
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Traversal.hs
@@ -0,0 +1,65 @@
+module Data.Profunctor.Optic.Traversal where
+
+import Data.Bitraversable
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Optic.Type
+
+---------------------------------------------------------------------
+-- 'Traversal'
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+traversal :: Traversable f => (s -> f a) -> (s -> f b -> t) -> Traversal s t a b
+traversal sa sbt = dimap dup (uncurry sbt) . psecond . lmap sa . lift traverse
+
+-- | Transform a Van Laarhoven 'Traversal' into a profunctor 'Traversal'.
+--
+traversalVL :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> Traversal s t a b
+traversalVL = lift
+
+-- | TODO: Document
+--
+traversed :: Traversable f => Traversal (f a) (f b) a b
+traversed = lift traverse
+
+---------------------------------------------------------------------
+-- Primitive Operators
+---------------------------------------------------------------------
+
+-- ^ @
+-- traverseOf :: Functor f => Lens s t a b -> (a -> f b) -> s -> f t
+-- traverseOf :: Applicative f => Traversal s t a b -> (a -> f b) -> s -> f t
+-- @
+--
+traverseOf :: Applicative f => ATraversal f s t a b -> (a -> f b) -> s -> f t
+traverseOf = between runStar Star
+
+-- | TODO: Document
+--
+sequenceOf :: Applicative f => ATraversal f s t (f a) a -> s -> f t
+sequenceOf t = traverseOf t id
+
+---------------------------------------------------------------------
+-- Common 'Traversal's
+---------------------------------------------------------------------
+
+-- | Traverse bitraversed parts of a 'Bitraversable' container with matching types.
+--
+-- >>> traverseOf bitraversed (pure . length) (Right "hello")
+-- Right 5
+--
+-- >>> traverseOf bitraversed (pure . length) ("hello","world")
+-- (5,5)
+--
+-- >>> ("hello","world") ^. bitraversed
+-- "helloworld"
+--
+-- @
+-- 'bitraversed' :: 'Traversal' (a , a) (b , b) a b
+-- 'bitraversed' :: 'Traversal' (a + a) (b + b) a b
+-- @
+--
+bitraversed :: Bitraversable f => Traversal (f a a) (f b b) a b
+bitraversed = lift $ \f -> bitraverse f f
+{-# INLINE bitraversed #-}
diff --git a/src/Data/Profunctor/Optic/Traversal0.hs b/src/Data/Profunctor/Optic/Traversal0.hs
new file mode 100644
index 0000000..0b5a733
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Traversal0.hs
@@ -0,0 +1,163 @@
+{-# LANGUAGE TupleSections #-}
+module Data.Profunctor.Optic.Traversal0 where
+
+import Data.Profunctor.Optic.Type
+import Data.Profunctor.Optic.Prelude
+
+---------------------------------------------------------------------
+-- 'Traversal0'
+---------------------------------------------------------------------
+
+-- | Create a 'Traversal0' from a constructor and a matcher.
+--
+-- \( \quad \mathsf{Traversal0}\;S\;A =\exists C, D, S \cong D + C \times A \)
+--
+-- /Caution/: In order for the 'Traversal0' to be well-defined,
+-- you must ensure that the three affine traversal laws hold:
+--
+-- * @sta (sbt (a, s)) ≡ either (Left . const a) Right (sta s)@
+--
+-- * @either (\a -> sbt (a, s)) id (sta s) ≡ s@
+--
+-- * @sbt (a2, (sbt (a1, s))) ≡ sbt (a2, s)@
+--
+-- See 'Data.Profunctor.Optic.Property'.
+--
+traversal0 :: (s -> t + a) -> (s -> b -> t) -> Traversal0 s t a b
+traversal0 sta sbt = dimap f g . pright . pfirst
+ where f s = (,s) <$> sta s
+ g = id ||| (uncurry . flip $ sbt)
+
+-- | Create a 'Traversal0'' from a constructor and a matcher function.
+--
+traversal0' :: (s -> Maybe a) -> (s -> a -> s) -> Traversal0' s a
+traversal0' sa sas = flip traversal0 sas $ \s -> maybe (Left s) Right (sa s)
+
+-- | Transform a Van Laarhoven 'Traversal0' into a profunctor 'Traversal0'.
+--
+traversal0VL :: (forall f. Functor f => (forall r. r -> f r) -> (a -> f b) -> s -> f t) -> Traversal0 s t a b
+traversal0VL f = dimap (\s -> (match s, s)) (\(ebt, s) -> either (update s) id ebt) . pfirst . pleft
+ where
+ match s = f Right Left s
+ update s b = runIdentity $ f Identity (\_ -> Identity b) s
+
+---------------------------------------------------------------------
+-- 'Traversal0Rep'
+---------------------------------------------------------------------
+
+-- | The `Traversal0Rep` profunctor precisely characterizes an 'Traversal0'.
+data Traversal0Rep a b s t = Traversal0Rep (s -> t + a) (s -> b -> t)
+
+type ATraversal0 s t a b = Optic (Traversal0Rep a b) s t a b
+
+type ATraversal0' s a = ATraversal0 s s a a
+
+type ARetraversal0 s t a b = Optic (Re (Traversal0Rep t s) a b) s t a b
+
+instance Profunctor (Traversal0Rep u v) where
+ dimap f g (Traversal0Rep getter setter) = Traversal0Rep
+ (\a -> first g $ getter (f a))
+ (\a v -> g (setter (f a) v))
+
+instance Strong (Traversal0Rep u v) where
+ first' (Traversal0Rep getter setter) = Traversal0Rep
+ (\(a, c) -> first (,c) $ getter a)
+ (\(a, c) v -> (setter a v, c))
+
+instance Choice (Traversal0Rep u v) where
+ right' (Traversal0Rep getter setter) = Traversal0Rep
+ (\eca -> assocl' (second getter eca))
+ (\eca v -> second (`setter` v) eca)
+
+instance Sieve (Traversal0Rep a b) (PStore0 a b) where
+ sieve (Traversal0Rep sta sbt) s = PStore0 (sbt s) (sta s)
+
+instance Representable (Traversal0Rep a b) where
+ type Rep (Traversal0Rep a b) = PStore0 a b
+
+ tabulate f = Traversal0Rep (\s -> info0 (f s)) (\s -> values0 (f s))
+
+data PStore0 a b t = PStore0 (b -> t) (t + a)
+
+values0 :: PStore0 a b t -> b -> t
+values0 (PStore0 bt _) = bt
+
+info0 :: PStore0 a b t -> t + a
+info0 (PStore0 _ a) = a
+
+instance Functor (PStore0 a b) where
+ fmap f (PStore0 bt ta) = PStore0 (f . bt) (first f ta)
+ {-# INLINE fmap #-}
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+withTraversal0 :: ATraversal0 s t a b -> ((s -> t + a) -> (s -> b -> t) -> r) -> r
+withTraversal0 o f = case o (Traversal0Rep Right $ const id) of Traversal0Rep x y -> f x y
+
+-- | Retrieve the value targeted by a 'Traversal0' or return the original.
+--
+--
+-- Allows the type to change if the optic does not match.
+--
+-- @
+-- 'preview' o ≡ 'either' ('const' 'Nothing') 'id' . 'matchOf' o
+-- @
+--
+matchOf :: ATraversal0 s t a b -> s -> t + a
+matchOf o = withTraversal0 o $ \match _ -> match
+
+-- | Reverse match on a 'Reprism' or similar.
+--
+-- * @rematching . re $ prism _ sa ≡ sa@
+--
+rematchOf :: ARetraversal0 s t a b -> b -> a + t
+rematchOf o = matchOf (re o)
+
+-- | Test whether the optic matches or not.
+--
+-- >>> isMatched _Just Nothing
+-- False
+--
+isMatched :: ATraversal0 s t a b -> s -> Bool
+isMatched o = either (const False) (const True) . matchOf o
+
+-- | Test whether the optic matches or not.
+--
+-- >>> isntMatched _Just Nothing
+-- True
+--
+isntMatched :: ATraversal0 s t a b -> s -> Bool
+isntMatched o = either (const True) (const False) . matchOf o
+
+---------------------------------------------------------------------
+-- Common affine traversals
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+nulled :: Traversal0' s a
+nulled = traversal0 Left const
+
+-- | Filter result(s) that don't satisfy a predicate.
+--
+-- /Caution/: While this is a valid 'Traversal0', it is only a valid 'Traversal'
+-- if the predicate always evaluates to 'True' on the targets of the 'Traversal'.
+--
+-- @
+-- 'filtered0' p ≡ 'vltraversal0' $ \point f a -> if p a then f a else point a
+-- @
+--
+-- >>> [1..10] ^.. fold id . filtered0 even
+-- [2,4,6,8,10]
+--
+filtered0 :: (a -> Bool) -> Traversal0' a a
+filtered0 p = traversal0 (branch' p) (flip const)
+
+-- | TODO: Document
+--
+selected0 :: (a -> Bool) -> Traversal0' (a, b) b
+selected0 p = traversal0 (\kv@(k,v) -> branch p kv v k) (\kv@(k,_) v' -> if p k then (k,v') else kv)
diff --git a/src/Data/Profunctor/Optic/Type.hs b/src/Data/Profunctor/Optic/Type.hs
new file mode 100644
index 0000000..017c65d
--- /dev/null
+++ b/src/Data/Profunctor/Optic/Type.hs
@@ -0,0 +1,484 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+module Data.Profunctor.Optic.Type (
+ -- * Optics
+ Optic, Optic', between
+ -- * Equality
+ , Equality, Equality', As
+ -- * Isos
+ , Iso, Iso'
+ -- * Views & Reviews
+ , View, AView, PrimView, PrimViewLike, Review, AReview, PrimReview, PrimReviewLike
+ -- * Setters & Resetters
+ , Setter, Setter', SetterLike, ASetter , Resetter, Resetter', ResetterLike, AResetter
+ -- * Lenses & Relenses
+ , Lens, Lens', LensLike, LensLike', Relens, Relens', RelensLike, RelensLike'
+ -- * Prisms & Reprisms
+ , Prism, Prism', PrismLike, PrismLike', Reprism, Reprism', ReprismLike, ReprismLike'
+ -- * Grates
+ , Grate, Grate', GrateLike, GrateLike'
+ -- * Grids
+ , Grid, Grid', GridLike, GridLike'
+ -- * Affine traversals and retraversals
+ , Affine, Traversal0, Traversal0', Traversal0Like, Traversal0Like', Retraversal0, Retraversal0', Retraversal0Like, Retraversal0Like'
+ -- * Non-empty traversals
+ , Traversal1, Traversal1', Traversal1Like, Traversal1Like'
+ -- * General traversals
+ , Traversal, Traversal', TraversalLike, TraversalLike', ATraversal, ATraversal'
+ -- * Affine cotraversals
+ , Coaffine, Cotraversal0, Cotraversal0', Cotraversal0Like, Cotraversal0Like'
+ -- * Cotraversals
+ , Cotraversal, Cotraversal', CotraversalLike, CotraversalLike'
+ -- * Affine folds
+ , Fold0, Fold0Like
+ -- * Non-empty folds
+ , Fold1, Fold1Like, AFold1
+ -- * General folds
+ , Fold, FoldLike, FoldRep, AFold, Handler, HandlerM
+ -- * Co-affine Cofolds (a.k.a. Glasses)
+ , Cofold0, Cofold0Like
+ -- * Cofolds
+ , Cofold, CofoldRep, ACofold
+ -- * Repns
+ , Repn, Repn', RepnLike, RepnLike', ARepn
+ -- * Corepns
+ , Corepn, Corepn', CorepnLike, CorepnLike', ACorepn
+ -- * 'Re'
+ , Re(..), re
+ , module Export
+) where
+
+import Control.Foldl (EndoM)
+import Data.Functor.Apply (Apply(..))
+import Data.Monoid (Endo)
+import Data.Profunctor.Optic.Prelude
+import Data.Profunctor.Types as Export
+import Data.Profunctor.Orphan as Export ()
+import Data.Profunctor.Strong as Export (Strong(..), Costrong(..))
+import Data.Profunctor.Choice as Export (Choice(..), Cochoice(..))
+import Data.Profunctor.Closed as Export (Closed(..))
+import Data.Profunctor.Sieve as Export (Sieve(..), Cosieve(..))
+import Data.Profunctor.Rep as Export (Representable(..), Corepresentable(..))
+
+---------------------------------------------------------------------
+-- 'Optic'
+---------------------------------------------------------------------
+
+type Optic p s t a b = p a b -> p s t
+
+type Optic' p s a = Optic p s s a a
+
+-- | Can be used to rewrite
+--
+-- > \g -> f . g . h
+--
+-- to
+--
+-- > between f h
+--
+between :: (c -> d) -> (a -> b) -> (b -> c) -> a -> d
+between f g = (f .) . (. g)
+{-# INLINE between #-}
+
+---------------------------------------------------------------------
+-- 'Equality'
+---------------------------------------------------------------------
+
+type Equality s t a b = forall p. Optic p s t a b
+
+type Equality' s a = Equality s s a a
+
+type As a = Equality' a a
+
+---------------------------------------------------------------------
+-- 'Iso'
+---------------------------------------------------------------------
+
+-- | 'Iso'
+--
+-- \( \mathsf{Iso}\;S\;A = S \cong A \)
+--
+type Iso s t a b = forall p. Profunctor p => Optic p s t a b
+
+type Iso' s a = Iso s s a a
+
+---------------------------------------------------------------------
+-- 'View'
+---------------------------------------------------------------------
+
+-- | A 'View' extracts a result.
+--
+type View s a = forall p. Strong p => PrimViewLike p s s a a
+
+type PrimView s t a b = forall p. PrimViewLike p s t a b
+
+type PrimViewLike p s t a b = Profunctor p => (forall x. Contravariant (p x)) => Optic p s t a b
+
+type AView s a = Optic' (FoldRep a) s a
+
+---------------------------------------------------------------------
+-- 'Review'
+---------------------------------------------------------------------
+
+-- | A 'Review' produces a result.
+--
+type Review t b = forall p. Choice p => PrimReviewLike p t t b b
+
+type PrimReview s t a b = forall p. PrimReviewLike p s t a b
+
+type PrimReviewLike p s t a b = Profunctor p => Bifunctor p => Optic p s t a b
+
+type AReview t b = Optic' (CofoldRep b) t b
+
+---------------------------------------------------------------------
+-- 'Setter'
+---------------------------------------------------------------------
+
+-- | A 'Setter' modifies part of a structure.
+--
+-- \( \mathsf{Setter}\;S\;A = \exists F : \mathsf{Functor}, S \equiv F\,A \)
+--
+type Setter s t a b = forall p. SetterLike p s t a b
+
+type Setter' s a = Setter s s a a
+
+type SetterLike p s t a b = Closed p => Distributive (Rep p) => TraversalLike p s t a b
+
+type ASetter s t a b = Optic (->) s t a b
+
+---------------------------------------------------------------------
+-- 'Resetter'
+---------------------------------------------------------------------
+
+type Resetter s t a b = forall p. ResetterLike p s t a b
+
+type Resetter' s a = Resetter s s a a
+
+type ResetterLike p s t a b = Strong p => Traversable (Corep p) => Cotraversal1Like p s t a b
+
+type AResetter s t a b = Optic (->) s t a b
+
+---------------------------------------------------------------------
+-- 'Lens'
+---------------------------------------------------------------------
+
+-- | Lenses access one piece of a product structure.
+--
+-- \( \mathsf{Lens}\;S\;A = \exists C, S \cong C \times A \)
+--
+type Lens s t a b = forall p. LensLike p s t a b
+
+type Lens' s a = Lens s s a a
+
+type LensLike p s t a b = Strong p => Optic p s t a b
+
+type LensLike' p s a = LensLike p s s a a
+
+type Relens s t a b = forall p. RelensLike p s t a b
+
+type Relens' s a = Relens s s a a
+
+type RelensLike p s t a b = Costrong p => Optic p s t a b
+
+type RelensLike' p s a = RelensLike p s s a a
+
+---------------------------------------------------------------------
+-- 'Prism'
+---------------------------------------------------------------------
+
+-- | Prisms access one piece of a sum structure.
+--
+-- \( \mathsf{Prism}\;S\;A = \exists D, S \cong D + A \)
+--
+type Prism s t a b = forall p. PrismLike p s t a b
+
+type Prism' s a = Prism s s a a
+
+type PrismLike p s t a b = Choice p => Optic p s t a b
+
+type PrismLike' p s a = PrismLike p s s a a
+
+type Reprism s t a b = forall p. ReprismLike p s t a b
+
+type Reprism' s a = Reprism s s a a
+
+type ReprismLike p s t a b = Cochoice p => Optic p s t a b
+
+type ReprismLike' p s a = ReprismLike p s s a a
+
+---------------------------------------------------------------------
+-- 'Grate'
+---------------------------------------------------------------------
+
+-- | Grates access the codomain of an indexed structure.
+--
+-- \( \mathsf{Grate}\;S\;A = \exists I, S \cong I \to A \)
+--
+type Grate s t a b = forall p. GrateLike p s t a b
+
+type Grate' s a = Grate s s a a
+
+type GrateLike p s t a b = Closed p => Optic p s t a b
+
+type GrateLike' p s a = GrateLike p s s a a
+
+---------------------------------------------------------------------
+-- 'Grid'
+---------------------------------------------------------------------
+
+-- | Grids arise from the combination of lenses and grates.
+--
+-- \( \mathsf{Grid}\;S\;A = \exists C,I, S \cong C \times (I \to A) \)
+--
+type Grid s t a b = forall p. GridLike p s t a b
+
+type Grid' s a = Grid s s a a
+
+type GridLike p s t a b = Closed p => LensLike p s t a b
+
+type GridLike' p s a = GridLike p s s a a
+
+---------------------------------------------------------------------
+-- 'Traversal0'
+---------------------------------------------------------------------
+
+type Affine p = (Strong p, Choice p)
+
+-- | A 'Traversal0' processes at most one element, with no interactions.
+--
+-- \( \mathsf{Traversal0}\;S\;A = \exists C, D, S \cong D + C \times A \)
+--
+type Traversal0 s t a b = forall p. Traversal0Like p s t a b
+
+type Traversal0' s a = Traversal0 s s a a
+
+type Traversal0Like p s t a b = Affine p => Optic p s t a b
+
+type Traversal0Like' p s a = Traversal0Like p s s a a
+
+type Retraversal0 s t a b = forall p. Retraversal0Like p s t a b
+
+type Retraversal0' s a = Retraversal0 s s a a
+
+type Retraversal0Like p s t a b = Costrong p => Cochoice p => Optic p s t a b
+
+type Retraversal0Like' p s a = ReprismLike p s s a a
+
+---------------------------------------------------------------------
+-- 'Traversal1'
+---------------------------------------------------------------------
+
+-- | A 'Traversal1' processes 1 or more elements, with non-empty applicative interactions.
+--
+type Traversal1 s t a b = forall p. Traversal1Like p s t a b
+
+type Traversal1' s a = Traversal1 s s a a
+
+type Traversal1Like p s t a b = Choice p => Apply (Rep p) => RepnLike p s t a b
+
+type Traversal1Like' p s a = Traversal1Like p s s a a
+
+---------------------------------------------------------------------
+-- 'Traversal'
+---------------------------------------------------------------------
+
+-- | A 'Traversal' processes 0 or more elements, with applicative interactions.
+--
+type Traversal s t a b = forall p. TraversalLike p s t a b
+
+type Traversal' s a = Traversal s s a a
+
+type TraversalLike p s t a b = Affine p => Applicative (Rep p) => RepnLike p s t a b
+
+type TraversalLike' p s a = TraversalLike p s s a a
+
+type ATraversal f s t a b = Applicative f => Optic (Star f) s t a b
+
+type ATraversal' f s a = ATraversal f s s a a
+
+---------------------------------------------------------------------
+-- 'Cotraversal0'
+---------------------------------------------------------------------
+
+type Coaffine p = (Closed p, Choice p)
+
+-- | A 'Cotraversal0' arises from the combination of prisms and grates.
+--
+-- \( \mathsf{Cotraversal0}\;S\;A = \exists D,I, S \cong D + (I \to A) \)
+--
+type Cotraversal0 s t a b = forall p. Cotraversal0Like p s t a b
+
+type Cotraversal0' s a = Cotraversal0 s s a a
+
+type Cotraversal0Like p s t a b = Coaffine p => Optic p s t a b
+
+type Cotraversal0Like' p s a = Cotraversal0Like p s s a a
+
+---------------------------------------------------------------------
+-- 'Cotraversal'
+---------------------------------------------------------------------
+
+type Cotraversal s t a b = forall p. CotraversalLike p s t a b
+
+type Cotraversal' s a = Cotraversal s s a a
+
+type CotraversalLike p s t a b = Coaffine p => CorepnLike p s t a b
+
+type CotraversalLike' p s a = CotraversalLike p s s a a
+
+type Cotraversal1Like p s t a b = Coaffine p => Comonad (Corep p) => CorepnLike p s t a b
+
+---------------------------------------------------------------------
+-- 'Fold0'
+---------------------------------------------------------------------
+
+-- | A 'Fold0' extracts at most one non-summary result from a container.
+--
+type Fold0 s a = forall p. Fold0Like p s a
+
+type Fold0Like p s a = (forall x. Contravariant (p x)) => Traversal0Like p s s a a
+
+---------------------------------------------------------------------
+-- 'Fold1'
+---------------------------------------------------------------------
+
+-- | A 'Fold1' extracts a semigroupal summary from a non-empty container
+--
+type Fold1 s a = forall p. Fold1Like p s a
+
+type Fold1Like p s a = (forall x. Contravariant (p x)) => Traversal1Like p s s a a
+
+type AFold1 r s a = Semigroup r => Optic' (FoldRep r) s a
+
+---------------------------------------------------------------------
+-- 'Fold'
+---------------------------------------------------------------------
+
+-- | A 'Fold' extracts a monoidal summary from a container.
+--
+-- A 'Fold' can interpret 'a' in a monoid so long as 's' can also be interpreted that way.
+--
+type Fold s a = forall p. FoldLike p s a
+
+type FoldLike p s a = (forall x. Contravariant (p x)) => TraversalLike p s s a a
+
+type FoldRep r = Star (Const r)
+
+type AFold r s a = Monoid r => Optic' (FoldRep r) s a
+
+-- | Any lens, traversal, or prism will type-check as a `Handler`
+--
+type Handler s a = forall r. AFold (Endo (Endo r)) s a
+
+type HandlerM m s a = forall r. AFold (Endo (EndoM m r)) s a
+
+---------------------------------------------------------------------
+-- 'Cofold0'
+---------------------------------------------------------------------
+
+type Cofold0 s a = forall p. Cofold0Like p s a
+
+type Cofold0Like p s a = Bifunctor p => Cotraversal0Like p s s a a
+
+---------------------------------------------------------------------
+-- 'Cofold'
+---------------------------------------------------------------------
+
+type Cofold t b = forall p. CofoldLike p t b
+
+type CofoldLike p t b = Bifunctor p => CotraversalLike p t t b b
+
+type CofoldRep r = Costar (Const r)
+
+type ACofold r t b = Optic' (CofoldRep r) t b
+
+---------------------------------------------------------------------
+-- 'Repn'
+---------------------------------------------------------------------
+
+type Repn s t a b = forall p. RepnLike p s t a b
+
+type Repn' s a = Repn s s a a
+
+type RepnLike p s t a b = Representable p => Optic p s t a b
+
+type RepnLike' p s a = RepnLike p s s a a
+
+type ARepn f s t a b = Optic (Star f) s t a b
+
+---------------------------------------------------------------------
+-- 'Corepn'
+---------------------------------------------------------------------
+
+type Corepn s t a b = forall p. CorepnLike p s t a b
+
+type Corepn' s a = Corepn s s a a
+
+type CorepnLike p s t a b = Corepresentable p => Optic p s t a b
+
+type CorepnLike' p s a = CorepnLike p s s a a
+
+type ACorepn f s t a b = Optic (Costar f) s t a b
+
+---------------------------------------------------------------------
+-- 'Re'
+---------------------------------------------------------------------
+
+-- | Turn a 'Lens', 'Prism' or 'Iso' around to build its dual.
+--
+-- If you have an 'Iso', 'from' is a more powerful version of this function
+-- that will return an 'Iso' instead of a mere 'View'.
+--
+-- >>> 5 ^. re _L
+-- Left 5
+--
+-- >>> 6 ^. re (_L . from succ)
+-- Left 7
+--
+-- @
+-- 'review' ≡ 'view' '.' 're'
+-- 'reviews' ≡ 'views' '.' 're'
+-- 'reuse' ≡ 'use' '.' 're'
+-- 'reuses' ≡ 'uses' '.' 're'
+-- @
+--
+-- @
+-- 're' :: 'Prism' s t a b -> 'Reprism' b t
+-- 're' :: 'Iso' s t a b -> 'View' b t
+-- @
+--
+re :: Optic (Re p a b) s t a b -> Optic p b a t s
+re o = (between runRe Re) o id
+{-# INLINE re #-}
+
+-- | The 'Re' type and its instances witness the symmetry between the parameters of a 'Profunctor'.
+--
+newtype Re p s t a b = Re { runRe :: p b a -> p t s }
+
+instance Profunctor p => Profunctor (Re p s t) where
+ dimap f g (Re p) = Re (p . dimap g f)
+
+instance Strong p => Costrong (Re p s t) where
+ unfirst (Re p) = Re (p . pfirst)
+
+instance Costrong p => Strong (Re p s t) where
+ first' (Re p) = Re (p . unfirst)
+
+instance Choice p => Cochoice (Re p s t) where
+ unright (Re p) = Re (p . pright)
+
+instance Cochoice p => Choice (Re p s t) where
+ right' (Re p) = Re (p . unright)
+
+instance (Profunctor p, forall x. Contravariant (p x)) => Bifunctor (Re p s t) where
+ first f (Re p) = Re (p . contramap f)
+
+ second f (Re p) = Re (p . lmap f)
+
+instance Bifunctor p => Contravariant (Re p s t a) where
+ contramap f (Re p) = Re (p . first f)
diff --git a/src/Data/Profunctor/Optic/View.hs b/src/Data/Profunctor/Optic/View.hs
new file mode 100644
index 0000000..f37c72f
--- /dev/null
+++ b/src/Data/Profunctor/Optic/View.hs
@@ -0,0 +1,333 @@
+module Data.Profunctor.Optic.View where
+
+import Data.Profunctor.Optic.Type
+import Data.Profunctor.Optic.Prelude
+import Control.Monad.Reader as Reader
+import Control.Monad.Writer as Writer hiding (Sum(..))
+import Control.Monad.State as State hiding (StateT(..))
+
+---------------------------------------------------------------------
+-- 'View' & 'Review'
+---------------------------------------------------------------------
+
+-- | Build a 'View' from an arbitrary function.
+--
+-- @
+-- 'to' f '.' 'to' g ≡ 'to' (g '.' f)
+-- a '^.' 'to' f ≡ f a
+-- @
+--
+-- >>> ("hello","world") ^. to snd
+-- "world"
+--
+-- >>> 5 ^. to succ
+-- 6
+--
+-- >>> (0, -5) ^. _2 . to abs
+-- 5
+--
+-- @
+-- 'to' :: (s -> a) -> 'View' s a
+-- @
+--
+to :: (s -> a) -> PrimView s t a b
+to f = coercer . lmap f
+{-# INLINE to #-}
+
+-- | Build a 'Review' from an arbitrary function.
+--
+-- @
+-- 'from' ≡ 're' . 'to'
+-- @
+--
+-- >>> (from Prelude.length) # [1,2,3]
+-- 3
+--
+-- @
+-- 'from' :: (b -> t) -> 'Review' t b
+-- @
+--
+from :: (b -> t) -> PrimReview s t a b
+from f = coercel . rmap f
+{-# INLINE from #-}
+
+-- ^ @
+-- 'toBoth' :: 'View' s a -> 'View' s b -> 'View' s (a, b)
+-- @
+--
+toBoth :: AView s a1 -> AView s a2 -> PrimView s t (a1 , a2) b
+toBoth l r = to (view l &&& view r)
+{-# INLINE toBoth #-}
+
+-- | TODO: Document
+--
+fromBoth :: AReview t1 b -> AReview t2 b -> PrimReview s (t1 , t2) a b
+fromBoth l r = from (review l &&& review r)
+{-# INLINE fromBoth #-}
+
+-- | TODO: Document
+--
+toEither :: AView s1 a -> AView s2 a -> PrimView (s1 + s2) t a b
+toEither l r = to (view l ||| view r)
+{-# INLINE toEither #-}
+
+-- | TODO: Document
+--
+fromEither :: AReview t b1 -> AReview t b2 -> PrimReview s t a (b1 + b2)
+fromEither l r = from (review l ||| review r)
+{-# INLINE fromEither #-}
+
+-- ^ @
+-- 'cloneView' :: 'AView' s a -> 'View' s a
+-- 'cloneView' :: 'Monoid' a => 'AView' s a -> 'Fold' s a
+-- @
+--
+cloneView :: AView s a -> PrimView s s a a
+cloneView = to . view
+{-# INLINE cloneView #-}
+
+-- | TODO: Document
+--
+cloneReview :: AReview t b -> PrimReview t t b b
+cloneReview = from . review
+{-# INLINE cloneReview #-}
+
+---------------------------------------------------------------------
+-- Primitive operators
+---------------------------------------------------------------------
+
+-- | Map each part of a structure viewed to a SEC.
+--
+-- @
+-- 'Data.Foldable.foldMap' = 'viewOf' 'folding''
+-- 'viewOf' ≡ 'views'
+-- @
+--
+-- >>> viewOf both id (["foo"], ["bar", "baz"])
+-- ["foo","bar","baz"]
+--
+-- @
+-- 'viewOf' :: 'Iso'' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'Lens'' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'Monoid' r => 'Prism'' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'Monoid' r => 'Traversal'' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'Monoid' r => 'Traversal0'' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'Semigroup' r => 'Traversal1'' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'Monoid' r => 'Fold' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'Semigroup' r => 'Fold1' s a -> (a -> r) -> s -> r
+-- 'viewOf' :: 'AView' s a -> (a -> r) -> s -> r
+-- @
+--
+viewOf :: Optic' (FoldRep r) s a -> (a -> r) -> s -> r
+viewOf = between ((getConst .) . runStar) (Star . (Const . ))
+{-# INLINE viewOf #-}
+
+-- | TODO: Document
+--
+reviewOf :: Optic' (CofoldRep r) t b -> (r -> b) -> r -> t
+reviewOf = between ((. Const) . runCostar) (Costar . (. getConst))
+{-# INLINE reviewOf #-}
+
+---------------------------------------------------------------------
+-- Common 'View's and 'Review's
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+coercedr :: PrimView a x a y
+coercedr = coercer
+{-# INLINE coercedr #-}
+
+-- | TODO: Document
+--
+coercedl :: PrimReview x b y b
+coercedl = coercel
+{-# INLINE coercedl #-}
+
+-- | TODO: Document
+--
+_1' :: PrimView (a , c) (b , c) a b
+_1' = to fst
+
+-- | TODO: Document
+--
+_2' :: PrimView (c , a) (c , b) a b
+_2' = to snd
+
+-- | TODO: Document
+--
+_L' :: PrimReview (a + c) (b + c) a b
+_L' = from Left
+
+-- | TODO: Document
+--
+_R' :: PrimReview (c + a) (c + b) a b
+_R' = from Right
+
+-- | Build a constant-valued (index-preserving) 'PrimView' from an arbitrary value.
+--
+-- @
+-- 'like' a '.' 'like' b ≡ 'like' b
+-- a '^.' 'like' b ≡ b
+-- a '^.' 'like' b ≡ a '^.' 'to' ('const' b)
+-- @
+--
+-- This can be useful as a second case 'failing' a 'Fold'
+-- e.g. @foo `failing` 'like' 0@
+--
+like :: a -> PrimView s t a b
+like = to . const
+{-# INLINE like #-}
+
+-- | Build a constant-valued (index-preserving) 'PrimReview' from an arbitrary value.
+--
+-- @
+-- 'relike' a '.' 'relike' b ≡ 'relike' a
+-- 'relike' a '#' b ≡ a
+-- 'relike' a '#' b ≡ 'from' ('const' a) '#' b
+-- @
+--
+relike :: t -> PrimReview s t a b
+relike = from . const
+{-# INLINE relike #-}
+
+---------------------------------------------------------------------
+-- Derived operators
+---------------------------------------------------------------------
+
+infixl 8 ^.
+
+-- | TODO: Document
+--
+(^.) :: s -> AView s a -> a
+(^.) = flip view
+{-# INLINE ( ^. ) #-}
+
+infixr 8 #
+
+-- | An infix alias for 'review'. Dual to '^.'.
+--
+-- @
+-- 'from' f # x ≡ f x
+-- l # x ≡ x '^.' 're' l
+-- @
+--
+-- This is commonly used when using a 'Prism' as a smart constructor.
+--
+-- >>> _Left # 4
+-- Left 4
+--
+-- But it can be used for any 'Prism'
+--
+-- >>> base 16 # 123
+-- "7b"
+--
+-- @
+-- (#) :: 'Iso'' s a -> a -> s
+-- (#) :: 'Prism'' s a -> a -> s
+-- (#) :: 'Review' s a -> a -> s
+-- (#) :: 'Equality'' s a -> a -> s
+-- @
+--
+(#) :: AReview t b -> b -> t
+o # b = review o b
+{-# INLINE ( # ) #-}
+
+-- ^ @
+-- 'view o ≡ foldMapOf o id'
+-- 'review' ≡ 'view' '.' 're'
+-- 'reviews' ≡ 'views' '.' 're'
+-- @
+--
+view :: MonadReader s m => AView s a -> m a
+view = (`views` id)
+{-# INLINE view #-}
+
+-- ^ @
+-- 'review o ≡ cofoldMapOf o id'
+-- @
+--
+review :: MonadReader b m => AReview t b -> m t
+review = (`reviews` id)
+{-# INLINE review #-}
+
+-- ^ @
+-- 'views o f ≡ foldMapOf o f'
+-- @
+views :: MonadReader s m => Optic' (FoldRep r) s a -> (a -> r) -> m r
+views o f = Reader.asks $ viewOf o f
+{-# INLINE views #-}
+
+-- | This can be used to turn an 'Iso' or 'Prism' around and 'view' a value (or the current environment) through it the other way,
+-- applying a function.
+--
+-- @
+-- 'reviews' ≡ 'views' '.' 're'
+-- 'reviews' ('from' f) g ≡ g '.' f
+-- @
+--
+-- >>> reviews _Left isRight "mustard"
+-- False
+--
+-- >>> reviews (from succ) (*2) 3
+-- 8
+--
+-- Usually this function is used in the @(->)@ 'Monad' with a 'Prism' or 'Iso', in which case it may be useful to think of
+-- it as having one of these more restricted type signatures:
+--
+-- @
+-- 'reviews' :: 'Iso'' s a -> (s -> r) -> a -> r
+-- 'reviews' :: 'Prism'' s a -> (s -> r) -> a -> r
+-- @
+--
+-- However, when working with a 'Monad' transformer stack, it is sometimes useful to be able to 'review' the current environment, in which case
+-- it may be beneficial to think of it as having one of these slightly more liberal type signatures:
+--
+-- @
+-- 'reviews' :: 'MonadReader' a m => 'Iso'' s a -> (s -> r) -> m r
+-- 'reviews' :: 'MonadReader' a m => 'Prism'' s a -> (s -> r) -> m r
+-- @
+-- ^ @
+-- 'reviews o f ≡ cofoldMapOf o f'
+-- @
+--
+reviews :: MonadReader r m => ACofold r t b -> (r -> b) -> m t
+reviews o f = Reader.asks $ reviewOf o f
+{-# INLINE reviews #-}
+
+---------------------------------------------------------------------
+-- 'MonadState' and 'MonadWriter'
+---------------------------------------------------------------------
+
+-- | TODO: Document
+--
+use :: MonadState s m => AView s a -> m a
+use o = State.gets (view o)
+{-# INLINE use #-}
+
+-- | Extracts the portion of a log that is focused on by a 'View'.
+--
+-- Given a 'Fold' or a 'Traversal', then a monoidal summary of the parts
+-- of the log that are visited will be returned.
+--
+-- @
+-- 'listening' :: 'MonadWriter' w m => 'View' w u -> m a -> m (a, u)
+-- 'listening' :: 'MonadWriter' w m => 'Lens'' w u -> m a -> m (a, u)
+-- 'listening' :: 'MonadWriter' w m => 'Iso'' w u -> m a -> m (a, u)
+-- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Fold' w u -> m a -> m (a, u)
+-- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Traversal'' w u -> m a -> m (a, u)
+-- 'listening' :: ('MonadWriter' w m, 'Monoid' u) => 'Prism'' w u -> m a -> m (a, u)
+-- @
+listening :: MonadWriter w m => AView w u -> m a -> m (a, u)
+listening l m = do
+ (a, w) <- Writer.listen m
+ return (a, view l w)
+{-# INLINE listening #-}
+
+-- | TODO: Document
+--
+listenings :: MonadWriter w m => Optic' (FoldRep v) w u -> (u -> v) -> m a -> m (a, v)
+listenings l uv m = do
+ (a, w) <- listen m
+ return (a, views l uv w)
+{-# INLINE listenings #-}
diff --git a/src/Data/Profunctor/Orphan.hs b/src/Data/Profunctor/Orphan.hs
new file mode 100644
index 0000000..42645c7
--- /dev/null
+++ b/src/Data/Profunctor/Orphan.hs
@@ -0,0 +1,61 @@
+module Data.Profunctor.Orphan where
+
+import Control.Applicative
+import Control.Comonad
+import Control.Foldl
+import Data.Distributive
+import Data.Bifunctor
+import Data.Functor.Contravariant
+import Data.Functor.Rep as Functor
+import Data.Profunctor
+import Data.Profunctor.Rep as Profunctor
+import Data.Profunctor.Sieve
+
+import Prelude
+
+instance Contravariant f => Contravariant (Star f a) where
+ contramap f (Star g) = Star $ contramap f . g
+
+instance Contravariant f => Bifunctor (Costar f) where
+ first f (Costar g) = Costar $ g . contramap f
+
+ second f (Costar g) = Costar $ f . g
+
+instance Cochoice (Forget r) where
+ unleft (Forget f) = Forget $ f . Left
+
+ unright (Forget f) = Forget $ f . Right
+
+instance Comonad f => Strong (Costar f) where
+ first' (Costar f) = Costar $ \x -> (f (fmap fst x), snd (extract x))
+
+ second' (Costar f) = Costar $ \x -> (fst (extract x), f (fmap snd x))
+
+instance Distributive (Fold a) where
+ distribute = distributeRep
+ {-# INLINE distribute #-}
+
+instance Functor.Representable (Fold a) where
+ type Rep (Fold a) = [a]
+ index = cosieve
+ tabulate = cotabulate
+
+instance Costrong Fold where
+ unfirst = unfirstCorep
+ unsecond = unsecondCorep
+
+instance Closed Fold where
+ closed (Fold h z k) = Fold (liftA2 h) (pure z) (\f x -> k (f x))
+
+-- | >>> cosieve (Fold (+) 0 id) [1,2,3]
+-- 6
+instance Cosieve Fold [] where
+ cosieve (Fold h0 z0 k0) as0 = go k0 h0 z0 as0 where
+ go k _ z [] = k z
+ go k h z (a:as) = go k h (h z a) as
+ {-# INLINE cosieve #-}
+
+instance Corepresentable Fold where
+ type Corep Fold = []
+ cotabulate f = Fold (flip (:)) [] (f . reverse)
+ {-# INLINE cotabulate #-}