diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,16 @@
+# 0.8.0
+
+- Split `align` and `alignWith` into own class: `Semialign`.
+- `ialign` has default implementation
+- Add `Semialign` `NonEmpty` and `Identity` instances
+- Add `Swap` and `Assoc` instances (type classes from `assoc` package)
+- Move optics into `Data.These.Lens` module,
+  and and some combinators `Data.These.Combinators`.
+  Also some combinators are renamed, so naming is now consistent.
+  As the result `Data.These` has very minimal exports.
+- Change type of `partitionThese` (nested pairs to triple)
+- Add `partitionHereThere :: [These a b] -> ([a],[b])`
+
 # 0.7.6
 
 - Tigthen lower bounds
diff --git a/Control/Monad/Chronicle/Class.hs b/Control/Monad/Chronicle/Class.hs
--- a/Control/Monad/Chronicle/Class.hs
+++ b/Control/Monad/Chronicle/Class.hs
@@ -19,6 +19,7 @@
     ) where
 
 import Data.These
+import Data.These.Combinators
 import Control.Applicative
 import Control.Monad.Trans.Chronicle (ChronicleT, runChronicle)
 import qualified Control.Monad.Trans.Chronicle as Ch
@@ -97,13 +98,13 @@
     dictate c = These c ()
     confess c = This c
     memento (This c) = That (Left c)
-    memento m = mapThat Right m
+    memento m = mapThere Right m
     absolve x (This _) = That x
     absolve _ (That x) = That x
     absolve _ (These _ x) = That x
     condemn (These c _) = This c
     condemn m = m
-    retcon = mapThis
+    retcon = mapHere
     chronicle = id
 
 instance (Semigroup c, Monad m) => MonadChronicle c (ChronicleT c m) where
diff --git a/Control/Monad/Trans/Chronicle.hs b/Control/Monad/Trans/Chronicle.hs
--- a/Control/Monad/Trans/Chronicle.hs
+++ b/Control/Monad/Trans/Chronicle.hs
@@ -37,6 +37,7 @@
 import Control.Monad.RWS.Class
 import Prelude
 import Data.These
+import Data.These.Combinators (mapHere)
 
 -- --------------------------------------------------------------------------
 -- | A chronicle monad parameterized by the output type @c@.
@@ -208,5 +209,5 @@
 --   
 --   Equivalent to 'censor' for the 'Writer' monad.
 retcon :: (Semigroup c, Monad m) => (c -> c) -> ChronicleT c m a -> ChronicleT c m a
-retcon f m = ChronicleT $ mapThis f `liftM` runChronicleT m
+retcon f m = ChronicleT $ mapHere f `liftM` runChronicleT m
 
diff --git a/Data/Align.hs b/Data/Align.hs
--- a/Data/Align.hs
+++ b/Data/Align.hs
@@ -6,7 +6,8 @@
 -- shapes, plus traversal of (bi)foldable (bi)functors through said
 -- functors.
 module Data.Align (
-      Align(..)
+      Semialign (..)
+    , Align(..)
     -- * Specialized aligns
     , malign, salign, padZip, padZipWith
     , lpadZip, lpadZipWith
@@ -36,6 +37,7 @@
 import Data.Functor.Product              (Product (..))
 import Data.Hashable                     (Hashable (..))
 import Data.HashMap.Strict               (HashMap)
+import Data.List.NonEmpty                (NonEmpty (..))
 import Data.Maybe                        (catMaybes)
 import Data.Semigroup                    (Semigroup (..))
 import Data.Sequence                     (Seq)
@@ -64,8 +66,8 @@
 import qualified Data.IntMap.Lazy as IntMap
 
 #if MIN_VERSION_containers(0,5,9)
-import qualified Data.Map.Merge.Lazy as Map
 import qualified Data.IntMap.Merge.Lazy as IntMap
+import qualified Data.Map.Merge.Lazy    as Map
 #endif
 
 -- containers <0.5
@@ -94,17 +96,15 @@
 -- Maybe (These b c) ~ (a -> Maybe b, a -> Maybe c))@. This insight
 -- is due to rwbarton.
 --
--- Minimal definition: @nil@ and either @align@ or @alignWith@.
+-- Minimal definition: either @align@ or @alignWith@.
 --
 -- == Laws:
 --
 -- @
--- (\`align` nil) = fmap This
--- (nil \`align`) = fmap That
 -- join align = fmap (join These)
 -- align (f \<$> x) (g \<$> y) = bimap f g \<$> align x y
 -- alignWith f a b = f \<$> align a b
--- align (align x y) z = fmap assoc (align x (align y z))
+-- align x (align y z) = fmap assoc (align (align x y) z)
 -- @
 --
 -- /Note:/ @'join' f x = f x x@
@@ -118,11 +118,7 @@
 --          = mapMaybe justHere (toList (align x y))
 -- @
 --
-class (Functor f) => Align f where
-    -- | An empty strucutre. @'align'@ing with @'nil'@ will produce a structure with
-    --   the same shape and elements as the other input, modulo @'This'@ or @'That'@.
-    nil :: f a
-
+class Functor f => Semialign f where
     -- | Analogous to @'zip'@, combines two structures by taking the union of
     --   their shapes and using @'These'@ to hold the elements.
     align :: f a -> f b -> f (These a b)
@@ -134,9 +130,23 @@
     alignWith f a b = f <$> align a b
 
 #if __GLASGOW_HASKELL__ >= 707
-    {-# MINIMAL nil , (align | alignWith) #-}
+    {-# MINIMAL align | alignWith #-}
 #endif
 
+-- | A unit of 'align'.
+--
+-- == Laws:
+--
+-- @
+-- (\`align` nil) = fmap This
+-- (nil \`align`) = fmap That
+-- @
+--
+class Semialign f => Align f where
+    -- | An empty structure. @'align'@ing with @'nil'@ will produce a structure with
+    --   the same shape and elements as the other input, modulo @'This'@ or @'That'@.
+    nil :: f a
+
 {-# RULES
 
 "align nil nil" align nil nil = nil
@@ -147,9 +157,14 @@
 
  #-}
 
+-------------------------------------------------------------------------------
+-- Instances
+-------------------------------------------------------------------------------
 
 instance Align Maybe where
     nil = Nothing
+
+instance Semialign Maybe where
     align Nothing Nothing = Nothing
     align (Just a) Nothing = Just (This a)
     align Nothing (Just b) = Just (That b)
@@ -157,17 +172,26 @@
 
 instance Align [] where
     nil = []
+
+instance Semialign [] where
     align xs [] = This <$> xs
     align [] ys = That <$> ys
     align (x:xs) (y:ys) = These x y : align xs ys
 
+-- @since 0.8
+instance Semialign NonEmpty where
+    align (x :| xs) (y :| ys) = These x y :| align xs ys
+
 instance Align ZipList where
     nil = ZipList []
-    align (ZipList xs) (ZipList ys) = ZipList (align xs ys)
 
+instance Semialign ZipList where
+    alignWith f (ZipList xs) (ZipList ys) = ZipList (alignWith f xs ys)
+
 instance Align Seq where
     nil = Seq.empty
 
+instance Semialign Seq where
     align xs ys = case compare xn yn of
         EQ -> Seq.zipWith fc xs ys
         LT -> case Seq.splitAt xn ys of
@@ -192,6 +216,8 @@
 
 instance (Ord k) => Align (Map k) where
     nil = Map.empty
+
+instance (Ord k) => Semialign (Map k) where
 #if MIN_VERSION_containers(0,5,9)
     alignWith f = Map.merge (Map.mapMissing (\_ x ->  f (This x)))
                             (Map.mapMissing (\_ y ->  f (That y)))
@@ -206,6 +232,8 @@
 
 instance Align IntMap where
     nil = IntMap.empty
+
+instance Semialign IntMap where
 #if MIN_VERSION_containers(0,5,9)
     alignWith f = IntMap.merge (IntMap.mapMissing (\_ x ->  f (This x)))
                                (IntMap.mapMissing (\_ y ->  f (That y)))
@@ -218,13 +246,22 @@
             merge _ _ = oops "Align IntMap: merge"
 #endif
 
+-- @since 0.8
+instance Semialign Identity where
+    alignWith f (Identity a) (Identity b) = Identity (f (These a b))
+
 instance (Align f, Align g) => Align (Product f g) where
     nil = Pair nil nil
+
+instance (Semialign f, Semialign g) => Semialign (Product f g) where
     align (Pair a b) (Pair c d) = Pair (align a c) (align b d)
+    alignWith f (Pair a b) (Pair c d) = Pair (alignWith f a c) (alignWith f b d)
 
 -- Based on the Data.Vector.Fusion.Stream.Monadic zipWith implementation
 instance Monad m => Align (Stream m) where
     nil = Stream.empty
+
+instance Monad m => Semialign (Stream m) where
 #if MIN_VERSION_vector(0,11,0)
     alignWith  f (Stream stepa ta) (Stream stepb tb)
       = Stream step (ta, tb, Nothing, False)
@@ -254,12 +291,16 @@
 #if MIN_VERSION_vector(0,11,0)
 instance Monad m => Align (Bundle m v) where
     nil = Bundle.empty
+
+instance Monad m => Semialign (Bundle m v) where
     alignWith f Bundle{sElems = sa, sSize = na} Bundle{sElems = sb, sSize = nb}
       = Bundle.fromStream (alignWith f sa sb) (Bundle.larger na nb)
 #endif
 
 instance Align V.Vector where
   nil = Data.Vector.Generic.empty
+
+instance Semialign V.Vector where
   alignWith = alignVectorWith
 
 alignVectorWith :: (Vector v a, Vector v b, Vector v c)
@@ -268,6 +309,8 @@
 
 instance (Eq k, Hashable k) => Align (HashMap k) where
     nil = HashMap.empty
+
+instance (Eq k, Hashable k) => Semialign (HashMap k) where
     align m n = HashMap.unionWith merge (HashMap.map This m) (HashMap.map That n)
       where merge (This a) (That b) = These a b
             merge _ _ = oops "Align HashMap: merge"
diff --git a/Data/Align/Indexed.hs b/Data/Align/Indexed.hs
--- a/Data/Align/Indexed.hs
+++ b/Data/Align/Indexed.hs
@@ -10,7 +10,7 @@
     AlignWithIndex (..),
     ) where
 
-import Control.Lens          (FunctorWithIndex)
+import Control.Lens          (FunctorWithIndex (imap))
 import Data.Vector.Instances ()
 
 import Data.Align
@@ -25,20 +25,19 @@
 import Data.Sequence       (Seq)
 import Data.Vector         (Vector)
 
-import qualified Data.Align.Key as Key
-
 -- | Keyed version of 'Align'.
 --
 -- @since 0.7.6
-class (FunctorWithIndex i f, Align f) => AlignWithIndex i f | f -> i where
+class (FunctorWithIndex i f, Semialign f) => AlignWithIndex i f | f -> i where
     -- | Analogous to @'alignWith'@, but also provides an index.
     ialign :: (i -> These a b -> c) -> f a -> f b -> f c
+    ialign f a b = imap f (align a b)
 
-instance AlignWithIndex () Maybe where ialign = Key.alignWithKey
-instance AlignWithIndex Int [] where ialign = Key.alignWithKey
-instance AlignWithIndex Int ZipList where ialign = Key.alignWithKey
-instance AlignWithIndex Int Seq where ialign = Key.alignWithKey
-instance AlignWithIndex Int IntMap where ialign = Key.alignWithKey
-instance Ord k => AlignWithIndex k (Map k) where ialign = Key.alignWithKey
-instance (Eq k, Hashable k) => AlignWithIndex k (HashMap k) where ialign = Key.alignWithKey
-instance AlignWithIndex Int Vector where ialign = Key.alignWithKey
+instance AlignWithIndex () Maybe
+instance AlignWithIndex Int []
+instance AlignWithIndex Int ZipList
+instance AlignWithIndex Int Seq
+instance AlignWithIndex Int IntMap
+instance Ord k => AlignWithIndex k (Map k)
+instance (Eq k, Hashable k) => AlignWithIndex k (HashMap k)
+instance AlignWithIndex Int Vector
diff --git a/Data/Align/Key.hs b/Data/Align/Key.hs
--- a/Data/Align/Key.hs
+++ b/Data/Align/Key.hs
@@ -26,7 +26,7 @@
 -- | Keyed version of 'Align'.
 --
 -- @since 0.7.1
-class (Keyed f, Align f) => AlignWithKey f where
+class (Keyed f, Semialign f) => AlignWithKey f where
     -- | Analogous to @'alignWith'@, but also provides an index.
     alignWithKey :: (Key f -> These a b -> c) -> f a -> f b -> f c
     alignWithKey f a b = mapWithKey f (align a b)
diff --git a/Data/These.hs b/Data/These.hs
--- a/Data/These.hs
+++ b/Data/These.hs
@@ -14,59 +14,26 @@
     , mergeThese
     , mergeTheseWith
 
-    -- * Traversals
-    , here, there
-
-    -- * Half selections
-    , justHere
-    , justThere
-
-    -- * Prisms
-    , _This, _That, _These
-
-    -- * Case selections
-    , justThis
-    , justThat
-    , justThese
-
-    , catThis
-    , catThat
-    , catThese
-
+    -- * Partition
     , partitionThese
-
-    -- * Case predicates
-    , isThis
-    , isThat
-    , isThese
-
-    -- * Map operations
-    , mapThese
-    , mapThis
-    , mapThat
-
-    , bitraverseThese
-
-    -- * Associativity and commutativity
-    , swap
-    , assoc
-    , reassoc
+    , partitionHereThere
     ) where
 
 import Prelude ()
 import Prelude.Compat
 
 import Control.DeepSeq              (NFData (..))
-import Control.Lens                 (Prism', Swapped (..), iso, prism)
+import Control.Lens                 (Swapped (..), iso)
 import Data.Aeson                   (FromJSON (..), ToJSON (..), (.=))
 import Data.Bifoldable              (Bifoldable (..))
 import Data.Bifunctor               (Bifunctor (..))
+import Data.Bifunctor.Assoc         (Assoc (..))
+import Data.Bifunctor.Swap          (Swap (..))
 import Data.Binary                  (Binary (..))
 import Data.Bitraversable           (Bitraversable (..))
 import Data.Data                    (Data, Typeable)
 import Data.Functor.Bind            (Apply (..), Bind (..))
 import Data.Hashable                (Hashable (..))
-import Data.Maybe                   (isJust, mapMaybe)
 import Data.Semigroup               (Semigroup (..))
 import Data.Semigroup.Bifoldable    (Bifoldable1 (..))
 import Data.Semigroup.Bitraversable (Bitraversable1 (..))
@@ -100,6 +67,10 @@
 data These a b = This a | That b | These a b
     deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
 
+-------------------------------------------------------------------------------
+-- Eliminators
+-------------------------------------------------------------------------------
+
 -- | Case analysis for the 'These' type.
 these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
 these l _ _ (This a) = l a
@@ -108,215 +79,71 @@
 
 -- | Takes two default values and produces a tuple.
 fromThese :: a -> b -> These a b -> (a, b)
-fromThese _ x (This a   ) = (a, x)
-fromThese a _ (That x   ) = (a, x)
-fromThese _ _ (These a x) = (a, x)
+fromThese x y = these (`pair` y) (x `pair`) pair where
+    pair = (,)
 
 -- | Coalesce with the provided operation.
 mergeThese :: (a -> a -> a) -> These a a -> a
 mergeThese = these id id
 
--- | BiMap and coalesce results with the provided operation.
+-- | 'bimap' and coalesce results with the provided operation.
 mergeTheseWith :: (a -> c) -> (b -> c) -> (c -> c -> c) -> These a b -> c
-mergeTheseWith f g op t = mergeThese op $ mapThese f g t
-
--- | A 'Control.Lens.Traversal' of the first half of a 'These', suitable for use with "Control.Lens".
---
--- @
--- 'here' :: 'Control.Lens.Traversal' ('These' a t) ('These' b t) a b
--- @
---
--- >>> over here show (That 1)
--- That 1
---
--- >>> over here show (These 'a' 2)
--- These "'a'" 2
---
-here :: (Applicative f) => (a -> f b) -> These a t -> f (These b t)
-here f (This x) = This <$> f x
-here f (These x y) = flip These y <$> f x
-here _ (That x) = pure (That x)
-
--- | A 'Control.Lens.Traversal' of the second half of a 'These', suitable for use with "Control.Lens".
---
--- @
--- 'there' :: 'Control.Lens.Traversal' ('These' t b) ('These' t b) a b
--- @
---
--- >>> over there show (That 1)
--- That "1"
---
--- >>> over there show (These 'a' 2)
--- These 'a' "2"
---
-there :: (Applicative f) => (a -> f b) -> These t a -> f (These t b)
-there _ (This x) = pure (This x)
-there f (These x y) = These x <$> f y
-there f (That x) = That <$> f x
-
--- | @'justHere' = 'Control.Lens.preview' 'here'@
---
--- >>> justHere (This 'x')
--- Just 'x'
---
--- >>> justHere (That 'y')
--- Nothing
---
--- >>> justHere (These 'x' 'y')
--- Just 'x'
---
-justHere :: These a b -> Maybe a
-justHere (This a)    = Just a
-justHere (That _)    = Nothing
-justHere (These a _) = Just a
-
--- | @'justThere' = 'Control.Lens.preview' 'there'@
---
--- >>> justThere (This 'x')
--- Nothing
---
--- >>> justThere (That 'y')
--- Just 'y'
---
--- >>> justThere (These 'x' 'y')
--- Just 'y'
---
-justThere :: These a b -> Maybe b
-justThere (This _)    = Nothing
-justThere (That b)    = Just b
-justThere (These _ b) = Just b
-
--- | A 'Control.Lens.Prism'' selecting the 'This' constructor.
---
--- /Note:/ cannot change type.
-_This :: Prism' (These a b) a
-_This = prism This (these Right (Left . That) (\x y -> Left $ These x y))
-
--- | A 'Control.Lens.Prism'' selecting the 'That' constructor.
---
--- /Note:/ cannot change type.
-_That :: Prism' (These a b) b
-_That = prism That (these (Left . This) Right (\x y -> Left $ These x y))
-
--- | A 'Control.Lens.Prism'' selecting the 'These' constructor. 'These' names are ridiculous!
---
--- /Note:/ cannot change type.
-_These :: Prism' (These a b) (a, b)
-_These = prism (uncurry These) (these (Left . This) (Left . That) (\x y -> Right (x, y)))
-
-
--- | @'justThis' = 'Control.Lens.preview' '_This'@
-justThis :: These a b -> Maybe a
-justThis (This a) = Just a
-justThis _        = Nothing
-
--- | @'justThat' = 'Control.Lens.preview' '_That'@
-justThat :: These a b -> Maybe b
-justThat (That x) = Just x
-justThat _        = Nothing
-
--- | @'justThese' = 'Control.Lens.preview' '_These'@
-justThese :: These a b -> Maybe (a, b)
-justThese (These a x) = Just (a, x)
-justThese _           = Nothing
-
-
-isThis, isThat, isThese :: These a b -> Bool
--- | @'isThis' = 'isJust' . 'justThis'@
-isThis  = isJust . justThis
-
--- | @'isThat' = 'isJust' . 'justThat'@
-isThat  = isJust . justThat
-
--- | @'isThese' = 'isJust' . 'justThese'@
-isThese = isJust . justThese
-
--- | 'Bifunctor' map.
-mapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
-mapThese f _ (This  a  ) = This (f a)
-mapThese _ g (That    x) = That (g x)
-mapThese f g (These a x) = These (f a) (g x)
-
--- | 'Bitraversable'.
---
--- @since 0.7.5
-bitraverseThese :: Applicative f => (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
-bitraverseThese f _ (This x) = This <$> f x
-bitraverseThese _ g (That x) = That <$> g x
-bitraverseThese f g (These x y) = These <$> f x <*> g y
-
--- | @'mapThis' = 'Control.Lens.over' 'here'@
-mapThis :: (a -> c) -> These a b -> These c b
-mapThis f = mapThese f id
-
--- | @'mapThat' = 'Control.Lens.over' 'there'@
-mapThat :: (b -> d) -> These a b -> These a d
-mapThat f = mapThese id f
-
--- | Select all 'This' constructors from a list.
-catThis :: [These a b] -> [a]
-catThis = mapMaybe justThis
-
--- | Select all 'That' constructors from a list.
-catThat :: [These a b] -> [b]
-catThat = mapMaybe justThat
+mergeTheseWith f g op t = mergeThese op $ bimap f g t
 
--- | Select all 'These' constructors from a list.
-catThese :: [These a b] -> [(a, b)]
-catThese = mapMaybe justThese
+-------------------------------------------------------------------------------
+-- Partitioning
+-------------------------------------------------------------------------------
 
 -- | Select each constructor and partition them into separate lists.
-partitionThese :: [These a b] -> ( [(a, b)], ([a], [b]) )
-partitionThese []             = ([], ([], []))
-partitionThese (These x y:xs) = first ((x, y):)      $ partitionThese xs
-partitionThese (This  x  :xs) = second (first  (x:)) $ partitionThese xs
-partitionThese (That    y:xs) = second (second (y:)) $ partitionThese xs
-
--- | 'These' is commutative.
---
--- @
--- 'swap' . 'swap' = 'id'
--- @
---
--- @since 0.7.6
-swap :: These a b -> These b a
-swap (This a)    = That a
-swap (That b)    = This b
-swap (These a b) = These b a
-
--- | 'These' is associative.
---
--- @
--- 'assoc' . 'reassoc' = 'id'
--- 'reassoc' . 'assoc' = 'id'
--- @
---
--- @since 0.7.6
-assoc :: These a (These b c) -> These (These a b) c
-assoc (This a)              = This (This a)
-assoc (That (This b))       = This (That b)
-assoc (That (That c))       = That c
-assoc (That (These b c))    = These (That b) c
-assoc (These a (This b))    = This (These a b)
-assoc (These a (That c))    = These (This a) c
-assoc (These a (These b c)) = These (These a b) c
+partitionThese :: [These a b] -> ([a], [b], [(a, b)])
+partitionThese []     = ([], [], [])
+partitionThese (t:ts) = case t of
+    This x    -> (x : xs,     ys,         xys)
+    That y    -> (    xs, y : ys,         xys)
+    These x y -> (    xs,     ys, (x,y) : xys)
+  where
+    ~(xs,ys,xys) = partitionThese ts
 
--- | 'These is associative. See 'assoc'.
+-- | Select 'here' and 'there' elements and partition them into separate lists.
 --
--- @since 0.7.6
-reassoc :: These (These a b) c -> These a (These b c)
-reassoc (This (This a))       = This a
-reassoc (This (That b))       = That (This b)
-reassoc (That c)              = That (That c)
-reassoc (These (That b) c)    = That (These b c)
-reassoc (This (These a b))    = These a (This b)
-reassoc (These (This a) c)    = These a (That c)
-reassoc (These (These a b) c) = These a (These b c)
+-- @since 0.8
+partitionHereThere :: [These a b] -> ([a], [b])
+partitionHereThere []     = ([], [])
+partitionHereThere (t:ts) = case t of
+    This x     -> (x : xs,     ys)
+    That y     -> (    xs, y : ys)
+    These x  y -> (x : xs, y : ys)
+  where
+    ~(xs,ys) = partitionHereThere ts
 
 -------------------------------------------------------------------------------
 -- Instances
 -------------------------------------------------------------------------------
 
+-- | @since 0.8
+instance Swap These where
+    swap (This a)    = That a
+    swap (That b)    = This b
+    swap (These a b) = These b a
+
+-- | @since 0.8
+instance Assoc These where
+    assoc (This (This a))       = This a
+    assoc (This (That b))       = That (This b)
+    assoc (That c)              = That (That c)
+    assoc (These (That b) c)    = That (These b c)
+    assoc (This (These a b))    = These a (This b)
+    assoc (These (This a) c)    = These a (That c)
+    assoc (These (These a b) c) = These a (These b c)
+
+    unassoc (This a)              = This (This a)
+    unassoc (That (This b))       = This (That b)
+    unassoc (That (That c))       = That c
+    unassoc (That (These b c))    = These (That b) c
+    unassoc (These a (This b))    = This (These a b)
+    unassoc (These a (That c))    = These (This a) c
+    unassoc (These a (These b c)) = These (These a b) c
+
 instance (Semigroup a, Semigroup b) => Semigroup (These a b) where
     This  a   <> This  b   = This  (a <> b)
     This  a   <> That    y = These  a             y
@@ -347,9 +174,9 @@
     sequenceA (These a x) = These a <$> x
 
 instance Bifunctor These where
-    bimap = mapThese
-    first = mapThis
-    second = mapThat
+    bimap f _ (This  a  ) = This (f a)
+    bimap _ g (That    x) = That (g x)
+    bimap f g (These a x) = These (f a) (g x)
 
 instance Bifoldable These where
     bifold = these id id mappend
@@ -360,7 +187,9 @@
     bifold1 = these id id (<>)
 
 instance Bitraversable These where
-    bitraverse = bitraverseThese
+    bitraverse f _ (This x) = This <$> f x
+    bitraverse _ g (That x) = That <$> g x
+    bitraverse f g (These x y) = These <$> f x <*> g y
 
 instance Bitraversable1 These where
     bitraverse1 f _ (This x) = This <$> f x
diff --git a/Data/These/Combinators.hs b/Data/These/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/Data/These/Combinators.hs
@@ -0,0 +1,247 @@
+-- | This module provides
+--
+-- * specialised versions of class members e.g. 'bitraverseThese'
+-- * non-lens variants of "Data.These.Lens" things, e.g 'justHere'
+module Data.These.Combinators (
+    -- * Specialised combinators
+    -- ** Bifunctor
+    bimapThese,
+    mapHere,
+    mapThere,
+    -- ** Bitraversable
+    bitraverseThese,
+    -- ** Associativity and commutativity
+    swapThese,
+    assocThese,
+    unassocThese,
+
+    -- * Other operations
+    -- ** preview
+    --
+    -- |
+    -- @
+    -- 'justThis'  = 'Control.Lens.preview' '_This'
+    -- 'justThat'  = 'Control.Lens.preview' '_That'
+    -- 'justThese' = 'Control.Lens.preview' '_These'
+    -- 'justHere'  = 'Control.Lens.preview' 'here'
+    -- 'justThere' = 'Control.Lens.preview' 'there'
+    -- @
+    justThis,
+    justThat,
+    justThese,
+    justHere,
+    justThere,
+
+    -- ** toListOf
+    --
+    -- |
+    -- @
+    -- 'catThis'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_This')
+    -- 'catThat'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_That')
+    -- 'catThese' = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_These')
+    -- 'catHere'  = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'here')
+    -- 'catThere' = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'there')
+    -- @
+    catThis,
+    catThat,
+    catThese,
+    catHere,
+    catThere,
+
+    -- * is / has
+    --
+    -- |
+    -- @
+    -- 'isThis'   = 'Control.Lens.Extra.is' '_This'
+    -- 'isThat'   = 'Control.Lens.Extra.is' '_That'
+    -- 'isThese'  = 'Control.Lens.Extra.is' '_These'
+    -- 'hasHere'  = 'Control.Lens.has' 'here'
+    -- 'hasThere' = 'Control.Lens.has' 'there'
+    -- @
+    isThis,
+    isThat,
+    isThese,
+    hasHere,
+    hasThere,
+
+    -- * over / map
+    --
+    -- @
+    -- 'mapThis'  = 'Control.Lens.over' '_This'
+    -- 'mapThat'  = 'Control.Lens.over' '_That'
+    -- 'mapThese' = 'Control.Lens.over' '_These'
+    -- 'mapHere'  = 'Control.Lens.over' 'here'
+    -- 'mapThere' = 'Control.Lens.over' 'there'
+    -- @
+    mapThis,
+    mapThat,
+    mapThese,
+    ) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Bifunctor       (bimap, first, second)
+import Data.Bifunctor.Assoc (assoc, unassoc)
+import Data.Bifunctor.Swap  (swap)
+import Data.Bitraversable   (bitraverse)
+import Data.Maybe           (isJust, mapMaybe)
+import Data.These
+
+-------------------------------------------------------------------------------
+-- bifunctors
+-------------------------------------------------------------------------------
+
+-- | 'Bifunctor' 'bimap'.
+bimapThese :: (a -> c) -> (b -> d) -> These a b -> These c d
+bimapThese = bimap
+
+-- | @'mapThis' = 'Control.Lens.over' 'here'@
+mapHere :: (a -> c) -> These a b -> These c b
+mapHere = first
+
+-- | @'mapThere' = 'Control.Lens.over' 'there'@
+mapThere :: (b -> d) -> These a b -> These a d
+mapThere = second
+
+-- | 'Bitraversable' 'bitraverse'.
+bitraverseThese :: Applicative f => (a -> f c) -> (b -> f d) -> These a b -> f (These c d)
+bitraverseThese = bitraverse
+
+-------------------------------------------------------------------------------
+-- assoc
+-------------------------------------------------------------------------------
+
+-- | 'These' is commutative.
+--
+-- @
+-- 'swapThese' . 'swapThese' = 'id'
+-- @
+--
+-- @since 0.8
+swapThese :: These a b -> These b a
+swapThese = swap
+
+-- | 'These' is associative.
+--
+-- @
+-- 'assocThese' . 'unassocThese' = 'id'
+-- 'unassocThese' . 'assocThese' = 'id'
+-- @
+--
+-- @since 0.8
+assocThese :: These (These a b) c -> These a (These b c)
+assocThese = assoc
+
+-- | 'These is associative. See 'assocThese'.
+--
+-- @since 0.8
+unassocThese :: These a (These b c) -> These (These a b) c
+unassocThese = unassoc
+
+-------------------------------------------------------------------------------
+-- preview
+-------------------------------------------------------------------------------
+
+-- |
+--
+-- >>> justHere (This 'x')
+-- Just 'x'
+--
+-- >>> justHere (That 'y')
+-- Nothing
+--
+-- >>> justHere (These 'x' 'y')
+-- Just 'x'
+--
+justHere :: These a b -> Maybe a
+justHere (This a)    = Just a
+justHere (That _)    = Nothing
+justHere (These a _) = Just a
+
+-- |
+--
+-- >>> justThere (This 'x')
+-- Nothing
+--
+-- >>> justThere (That 'y')
+-- Just 'y'
+--
+-- >>> justThere (These 'x' 'y')
+-- Just 'y'
+--
+justThere :: These a b -> Maybe b
+justThere (This _)    = Nothing
+justThere (That b)    = Just b
+justThere (These _ b) = Just b
+
+justThis :: These a b -> Maybe a
+justThis (This a) = Just a
+justThis _        = Nothing
+
+justThat :: These a b -> Maybe b
+justThat (That x) = Just x
+justThat _        = Nothing
+
+justThese :: These a b -> Maybe (a, b)
+justThese (These a x) = Just (a, x)
+justThese _           = Nothing
+
+-------------------------------------------------------------------------------
+-- toListOf
+-------------------------------------------------------------------------------
+
+-- | Select all 'This' constructors from a list.
+catThis :: [These a b] -> [a]
+catThis = mapMaybe justThis
+
+-- | Select all 'That' constructors from a list.
+catThat :: [These a b] -> [b]
+catThat = mapMaybe justThat
+
+-- | Select all 'These' constructors from a list.
+catThese :: [These a b] -> [(a, b)]
+catThese = mapMaybe justThese
+
+catHere :: [These a b] -> [a]
+catHere = mapMaybe justHere
+
+catThere :: [These a b] -> [b]
+catThere = mapMaybe justThere
+
+-------------------------------------------------------------------------------
+-- is
+-------------------------------------------------------------------------------
+
+isThis, isThat, isThese :: These a b -> Bool
+-- | @'isThis' = 'isJust' . 'justThis'@
+isThis  = isJust . justThis
+
+-- | @'isThat' = 'isJust' . 'justThat'@
+isThat  = isJust . justThat
+
+-- | @'isThese' = 'isJust' . 'justThese'@
+isThese = isJust . justThese
+
+hasHere, hasThere :: These a b -> Bool
+-- | @'hasHere' = 'isJust' . 'justHere'@
+hasHere = isJust . justHere
+
+-- | @'hasThere' = 'isJust' . 'jusThere'@
+hasThere = isJust . justThere
+
+-------------------------------------------------------------------------------
+-- over / map
+-------------------------------------------------------------------------------
+
+mapThis :: (a -> a) -> These a b -> These a b
+mapThis f (This x) = This (f x)
+mapThis _ y        = y
+
+mapThat :: (b -> b) -> These a b -> These a b
+mapThat f (That x) = That (f x)
+mapThat _ y        = y
+
+mapThese :: ((a, b) -> (a, b)) -> These a b -> These a b
+mapThese f (These x y) = uncurry These (curry f x y)
+mapThese _ z           = z
diff --git a/Data/These/Lens.hs b/Data/These/Lens.hs
new file mode 100644
--- /dev/null
+++ b/Data/These/Lens.hs
@@ -0,0 +1,73 @@
+module Data.These.Lens (
+    -- * Traversals
+    here, there,
+
+    -- * Prisms
+    _This, _That, _These,
+    ) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Control.Lens                 (Prism', prism)
+import Data.These
+
+-------------------------------------------------------------------------------
+-- Traversals
+-------------------------------------------------------------------------------
+
+-- | A 'Control.Lens.Traversal' of the first half of a 'These', suitable for use with "Control.Lens".
+--
+-- @
+-- 'here' :: 'Control.Lens.Traversal' ('These' a t) ('These' b t) a b
+-- @
+--
+-- >>> over here show (That 1)
+-- That 1
+--
+-- >>> over here show (These 'a' 2)
+-- These "'a'" 2
+--
+here :: (Applicative f) => (a -> f b) -> These a t -> f (These b t)
+here f (This x) = This <$> f x
+here f (These x y) = flip These y <$> f x
+here _ (That x) = pure (That x)
+
+-- | A 'Control.Lens.Traversal' of the second half of a 'These', suitable for use with "Control.Lens".
+--
+-- @
+-- 'there' :: 'Control.Lens.Traversal' ('These' t b) ('These' t b) a b
+-- @
+--
+-- >>> over there show (That 1)
+-- That "1"
+--
+-- >>> over there show (These 'a' 2)
+-- These 'a' "2"
+--
+there :: (Applicative f) => (a -> f b) -> These t a -> f (These t b)
+there _ (This x) = pure (This x)
+there f (These x y) = These x <$> f y
+there f (That x) = That <$> f x
+
+-------------------------------------------------------------------------------
+-- Prisms
+-------------------------------------------------------------------------------
+
+-- | A 'Control.Lens.Prism'' selecting the 'This' constructor.
+--
+-- /Note:/ cannot change type.
+_This :: Prism' (These a b) a
+_This = prism This (these Right (Left . That) (\x y -> Left $ These x y))
+
+-- | A 'Control.Lens.Prism'' selecting the 'That' constructor.
+--
+-- /Note:/ cannot change type.
+_That :: Prism' (These a b) b
+_That = prism That (these (Left . This) Right (\x y -> Left $ These x y))
+
+-- | A 'Control.Lens.Prism'' selecting the 'These' constructor. 'These' names are ridiculous!
+--
+-- /Note:/ cannot change type.
+_These :: Prism' (These a b) (a, b)
+_These = prism (uncurry These) (these (Left . This) (Left . That) (\x y -> Right (x, y)))
diff --git a/test/Tests.hs b/test/Tests.hs
--- a/test/Tests.hs
+++ b/test/Tests.hs
@@ -46,6 +46,8 @@
 import Data.Align.Indexed
 import Data.Align.Key
 import Data.These
+import Data.These.Combinators
+import Data.These.Lens
 
 -- For old GHC to work
 data Proxy (a :: * -> *) = Proxy
@@ -188,8 +190,8 @@
 dataAlignLaws :: forall (f :: * -> *). ( Align f, Foldable f
                                        , Eq (f (These Int Int))
                                        , Show (f (These Int Int))
-                                       , Eq (f (These (These Int Int) Int))
-                                       , Show (f (These (These Int Int) Int))
+                                       , Eq (f (These Int (These Int Int)))
+                                       , Show (f (These Int (These Int Int)))
                                        , CoArbitrary (These Int Int)
                                        , Arbitrary (f Int)
                                        , Eq (f Int)
@@ -225,10 +227,10 @@
       alignWith f xs ys === (f <$> align xs ys)
 
     assocProp :: f Int -> f Int -> f Int -> Property
-    assocProp xs ys zs = rhs === lhs
+    assocProp xs ys zs = lhs === fmap assocThese rhs
       where
         rhs = (xs `align` ys) `align` zs
-        lhs = fmap assoc $ xs `align` (ys `align` zs)
+        lhs = xs `align` (ys `align` zs)
 
     alignToListProp :: f Int -> f Int -> Property
     alignToListProp xs ys =
@@ -252,6 +254,8 @@
 
 instance Ord k => Align (WrongMap k) where
     nil = WM Map.empty
+
+instance Ord k => Semialign (WrongMap k) where
     align (WM x) (WM y)
        | Map.null y = WM $ This <$> x
        | Map.null x = WM $ That <$> y
@@ -276,6 +280,7 @@
 instance Ord k => Align (WeirdMap k) where
     nil = WeirdMap Map.empty
 
+instance Ord k => Semialign (WeirdMap k) where
     alignWith f (WeirdMap x) (WeirdMap y) = WeirdMap $ Map.fromList $
         alignWith g (Map.toList x) (Map.toList y)
       where
@@ -290,6 +295,8 @@
 {-
 instance Monoid a => Align (Const a) where
     nil = Const mempty
+
+instance Monoid a => Semialign (Const a) where
     align (Const a) (Const b) = Const (mappend a b)
 -}
 
@@ -304,6 +311,7 @@
 instance Align R where
     nil = Nest []
 
+instance Semialign R where
     align (Nest ass) (Nest bss)
         | null ass                = That <$> Nest bss
         | null bss                = This <$> Nest ass
diff --git a/these.cabal b/these.cabal
--- a/these.cabal
+++ b/these.cabal
@@ -1,6 +1,6 @@
 cabal-version:      >=1.10
 name:               these
-version:            0.7.6
+version:            0.8
 synopsis:
   An either-or-both data type & a generalized 'zip with padding' typeclass
 
@@ -49,10 +49,13 @@
     Data.Align.Key
     Data.Functor.These
     Data.These
+    Data.These.Lens
+    Data.These.Combinators
 
   -- ghc boot libs
   build-depends:
-      base          >=4.5.1.0 && <4.13
+      assoc         >=1       && <1.1
+    , base          >=4.5.1.0 && <4.13
     , binary        >=0.5.1.0 && <0.10
     , containers    >=0.4.2.1 && <0.7
     , deepseq       >=1.3.0.0 && <1.5