id 0.0.3 → 0.0.4

raw patch · 5 files changed

+1009/−24 lines, 5 filesdep +bifunctorsdep +comonaddep +deepseqdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bifunctors, comonad, deepseq, distributive, hashable, profunctors

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• changelog.md +7/−0
• id.cabal +17/−2
• src/Data/BiId.hs +760/−0
• src/Data/Id.hs +225/−20
• test/Main.hs +0/−2

@@ -1,3 +1,10 @@+0.0.4++* Add Data.BiId module with BiId p s t a b newtype and full instance coverage+* Add INLINE pragmas to all functions and instance methods in Data.Id and Data.BiId+* Add SPECIALIZE pragmas on identity isos for common concrete types ((,), Either, (->))+* Add Comonad instance for Id+ 0.0.3  * Add __Unwrapped iso (dual of __Wrapped) with specializations for all type aliases

@@ -1,6 +1,6 @@ cabal-version:        2.4 name:                 id-version:              0.0.3+version:              0.0.4 synopsis:             Id (f a) data type description:          (f a) data type, with optics and functions for switching the type constructor (f) license:              BSD-3-Clause@@ -21,11 +21,18 @@  library   exposed-modules:    Data.Id+                    , Data.BiId -  build-depends:        base >= 4.8 && < 6+  build-depends:        base >= 4.18 && < 6+                      , bifunctors >= 5 && < 6+                      , comonad >= 5 && < 6                       , contravariant >= 1.4 && < 2+                      , deepseq >= 1.4 && < 2+                      , distributive >= 0.5 && < 1+                      , hashable >= 1.3 && < 2                       , lens >= 4 && < 6                       , mtl >= 2.2 && < 3+                      , profunctors >= 5 && < 6                       , semigroupoids >= 6 && < 7                       , tagged >= 0.8 && < 1                       , selective >= 0.7 && < 1@@ -36,6 +43,14 @@   default-language:   Haskell2010    ghc-options:        -Wall++  if flag(dev)+    ghc-options:      -Werror++flag dev+  description:        Enable -Werror for development+  manual:             True+  default:            False  test-suite doctest   type:               exitcode-stdio-1.0

@@ -0,0 +1,760 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- @BiId p s t a b@ — a newtype around @p (s a) (t b)@, with optics and instances+-- for switching the type constructors @p@, @s@, and @t@.+module Data.BiId+  ( -- * BiId data type+    BiId (..),++    -- * Optics+    __Wrapped,+    identityBifunctor,+    identityProfunctor,+    identityProfunctorBifunctor,+    identityBifunctorProfunctor,++    -- * Type aliases+    BiIdIdentity,+    Product,+    Coproduct,+    Exponential,+  )+where++import Control.Applicative (Alternative (empty, (<|>)))+import Control.Comonad (Comonad (..))+import Control.Lens+  ( FoldableWithIndex (..),+    FunctorWithIndex (..),+    Iso,+    Rewrapped,+    TraversableWithIndex (..),+    Wrapped (..),+    iso,+  )+import Control.Monad (MonadPlus (..), join)+import Control.Monad.Cont (MonadCont (..))+import Control.Monad.Error.Class (MonadError (..))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.RWS.Class (MonadRWS)+import Control.Monad.Reader.Class (MonadReader (..))+import Control.Monad.State.Class (MonadState (..))+import Control.Monad.Writer (MonadWriter (..))+import Control.Monad.Zip (MonadZip (..))+import Control.Selective (Selective (..))+import Data.Biapplicative (Biapplicative (..))+import Data.Bifoldable (Bifoldable (..))+import Data.Bifunctor (Bifunctor (..))+import Data.Bitraversable (Bitraversable (..))+import Data.Data (Data)+import Data.Distributive (Distributive (..))+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Apply (Apply ((<.>), liftF2))+import Data.Functor.Bind (Bind ((>>-)))+import Data.Functor.Classes+  ( Eq1 (..),+    Eq2 (..),+    Ord1 (..),+    Ord2 (..),+    Show1 (..),+    Show2 (..),+  )+import Data.Functor.Contravariant (Contravariant (..))+import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..))+import Data.Functor.Extend (Extend (..))+import Data.Functor.Identity+import Data.Functor.Plus (Plus (..))+import Data.Profunctor (Profunctor (..))+import Data.Profunctor.Choice (Choice (..), Cochoice (..))+import Data.Profunctor.Closed (Closed (..))+import Data.Profunctor.Strong (Costrong (..), Strong (..))+import Data.Semigroup.Bifoldable (Bifoldable1 (..))+import Data.Semigroup.Bitraversable (Bitraversable1 (..))+import Data.Semigroup.Foldable (Foldable1 (..))+import Data.Semigroup.Traversable (Traversable1 (..))+import GHC.Generics (Generic, Generic1)++-- $setup+-- >>> import Control.Lens (view, over, from)+-- >>> import Data.Functor.Identity (Identity(..), runIdentity)+-- >>> import Data.Semigroup (Sum(..))+-- >>> import Data.Tagged (Tagged(..))++-- |+-- >>> BiId ([1,2,3], Identity True)+-- BiId ([1,2,3],Identity True)+--+-- >>> BiId ([1,2,3], Identity True) == BiId ([1,2,3], Identity True)+-- True+--+-- >>> BiId ([1,2,3], Identity True) == BiId ([4,5], Identity False)+-- False+--+-- >>> compare (BiId ([1], Identity True)) (BiId ([2], Identity False))+-- LT+newtype BiId p s t a b = BiId (p (s a) (t b))+  deriving (Eq, Ord, Show, Data, Generic, Generic1)++-- |+-- >>> BiId ([1,2], [True, False]) :: Product [] [] Int Bool+-- BiId ([1,2],[True,False])+type Product s t a b = BiId (,) s t a b++-- |+-- >>> BiId (Left [1,2]) :: Coproduct [] [] Int Bool+-- BiId (Left [1,2])+type Coproduct s t a b = BiId Either s t a b++-- |+-- >>> (\(BiId f) -> f [1,2,3]) (BiId (fmap (+1)) :: Exponential [] [] Int Int)+-- [2,3,4]+type Exponential s t a b = BiId (->) s t a b++type BiIdIdentity p a b = BiId p Identity Identity a b++-- |+-- >>> view identityBifunctor (BiId (Identity 3, Identity True) :: BiIdIdentity (,) Int Bool)+-- (3,True)+--+-- >>> view (from identityBifunctor) (3, True) :: BiIdIdentity (,) Int Bool+-- BiId (Identity 3,Identity True)+identityBifunctor ::+  (Bifunctor p, Bifunctor p') =>+  Iso+    (BiIdIdentity p a b)+    (BiIdIdentity p' a' b')+    (p a b)+    (p' a' b')+identityBifunctor =+  iso+    (\(BiId x) -> bimap runIdentity runIdentity x)+    (BiId . bimap Identity Identity)+{-# INLINE identityBifunctor #-}+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity (,) a b) (BiIdIdentity (,) a' b') ((,) a b) ((,) a' b') #-}+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity Either a b) (BiIdIdentity Either a' b') (Either a b) (Either a' b') #-}+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity (,) a b) (BiIdIdentity Either a' b') ((,) a b) (Either a' b') #-}+{-# SPECIALIZE identityBifunctor :: Iso (BiIdIdentity Either a b) (BiIdIdentity (,) a' b') (Either a b) ((,) a' b') #-}++-- |+-- >>> view identityProfunctor (BiId (Tagged (Identity True)) :: BiIdIdentity Tagged Int Bool)+-- Tagged True+--+-- >>> view (from identityProfunctor) (Tagged True) :: BiIdIdentity Tagged Int Bool+-- BiId (Tagged (Identity True))+identityProfunctor ::+  (Profunctor p, Profunctor p') =>+  Iso+    (BiIdIdentity p a b)+    (BiIdIdentity p' a' b')+    (p a b)+    (p' a' b')+identityProfunctor =+  iso+    (\(BiId x) -> dimap Identity runIdentity x)+    (BiId . dimap runIdentity Identity)+{-# INLINE identityProfunctor #-}+{-# SPECIALIZE identityProfunctor :: Iso (BiIdIdentity (->) a b) (BiIdIdentity (->) a' b') ((->) a b) ((->) a' b') #-}++-- |+-- >>> view identityProfunctorBifunctor (BiId (Tagged (Identity True)) :: BiIdIdentity Tagged Int Bool) :: Tagged Int Bool+-- Tagged True+identityProfunctorBifunctor ::+  (Profunctor p, Bifunctor p') =>+  Iso+    (BiIdIdentity p a b)+    (BiIdIdentity p' a' b')+    (p a b)+    (p' a' b')+identityProfunctorBifunctor =+  iso+    (\(BiId x) -> dimap Identity runIdentity x)+    (BiId . bimap Identity Identity)+{-# INLINE identityProfunctorBifunctor #-}+{-# SPECIALIZE identityProfunctorBifunctor :: Iso (BiIdIdentity (->) a b) (BiIdIdentity (,) a' b') ((->) a b) ((,) a' b') #-}+{-# SPECIALIZE identityProfunctorBifunctor :: Iso (BiIdIdentity (->) a b) (BiIdIdentity Either a' b') ((->) a b) (Either a' b') #-}++-- |+-- >>> view identityBifunctorProfunctor (BiId (Tagged (Identity True)) :: BiIdIdentity Tagged Int Bool) :: Tagged Int Bool+-- Tagged True+identityBifunctorProfunctor ::+  (Bifunctor p, Profunctor p') =>+  Iso+    (BiIdIdentity p a b)+    (BiIdIdentity p' a' b')+    (p a b)+    (p' a' b')+identityBifunctorProfunctor =+  iso+    (\(BiId x) -> bimap runIdentity runIdentity x)+    (BiId . dimap runIdentity Identity)+{-# INLINE identityBifunctorProfunctor #-}+{-# SPECIALIZE identityBifunctorProfunctor :: Iso (BiIdIdentity (,) a b) (BiIdIdentity (->) a' b') ((,) a b) ((->) a' b') #-}+{-# SPECIALIZE identityBifunctorProfunctor :: Iso (BiIdIdentity Either a b) (BiIdIdentity (->) a' b') (Either a b) ((->) a' b') #-}++instance+  (BiId p s t a b ~ x) =>+  Rewrapped (BiId p s' t' a' b') x++-- |+-- >>> view _Wrapped' (BiId ([1,2,3], Identity True))+-- ([1,2,3],Identity True)+instance Wrapped (BiId p s t a b) where+  type+    Unwrapped (BiId p s t a b) =+      p (s a) (t b)+  _Wrapped' =+    iso (\(BiId x) -> x) BiId+  {-# INLINE _Wrapped' #-}++-- |+-- >>> view __Wrapped (BiId ([1,2,3], Identity True))+-- ([1,2,3],Identity True)+--+-- >>> view (from __Wrapped) ([1,2,3], Identity True) :: BiId (,) [] Identity Int Bool+-- BiId ([1,2,3],Identity True)+--+-- >>> over __Wrapped (\(xs, Identity b) -> (fmap (+1) xs, Identity (not b))) (BiId ([1,2,3], Identity True))+-- BiId ([2,3,4],Identity False)+__Wrapped ::+  Iso+    (BiId p s t a b)+    (BiId p' s' t' a' b')+    (p (s a) (t b))+    (p' (s' a') (t' b'))+__Wrapped =+  iso+    (\(BiId x) -> x)+    BiId+{-# INLINE __Wrapped #-}++-- |+-- >>> liftEq (==) (BiId ([1,2], Identity True)) (BiId ([1,2], Identity True))+-- True+--+-- >>> liftEq (==) (BiId ([1,2], Identity True)) (BiId ([1,2], Identity False))+-- False+instance (Eq1 (p (s a)), Eq1 t) => Eq1 (BiId p s t a) where+  liftEq f (BiId x) (BiId y) =+    liftEq (liftEq f) x y+  {-# INLINE liftEq #-}++-- |+-- >>> liftCompare compare (BiId ([1], Identity 'a')) (BiId ([1], Identity 'b'))+-- LT+instance (Ord1 (p (s a)), Ord1 t) => Ord1 (BiId p s t a) where+  liftCompare f (BiId x) (BiId y) =+    liftCompare (liftCompare f) x y+  {-# INLINE liftCompare #-}++-- |+-- >>> liftShowsPrec showsPrec showList 0 (BiId ([1,2], Identity True)) ""+-- "BiId ([1,2],Identity True)"+instance (Show1 (p (s a)), Show1 t) => Show1 (BiId p s t a) where+  liftShowsPrec sp l d (BiId x) =+    showParen (d > 10) $ showString "BiId " . liftShowsPrec (liftShowsPrec sp l) (liftShowList sp l) 11 x+  {-# INLINE liftShowsPrec #-}++-- |+-- >>> liftEq2 (==) (==) (BiId ([1,2], Identity True)) (BiId ([1,2], Identity True))+-- True+--+-- >>> liftEq2 (==) (==) (BiId ([1,2], Identity True)) (BiId ([3,4], Identity True))+-- False+instance (Eq2 p, Eq1 s, Eq1 t) => Eq2 (BiId p s t) where+  liftEq2 f g (BiId x) (BiId y) =+    liftEq2 (liftEq f) (liftEq g) x y+  {-# INLINE liftEq2 #-}++-- |+-- >>> liftCompare2 compare compare (BiId ([1], Identity 'a')) (BiId ([2], Identity 'a'))+-- LT+instance (Ord2 p, Ord1 s, Ord1 t) => Ord2 (BiId p s t) where+  liftCompare2 f g (BiId x) (BiId y) =+    liftCompare2 (liftCompare f) (liftCompare g) x y+  {-# INLINE liftCompare2 #-}++-- |+-- >>> liftShowsPrec2 showsPrec showList showsPrec showList 0 (BiId ([1,2], Identity True)) ""+-- "BiId ([1,2],Identity True)"+instance (Show2 p, Show1 s, Show1 t) => Show2 (BiId p s t) where+  liftShowsPrec2 spa la spb lb d (BiId x) =+    showParen (d > 10) $ showString "BiId " . liftShowsPrec2 (liftShowsPrec spa la) (liftShowList spa la) (liftShowsPrec spb lb) (liftShowList spb lb) 11 x+  {-# INLINE liftShowsPrec2 #-}++-- |+-- >>> dimap (+1) (*2) (BiId (Tagged (Identity 3))) :: BiId Tagged [] Identity Int Int+-- BiId (Tagged (Identity 6))+instance (Profunctor p, Functor s, Functor t) => Profunctor (BiId p s t) where+  dimap f g (BiId x) =+    BiId (dimap (fmap f) (fmap g) x)+  {-# INLINE dimap #-}+  lmap f (BiId x) =+    BiId (lmap (fmap f) x)+  {-# INLINE lmap #-}+  rmap f (BiId x) =+    BiId (rmap (fmap f) x)+  {-# INLINE rmap #-}++-- |+-- >>> let f = first' (BiId id :: BiId (->) Identity Identity Int Int)+-- >>> (\(BiId g) -> g) f (Identity (3, 'x'))+-- Identity (3,'x')+instance (Strong p, Comonad s, Functor t) => Strong (BiId p s t) where+  first' (BiId x) =+    BiId+      ( dimap+          (\sac -> (fmap fst sac, snd (extract sac)))+          (\(tb, c) -> fmap (, c) tb)+          (first' x)+      )+  {-# INLINE first' #-}+  second' (BiId x) =+    BiId+      ( dimap+          (\sca -> (fst (extract sca), fmap snd sca))+          (\(c, tb) -> fmap (c,) tb)+          (second' x)+      )+  {-# INLINE second' #-}++-- |+-- >>> let f = left' (BiId id :: BiId (->) Identity Identity Int Int)+-- >>> (\(BiId g) -> g) f (Identity (Left 3))+-- Identity (Left 3)+instance (Choice p, Traversable s, Applicative t) => Choice (BiId p s t) where+  left' (BiId x) =+    BiId+      ( dimap+          (either Right Left . traverse (either Right Left))+          (either (fmap Left) (pure . Right))+          (left' x)+      )+  {-# INLINE left' #-}+  right' (BiId x) =+    BiId+      ( dimap+          (either Left Right . traverse (either Left Right))+          (either (pure . Left) (fmap Right))+          (right' x)+      )+  {-# INLINE right' #-}++-- |+-- >>> let BiId f = closed (BiId id :: BiId (->) Identity Identity Int Int)+-- >>> runIdentity (f (Identity (const 7))) 'x'+-- 7+instance (Closed p, Distributive s, Distributive t) => Closed (BiId p s t) where+  closed (BiId x) =+    BiId (dimap distribute distribute (closed x))+  {-# INLINE closed #-}++-- |+-- >>> bimap (+1) not (BiId ([1,2,3], Identity True))+-- BiId ([2,3,4],Identity False)+instance (Bifunctor p, Functor s, Functor t) => Bifunctor (BiId p s t) where+  bimap f g (BiId x) =+    BiId (bimap (fmap f) (fmap g) x)+  {-# INLINE bimap #-}+  first f (BiId x) =+    BiId (first (fmap f) x)+  {-# INLINE first #-}+  second f (BiId x) =+    BiId (second (fmap f) x)+  {-# INLINE second #-}++-- |+-- >>> bifoldMap Sum Sum (BiId ([1,2,3], Identity 4))+-- Sum {getSum = 10}+instance (Bifoldable p, Foldable s, Foldable t) => Bifoldable (BiId p s t) where+  bifoldMap f g (BiId x) =+    bifoldMap (foldMap f) (foldMap g) x+  {-# INLINE bifoldMap #-}++-- |+-- >>> bifoldMap1 Sum Sum (BiId (Identity 3, Identity 4))+-- Sum {getSum = 7}+instance (Bifoldable1 p, Foldable1 s, Foldable1 t) => Bifoldable1 (BiId p s t) where+  bifoldMap1 f g (BiId x) =+    bifoldMap1 (foldMap1 f) (foldMap1 g) x+  {-# INLINE bifoldMap1 #-}++-- |+-- >>> bitraverse (\x -> if x > 2 then Nothing else Just (x * 10)) (\x -> Just (not x)) (BiId ([1,2], Identity True))+-- Just (BiId ([10,20],Identity False))+--+-- >>> bitraverse (\x -> if x > 2 then Nothing else Just (x * 10)) (\x -> Just (not x)) (BiId ([1,3], Identity True))+-- Nothing+instance (Bitraversable p, Traversable s, Traversable t) => Bitraversable (BiId p s t) where+  bitraverse f g (BiId x) =+    BiId <$> bitraverse (traverse f) (traverse g) x+  {-# INLINE bitraverse #-}++-- |+-- >>> bitraverse1 Just Just (BiId (Identity 3, Identity True))+-- Just (BiId (Identity 3,Identity True))+instance (Bitraversable1 p, Traversable1 s, Traversable1 t) => Bitraversable1 (BiId p s t) where+  bitraverse1 f g (BiId x) =+    BiId <$> bitraverse1 (traverse1 f) (traverse1 g) x+  {-# INLINE bitraverse1 #-}++-- |+-- >>> fmap (+1) (BiId ([1,2,3], Identity 4))+-- BiId ([1,2,3],Identity 5)+instance (Functor (p (s a)), Functor t) => Functor (BiId p s t a) where+  fmap f (BiId x) =+    BiId (fmap (fmap f) x)+  {-# INLINE fmap #-}++-- |+-- >>> foldMap Sum (BiId ([1,2,3], Identity 4))+-- Sum {getSum = 4}+instance (Foldable (p (s a)), Foldable t) => Foldable (BiId p s t a) where+  foldMap f (BiId x) =+    foldMap (foldMap f) x+  {-# INLINE foldMap #-}++-- |+-- >>> traverse (\x -> if x > 3 then Nothing else Just (x * 10)) (BiId ([1,2], Identity 3))+-- Just (BiId ([1,2],Identity 30))+--+-- >>> traverse (\x -> if x > 3 then Nothing else Just (x * 10)) (BiId ([1,2], Identity 4))+-- Nothing+instance (Traversable (p (s a)), Traversable t) => Traversable (BiId p s t a) where+  traverse f (BiId x) =+    BiId <$> traverse (traverse f) x+  {-# INLINE traverse #-}++-- |+-- >>> (BiId ("", Identity (+1)) :: BiId (,) [] Identity Char (Int -> Int)) <.> BiId ("", Identity 10)+-- BiId ("",Identity 11)+instance (Apply (p (s a)), Apply t) => Apply (BiId p s t a) where+  BiId x <.> BiId y =+    BiId (liftF2 (<.>) x y)+  {-# INLINE (<.>) #-}++-- |+-- >>> pure 7 :: BiId (,) [] Identity Int Int+-- BiId ([],Identity 7)+--+-- >>> (BiId ("", Identity (+1)) :: BiId (,) [] Identity Char (Int -> Int)) <*> BiId ("", Identity 10)+-- BiId ("",Identity 11)+instance (Applicative (p (s a)), Applicative t) => Applicative (BiId p s t a) where+  pure b =+    BiId (pure (pure b))+  {-# INLINE pure #-}+  BiId x <*> BiId y =+    BiId (liftA2 (<*>) x y)+  {-# INLINE (<*>) #-}++-- |+-- >>> BiId ("hello", Identity 3) >>- (\b -> BiId ("!", Identity (b + 1)))+-- BiId ("hello!",Identity 4)+instance (Apply (p (s a)), Monad (p (s a)), Apply t, Traversable t, Monad t) => Bind (BiId p s t a) where+  BiId x >>- f =+    BiId (x >>= \tb -> fmap join (mapM (\b -> let BiId y = f b in y) tb))+  {-# INLINE (>>-) #-}++-- |+-- >>> BiId ("hello", Identity 3) >>= (\b -> BiId ("!", Identity (b + 1)))+-- BiId ("hello!",Identity 4)+instance (Monad (p (s a)), Traversable t, Monad t) => Monad (BiId p s t a) where+  BiId x >>= f =+    BiId (x >>= \tb -> fmap join (mapM (\b -> let BiId y = f b in y) tb))+  {-# INLINE (>>=) #-}++-- |+-- >>> bipure 'a' True :: BiId (,) Identity Identity Char Bool+-- BiId (Identity 'a',Identity True)+instance (Biapplicative p, Applicative s, Applicative t) => Biapplicative (BiId p s t) where+  bipure a b =+    BiId (bipure (pure a) (pure b))+  {-# INLINE bipure #-}+  BiId x <<*>> BiId y =+    BiId (biliftA2 (liftA2 ($)) (liftA2 ($)) x y)+  {-# INLINE (<<*>>) #-}++-- |+-- >>> import Control.Lens (imap)+-- >>> imap (\(i, j) x -> (i, j, x)) (BiId (["hello", "world"], Identity 7))+-- BiId (["hello","world"],Identity (["hello","world"],(),7))+instance (FunctorWithIndex i (p (s a)), FunctorWithIndex j t) => FunctorWithIndex (i, j) (BiId p s t a) where+  imap f (BiId x) =+    BiId (imap (\i -> imap (\j -> f (i, j))) x)+  {-# INLINE imap #-}++-- |+-- >>> import Control.Lens (ifoldMap)+-- >>> ifoldMap (\(i, _) x -> [(i, x)]) (BiId (["hello", "world"], Identity 7))+-- [(["hello","world"],7)]+instance (FoldableWithIndex i (p (s a)), Foldable (p (s a)), FoldableWithIndex j t, Foldable t) => FoldableWithIndex (i, j) (BiId p s t a) where+  ifoldMap f (BiId x) =+    ifoldMap (\i -> ifoldMap (\j -> f (i, j))) x+  {-# INLINE ifoldMap #-}++-- |+-- >>> import Control.Lens (itraverse)+-- >>> itraverse (\(_, _) x -> Just (x + 1)) (BiId (["hello"], Identity 7))+-- Just (BiId (["hello"],Identity 8))+instance (TraversableWithIndex i (p (s a)), Traversable (p (s a)), FoldableWithIndex i (p (s a)), Foldable (p (s a)), TraversableWithIndex j t, Traversable t, FoldableWithIndex j t, Foldable t, Functor (p (s a)), Functor t) => TraversableWithIndex (i, j) (BiId p s t a) where+  itraverse f (BiId x) =+    BiId <$> itraverse (\i -> itraverse (\j -> f (i, j))) x+  {-# INLINE itraverse #-}++-- |+-- >>> select (BiId ("", Identity (Right 7))) (BiId ("x", Identity (+1)))+-- BiId ("x",Identity 7)+--+-- >>> select (BiId ("", Identity (Left 3))) (BiId ("x", Identity (+1)))+-- BiId ("x",Identity 4)+instance (Applicative (p (s a)), Selective t) => Selective (BiId p s t a) where+  select (BiId x) (BiId y) =+    BiId (liftA2 select x y)+  {-# INLINE select #-}++instance (Alt (p (s a)), Functor (p (s a)), Functor t) => Alt (BiId p s t a) where+  BiId x <!> BiId y =+    BiId (x <!> y)+  {-# INLINE (<!>) #-}++instance (Alternative (p (s a)), Applicative t) => Alternative (BiId p s t a) where+  BiId x <|> BiId y =+    BiId (x <|> y)+  {-# INLINE (<|>) #-}+  empty =+    BiId empty+  {-# INLINE empty #-}++instance (Plus (p (s a)), Functor (p (s a)), Functor t) => Plus (BiId p s t a) where+  zero =+    BiId zero+  {-# INLINE zero #-}++-- |+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)+-- >>> getPredicate ((\(BiId (Tagged x)) -> x) (contramap length (BiId (Tagged (Predicate (> 3))) :: BiId Tagged [] Predicate Int Int))) "hello"+-- True+instance (Functor (p (s a)), Contravariant t) => Contravariant (BiId p s t a) where+  contramap f (BiId x) =+    BiId (fmap (contramap f) x)+  {-# INLINE contramap #-}++-- |+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)+-- >>> import Data.Functor.Contravariant.Divisible (divided)+-- >>> let BiId (Tagged p) = divided (BiId (Tagged (Predicate even))) (BiId (Tagged (Predicate (> 0)))) :: BiId Tagged [] Predicate Int (Int, Int) in getPredicate p (4, 1)+-- True+instance (Applicative (p (s a)), Divisible t) => Divisible (BiId p s t a) where+  divide f (BiId x) (BiId y) =+    BiId (liftA2 (divide f) x y)+  {-# INLINE divide #-}+  conquer =+    BiId (pure conquer)+  {-# INLINE conquer #-}++-- |+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)+-- >>> import Data.Functor.Contravariant.Divisible (chosen)+-- >>> let BiId (Tagged p) = chosen (BiId (Tagged (Predicate even))) (BiId (Tagged (Predicate (> 0)))) :: BiId Tagged [] Predicate Int (Either Int Int) in getPredicate p (Left 4)+-- True+instance (Applicative (p (s a)), Decidable t) => Decidable (BiId p s t a) where+  choose f (BiId x) (BiId y) =+    BiId (liftA2 (choose f) x y)+  {-# INLINE choose #-}+  lose f =+    BiId (pure (lose f))+  {-# INLINE lose #-}++-- |+-- >>> let f = unfirst (BiId (Tagged (Identity (True, 'x')))) :: BiId Tagged Identity Identity Int Bool+-- >>> (\(BiId (Tagged x)) -> x) f+-- Identity True+instance (Costrong p, Functor s, Comonad t) => Costrong (BiId p s t) where+  unfirst (BiId x) =+    BiId+      ( unfirst+          ( dimap+              (\(sa, d) -> fmap (, d) sa)+              (\tbd -> (fmap fst tbd, snd (extract tbd)))+              x+          )+      )+  {-# INLINE unfirst #-}+  unsecond (BiId x) =+    BiId+      ( unsecond+          ( dimap+              (\(d, sa) -> fmap (d,) sa)+              (\tdb -> (fst (extract tdb), fmap snd tdb))+              x+          )+      )+  {-# INLINE unsecond #-}++-- |+-- >>> let BiId f = unleft (BiId id :: BiId (->) Identity Identity (Either Int Char) (Either Int Char))+-- >>> f (Identity 7)+-- Identity 7+instance (Cochoice p, Applicative s, Traversable t) => Cochoice (BiId p s t) where+  unleft (BiId x) =+    BiId+      ( unleft+          ( dimap+              (either (fmap Left) (pure . Right))+              (either Right Left . traverse (either Right Left))+              x+          )+      )+  {-# INLINE unleft #-}+  unright (BiId x) =+    BiId+      ( unright+          ( dimap+              (either (pure . Left) (fmap Right))+              (either Left Right . traverse (either Left Right))+              x+          )+      )+  {-# INLINE unright #-}++-- |+-- >>> BiId ([1,2], [3,4]) <> BiId ([5], [6]) :: BiId (,) [] [] Int Int+-- BiId ([1,2,5],[3,4,6])+instance (Semigroup (p (s a) (t b))) => Semigroup (BiId p s t a b) where+  BiId x <> BiId y =+    BiId (x <> y)+  {-# INLINE (<>) #-}++-- |+-- >>> mempty :: BiId (,) [] [] Int Int+-- BiId ([],[])+instance (Monoid (p (s a) (t b))) => Monoid (BiId p s t a b) where+  mempty =+    BiId mempty+  {-# INLINE mempty #-}++-- |+-- >>> duplicated (BiId (Identity 7, Identity True))+-- BiId (Identity 7,Identity (BiId (Identity 7,Identity True)))+instance (Comonad (p (s a)), Comonad t) => Extend (BiId p s t a) where+  duplicated (BiId x) =+    BiId (extend (\px -> extend (\tb -> BiId (fmap (const tb) px)) (extract px)) x)+  {-# INLINE duplicated #-}++-- |+-- >>> extract (BiId (Identity 7, Identity True))+-- True+instance (Comonad (p (s a)), Comonad t) => Comonad (BiId p s t a) where+  extract (BiId x) =+    extract (extract x)+  {-# INLINE extract #-}+  duplicate (BiId x) =+    BiId (extend (\px -> extend (\tb -> BiId (fmap (const tb) px)) (extract px)) x)+  {-# INLINE duplicate #-}++-- |+-- >>> foldMap1 Sum (BiId (Identity "hello", Identity 7))+-- Sum {getSum = 7}+instance (Foldable1 (p (s a)), Foldable1 t) => Foldable1 (BiId p s t a) where+  foldMap1 f (BiId x) =+    foldMap1 (foldMap1 f) x+  {-# INLINE foldMap1 #-}++-- |+-- >>> traverse1 Just (BiId (Identity "hello", Identity 7))+-- Just (BiId (Identity "hello",Identity 7))+instance (Traversable1 (p (s a)), Traversable1 t) => Traversable1 (BiId p s t a) where+  traverse1 f (BiId x) =+    BiId <$> traverse1 (traverse1 f) x+  {-# INLINE traverse1 #-}++instance (MonadPlus (p (s a)), Monad t, Traversable t) => MonadPlus (BiId p s t a)++-- |+-- >>> distribute [BiId (Tagged (Identity 1)), BiId (Tagged (Identity 2))] :: BiId Tagged [] Identity Int [Int]+-- BiId (Tagged (Identity [1,2]))+instance (Distributive (p (s a)), Distributive t) => Distributive (BiId p s t a) where+  distribute x =+    BiId (fmap distribute (distribute (fmap (\(BiId y) -> y) x)))+  {-# INLINE distribute #-}+  collect f x =+    distribute (fmap f x)+  {-# INLINE collect #-}++instance (MonadZip (p (s a)), MonadZip t, Traversable t, Monad t, Monad (p (s a))) => MonadZip (BiId p s t a) where+  mzipWith f (BiId x) (BiId y) =+    BiId (mzipWith (mzipWith f) x y)+  {-# INLINE mzipWith #-}++instance (MonadFail (p (s a)), Traversable t, Monad t) => MonadFail (BiId p s t a) where+  fail s =+    BiId (fail s)+  {-# INLINE fail #-}++instance (MonadIO (p (s a)), Applicative t, Traversable t, Monad t) => MonadIO (BiId p s t a) where+  liftIO =+    BiId . fmap pure . liftIO+  {-# INLINE liftIO #-}++-- |+-- >>> import Control.Monad.Reader (runReader)+-- >>> (\(BiId f) -> f (Identity 42)) (ask :: BiId (->) Identity Identity Int (Identity Int))+-- Identity (Identity 42)+instance (MonadReader r (p (s a)), Traversable t, Monad t) => MonadReader r (BiId p s t a) where+  ask =+    BiId (fmap pure ask)+  {-# INLINE ask #-}+  local f (BiId x) =+    BiId (local f x)+  {-# INLINE local #-}+  reader f =+    BiId (fmap pure (reader f))+  {-# INLINE reader #-}++instance (MonadState st (p (s a)), Traversable t, Monad t) => MonadState st (BiId p s t a) where+  get =+    BiId (fmap pure get)+  {-# INLINE get #-}+  put =+    BiId . fmap pure . put+  {-# INLINE put #-}+  state f =+    BiId (fmap pure (state f))+  {-# INLINE state #-}++instance (MonadWriter w (p (s a)), Comonad t, Traversable t, Monad t) => MonadWriter w (BiId p s t a) where+  writer aw =+    BiId (fmap pure (writer aw))+  {-# INLINE writer #-}+  tell =+    BiId . fmap pure . tell+  {-# INLINE tell #-}+  listen (BiId x) =+    BiId (fmap (\(tb, w) -> fmap (, w) tb) (listen x))+  {-# INLINE listen #-}+  pass (BiId x) =+    BiId (pass (fmap (\twf -> (fmap fst twf, snd (extract twf))) x))+  {-# INLINE pass #-}++instance (MonadError e (p (s a)), Traversable t, Monad t) => MonadError e (BiId p s t a) where+  throwError =+    BiId . fmap pure . throwError+  {-# INLINE throwError #-}+  catchError (BiId x) f =+    BiId (catchError x (\e -> let BiId y = f e in y))+  {-# INLINE catchError #-}++instance (MonadCont (p (s a)), Traversable t, Monad t) => MonadCont (BiId p s t a) where+  callCC f =+    BiId (callCC (\k -> let BiId x = f (BiId . k . pure) in x))+  {-# INLINE callCC #-}++instance (MonadRWS r w st (p (s a)), Comonad t, Traversable t, Monad t) => MonadRWS r w st (BiId p s t a)

@@ -6,7 +6,6 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -Wall -Werror #-}  -- | -- @Id f a@ — a newtype around @f a@, with optics and instances for switching@@ -47,6 +46,7 @@     -- * Optics     __Wrapped,     __Unwrapped,+    idIdentity,     idTagged,     idProxy,     just,@@ -57,6 +57,8 @@ where  import Control.Applicative (Alternative (empty, (<|>)))+import Control.Comonad (Comonad (..))+import Control.DeepSeq (NFData (..), NFData1 (..)) import Control.Lens   ( FoldableWithIndex (..),     FunctorWithIndex (..),@@ -96,6 +98,7 @@ import Control.Monad.Zip (MonadZip (..)) import Control.Selective (Selective (..)) import Data.Data (Data)+import Data.Distributive (Distributive (..)) import Data.Functor.Alt (Alt ((<!>))) import Data.Functor.Apply (Apply ((<.>))) import Data.Functor.Bind (Bind ((>>-)))@@ -103,15 +106,15 @@ import Data.Functor.Classes   ( Eq1 (..),     Ord1 (..),-    Read1 (..),     Show1 (liftShowsPrec),   ) import Data.Functor.Const (Const) import Data.Functor.Contravariant (Contravariant (..)) import Data.Functor.Contravariant.Divisible (Decidable (..), Divisible (..)) import Data.Functor.Extend (Extend (..))-import Data.Functor.Identity (Identity (Identity))+import Data.Functor.Identity (Identity (Identity, runIdentity)) import Data.Functor.Plus (Plus (..))+import Data.Hashable (Hashable (..)) import Data.List.NonEmpty (NonEmpty) import Data.Proxy (Proxy (..)) import Data.Semigroup.Foldable (Foldable1 (foldMap1))@@ -142,7 +145,7 @@ -- True newtype Id f a   = Id (f a)-  deriving (Eq, Ord, Show, Read, Data, Generic, Generic1)+  deriving (Eq, Ord, Show, Data, Generic, Generic1)  -- | -- >>> liftEq (==) (Id [1,2,3]) (Id [1,2,3])@@ -156,6 +159,7 @@ instance (Eq1 f) => Eq1 (Id f) where   liftEq f (Id x) (Id y) =     liftEq f x y+  {-# INLINE liftEq #-}  -- | -- >>> liftCompare compare (Id [1,2,3]) (Id [1,2,4])@@ -169,6 +173,7 @@ instance (Ord1 f) => Ord1 (Id f) where   liftCompare f (Id x) (Id y) =     liftCompare f x y+  {-# INLINE liftCompare #-}  -- | -- >>> liftShowsPrec showsPrec showList 0 (Id [1,2,3]) ""@@ -182,21 +187,8 @@ instance (Show1 f) => Show1 (Id f) where   liftShowsPrec sp l d (Id x) =     showParen (d > 10) $ showString "Id " . liftShowsPrec sp l 11 x+  {-# INLINE liftShowsPrec #-} --- |--- >>> liftReadsPrec readsPrec readList 0 "Id [1,2,3]" :: [(Id [] Int, String)]--- [(Id [1,2,3],"")]------ >>> liftReadsPrec readsPrec readList 0 "Id (Just 'x')" :: [(Id Maybe Char, String)]--- [(Id (Just 'x'),"")]------ >>> liftReadsPrec readsPrec readList 11 "(Id [1,2,3])" :: [(Id [] Int, String)]--- [(Id [1,2,3],"")]-instance (Read1 f) => Read1 (Id f) where-  liftReadsPrec rp rl d =-    readParen-      (d > 10)-      (\s -> [(Id x, t) | ("Id", r) <- lex s, (x, t) <- liftReadsPrec rp rl 11 r])  instance   (Id f a ~ x) =>@@ -214,6 +206,7 @@       f a   _Wrapped' =     iso (\(Id x) -> x) Id+  {-# INLINE _Wrapped' #-}  -- | -- >>> view __Wrapped (Id [1,2,3])@@ -255,6 +248,7 @@   iso     (\(Id x) -> x)     Id+{-# INLINE __Wrapped #-}  -- | -- >>> view __Unwrapped [1,2,3] :: Id [] Int@@ -296,6 +290,7 @@   iso     Id     (\(Id x) -> x)+{-# INLINE __Unwrapped #-}  -- | -- >>> unId (Id [1,2,3])@@ -305,6 +300,7 @@ -- Identity 7 unId :: Id f a -> f a unId (Id x) = x+{-# INLINE unId #-}  -- | -- >>> mapId reverse (Id [1,2,3])@@ -317,6 +313,7 @@ -- Id (Identity [1,2,3]) mapId :: (f a -> g b) -> Id f a -> Id g b mapId = over __Wrapped+{-# INLINE mapId #-}  -- | -- >>> view getId (Id [1,2,3])@@ -331,42 +328,52 @@ instance GetterId (Id f a) f a where   getId =     id+  {-# INLINE getId #-}  instance GetterId (Identity a) Identity a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId (Maybe a) Maybe a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId [a] [] a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId (NonEmpty a) NonEmpty a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId (Either e a) (Either e) a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId (w, a) ((,) w) a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId (Const c a) (Const c) a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId (Proxy a) Proxy a where   getId =     to Id+  {-# INLINE getId #-}  instance GetterId (Tagged s a) (Tagged s) a where   getId =     to Id+  {-# INLINE getId #-}  -- | -- >>> view id' (Id [1,2,3])@@ -382,46 +389,57 @@     Lens' a (Id f x)   id' =     lens (view getId) (flip setId)+  {-# INLINE id' #-}  instance HasId (Id f a) f a where   setId =     const+  {-# INLINE setId #-}  instance HasId (Identity a) Identity a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId (Maybe a) Maybe a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId [a] [] a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId (NonEmpty a) NonEmpty a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId (Either e a) (Either e) a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId (w, a) ((,) w) a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId (Const c a) (Const c) a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId (Proxy a) Proxy a where   setId =     const . unId+  {-# INLINE setId #-}  instance HasId (Tagged s a) (Tagged s) a where   setId =     const . unId+  {-# INLINE setId #-}  -- | -- >>> review reviewId (Id [1,2,3]) :: Id [] Int@@ -436,42 +454,52 @@ instance ReviewId (Id f a) f a where   reviewId =     unto id+  {-# INLINE reviewId #-}  instance ReviewId (Identity a) Identity a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId (Maybe a) Maybe a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId [a] [] a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId (NonEmpty a) NonEmpty a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId (Either e a) (Either e) a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId (w, a) ((,) w) a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId (Const c a) (Const c) a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId (Proxy a) Proxy a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  instance ReviewId (Tagged s a) (Tagged s) a where   reviewId =     unto unId+  {-# INLINE reviewId #-}  -- | -- >>> preview _Id (Id [1,2,3])@@ -487,46 +515,57 @@     Prism' a (Id f x)   _Id =     prism' (review reviewId) matchId+  {-# INLINE _Id #-}  instance AsId (Id f a) f a where   matchId =     Just+  {-# INLINE matchId #-}  instance AsId (Identity a) Identity a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId (Maybe a) Maybe a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId [a] [] a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId (NonEmpty a) NonEmpty a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId (Either e a) (Either e) a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId (w, a) ((,) w) a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId (Const c a) (Const c) a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId (Proxy a) Proxy a where   matchId =     Just . Id+  {-# INLINE matchId #-}  instance AsId (Tagged s a) (Tagged s) a where   matchId =     Just . Id+  {-# INLINE matchId #-}  -- | -- >>> Id [1,2,3] <> Id [4,5]@@ -537,6 +576,7 @@ instance (Semigroup (f a)) => Semigroup (Id f a) where   Id x <> Id y =     Id (x <> y)+  {-# INLINE (<>) #-}  -- | -- >>> mempty :: Id [] Int@@ -550,6 +590,7 @@ instance (Monoid (f a)) => Monoid (Id f a) where   mempty =     Id mempty+  {-# INLINE mempty #-}  -- | -- >>> fmap (+1) (Id [1,2,3])@@ -561,8 +602,9 @@ -- >>> fmap show (Id [1,2,3]) -- Id ["1","2","3"] instance (Functor f) => Functor (Id f) where-  fmap =-    over _Wrapped . fmap+  fmap f (Id x) =+    Id (fmap f x)+  {-# INLINE fmap #-}  -- | -- >>> Id [(+1), (*2)] <.> Id [3,4]@@ -573,6 +615,7 @@ instance (Apply f) => Apply (Id f) where   Id x <.> Id y =     Id (x <.> y)+  {-# INLINE (<.>) #-}  -- | -- >>> Id [(+1), (*2)] <*> Id [3,4]@@ -586,14 +629,19 @@ instance (Applicative f) => Applicative (Id f) where   Id x <*> Id y =     Id (x <*> y)+  {-# INLINE (<*>) #-}   pure =     Id . pure+  {-# INLINE pure #-}   liftA2 f (Id x) (Id y) =     Id (liftA2 f x y)+  {-# INLINE liftA2 #-}   Id x *> Id y =     Id (x *> y)+  {-# INLINE (*>) #-}   Id x <* Id y =     Id (x <* y)+  {-# INLINE (<*) #-}  -- | -- >>> select (Id [Right 7]) (Id [const 0])@@ -607,6 +655,7 @@ instance (Selective f) => Selective (Id f) where   select (Id x) (Id y) =     Id (select x y)+  {-# INLINE select #-}  -- | -- >>> Id [1,2] <!> Id [3,4]@@ -620,6 +669,7 @@ instance (Alt f) => Alt (Id f) where   Id x <!> Id y =     Id (x <!> y)+  {-# INLINE (<!>) #-}  -- | -- >>> Id [1,2] <|> Id [3,4]@@ -636,8 +686,10 @@ instance (Alternative f) => Alternative (Id f) where   Id x <|> Id y =     Id (x <|> y)+  {-# INLINE (<|>) #-}   empty =     Id empty+  {-# INLINE empty #-}  -- | -- >>> Id [1,2,3] >>- (\x -> Id [x, x*10])@@ -648,6 +700,7 @@ instance (Bind f) => Bind (Id f) where   Id x >>- f =     Id (x >>- view _Wrapped . f)+  {-# INLINE (>>-) #-}  -- | -- >>> Id [1,2,3] >>= (\x -> Id [x, x*10])@@ -658,6 +711,7 @@ instance (Monad f) => Monad (Id f) where   Id x >>= f =     Id (x >>= view _Wrapped . f)+  {-# INLINE (>>=) #-}  -- | -- >>> foldMap show (Id [1,2,3])@@ -671,12 +725,16 @@ instance (Foldable f) => Foldable (Id f) where   foldMap f (Id x) =     foldMap f x+  {-# INLINE foldMap #-}   foldr f z (Id x) =     foldr f z x+  {-# INLINE foldr #-}   null (Id x) =     null x+  {-# INLINE null #-}   length (Id x) =     length x+  {-# INLINE length #-}  -- | -- >>> foldMap1 show (Id (Identity 7))@@ -684,6 +742,7 @@ instance (Foldable1 f) => Foldable1 (Id f) where   foldMap1 f (Id x) =     foldMap1 f x+  {-# INLINE foldMap1 #-}  -- | -- >>> traverse Just (Id [1,2,3])@@ -697,6 +756,7 @@ instance (Traversable f) => Traversable (Id f) where   traverse f (Id x) =     Id <$> traverse f x+  {-# INLINE traverse #-}  -- | -- >>> traverse1 Just (Id (Identity 7))@@ -704,6 +764,7 @@ instance (Traversable1 f) => Traversable1 (Id f) where   traverse1 f (Id x) =     Id <$> traverse1 f x+  {-# INLINE traverse1 #-}  -- | -- >>> unId (liftIO (pure 7) :: Id IO Int)@@ -711,6 +772,7 @@ instance (MonadIO f) => MonadIO (Id f) where   liftIO =     Id . liftIO+  {-# INLINE liftIO #-}  -- | -- >>> lift [1,2,3] :: Id [] Int@@ -721,6 +783,7 @@ instance MonadTrans Id where   lift =     Id+  {-# INLINE lift #-}  -- | -- >>> liftB [1,2,3] :: Id [] Int@@ -728,6 +791,7 @@ instance BindTrans Id where   liftB =     Id+  {-# INLINE liftB #-}  -- | -- >>> throwError "oops" :: Id (Either String) Int@@ -738,8 +802,10 @@ instance (MonadError a f) => MonadError a (Id f) where   throwError =     Id . throwError+  {-# INLINE throwError #-}   catchError (Id x) f =     Id (catchError x (view _Wrapped . f))+  {-# INLINE catchError #-}  -- | -- >>> import Control.Monad.Cont (runCont)@@ -748,6 +814,7 @@ instance (MonadCont f) => MonadCont (Id f) where   callCC f =     Id (callCC (\k -> view _Wrapped (f (Id . k))))+  {-# INLINE callCC #-}  -- | -- >>> import Control.Monad.Reader (runReader)@@ -759,10 +826,13 @@ instance (MonadReader a f) => MonadReader a (Id f) where   ask =     Id ask+  {-# INLINE ask #-}   local f (Id x) =     Id (local f x)+  {-# INLINE local #-}   reader =     Id . reader+  {-# INLINE reader #-}  -- | -- >>> import Control.Monad.Writer (runWriter)@@ -774,12 +844,16 @@ instance (MonadWriter a f) => MonadWriter a (Id f) where   writer aw =     Id (writer aw)+  {-# INLINE writer #-}   tell =     Id . tell+  {-# INLINE tell #-}   listen =     over _Wrapped listen+  {-# INLINE listen #-}   pass =     over _Wrapped pass+  {-# INLINE pass #-}  -- | -- >>> import Control.Monad.State (runState)@@ -788,10 +862,13 @@ instance (MonadState a f) => MonadState a (Id f) where   get =     Id get+  {-# INLINE get #-}   put =     Id . put+  {-# INLINE put #-}   state =     Id . state+  {-# INLINE state #-}  instance (MonadRWS r w s f) => MonadRWS r w s (Id f) @@ -801,6 +878,7 @@ instance (MonadFix f) => MonadFix (Id f) where   mfix g =     Id (mfix (unId . g))+  {-# INLINE mfix #-}  -- | -- >>> fail "oops" :: Id Maybe Int@@ -808,6 +886,7 @@ instance (MonadFail f) => MonadFail (Id f) where   fail =     Id . fail+  {-# INLINE fail #-}  -- | -- >>> mzero :: Id [] Int@@ -823,6 +902,7 @@ instance (MonadZip f) => MonadZip (Id f) where   mzipWith f (Id x) (Id y) =     Id (mzipWith f x y)+  {-# INLINE mzipWith #-}  -- | -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)@@ -834,6 +914,7 @@ instance (Contravariant f) => Contravariant (Id f) where   contramap f (Id x) =     Id (contramap f x)+  {-# INLINE contramap #-}  -- | -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)@@ -846,8 +927,10 @@ instance (Divisible f) => Divisible (Id f) where   divide f (Id x) (Id y) =     Id (divide f x y)+  {-# INLINE divide #-}   conquer =     Id conquer+  {-# INLINE conquer #-}  -- | -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)@@ -860,8 +943,10 @@ instance (Decidable f) => Decidable (Id f) where   choose f (Id x) (Id y) =     Id (choose f x y)+  {-# INLINE choose #-}   lose f =     Id (lose f)+  {-# INLINE lose #-}  -- | -- >>> zero :: Id [] Int@@ -869,6 +954,7 @@ instance (Plus f) => Plus (Id f) where   zero =     Id zero+  {-# INLINE zero #-}  -- | -- >>> duplicated (Id (Identity 7))@@ -876,14 +962,27 @@ instance (Extend f) => Extend (Id f) where   duplicated (Id x) =     Id (Id <$> duplicated x)+  {-# INLINE duplicated #-}  -- |+-- >>> extract (Id (Identity 7))+-- 7+instance (Comonad f) => Comonad (Id f) where+  extract (Id x) =+    extract x+  {-# INLINE extract #-}+  duplicate (Id x) =+    Id (Id <$> duplicate x)+  {-# INLINE duplicate #-}++-- | -- >>> import Control.Lens (imap) -- >>> imap (+) (Id [10,20,30]) -- Id [10,21,32] instance (FunctorWithIndex i f) => FunctorWithIndex i (Id f) where   imap f (Id x) =     Id (imap f x)+  {-# INLINE imap #-}  -- | -- >>> import Control.Lens (ifoldMap)@@ -892,6 +991,7 @@ instance (FoldableWithIndex i f) => FoldableWithIndex i (Id f) where   ifoldMap f (Id x) =     ifoldMap f x+  {-# INLINE ifoldMap #-}  -- | -- >>> import Control.Lens (itraverse)@@ -903,7 +1003,93 @@ instance (TraversableWithIndex i f) => TraversableWithIndex i (Id f) where   itraverse f (Id x) =     Id <$> itraverse f x+  {-# INLINE itraverse #-} +instance (Distributive f) => Distributive (Id f) where+  distribute x =+    Id (distribute (fmap (\(Id y) -> y) x))+  {-# INLINE distribute #-}+  collect f x =+    Id (collect ((\(Id y) -> y) . f) x)+  {-# INLINE collect #-}++instance (NFData (f a)) => NFData (Id f a) where+  rnf (Id x) =+    rnf x+  {-# INLINE rnf #-}++instance (NFData1 f) => NFData1 (Id f) where+  liftRnf f (Id x) =+    liftRnf f x+  {-# INLINE liftRnf #-}++instance (Hashable (f a)) => Hashable (Id f a) where+  hashWithSalt s (Id x) =+    hashWithSalt s x+  {-# INLINE hashWithSalt #-}++instance (Num (f a)) => Num (Id f a) where+  Id x + Id y = Id (x + y)+  {-# INLINE (+) #-}+  Id x * Id y = Id (x * y)+  {-# INLINE (*) #-}+  Id x - Id y = Id (x - y)+  {-# INLINE (-) #-}+  negate (Id x) = Id (negate x)+  {-# INLINE negate #-}+  abs (Id x) = Id (abs x)+  {-# INLINE abs #-}+  signum (Id x) = Id (signum x)+  {-# INLINE signum #-}+  fromInteger = Id . fromInteger+  {-# INLINE fromInteger #-}++instance (Fractional (f a)) => Fractional (Id f a) where+  Id x / Id y = Id (x / y)+  {-# INLINE (/) #-}+  recip (Id x) = Id (recip x)+  {-# INLINE recip #-}+  fromRational = Id . fromRational+  {-# INLINE fromRational #-}++instance (Floating (f a)) => Floating (Id f a) where+  pi = Id pi+  {-# INLINE pi #-}+  exp (Id x) = Id (exp x)+  {-# INLINE exp #-}+  log (Id x) = Id (log x)+  {-# INLINE log #-}+  sqrt (Id x) = Id (sqrt x)+  {-# INLINE sqrt #-}+  Id x ** Id y = Id (x ** y)+  {-# INLINE (**) #-}+  logBase (Id x) (Id y) = Id (logBase x y)+  {-# INLINE logBase #-}+  sin (Id x) = Id (sin x)+  {-# INLINE sin #-}+  cos (Id x) = Id (cos x)+  {-# INLINE cos #-}+  tan (Id x) = Id (tan x)+  {-# INLINE tan #-}+  asin (Id x) = Id (asin x)+  {-# INLINE asin #-}+  acos (Id x) = Id (acos x)+  {-# INLINE acos #-}+  atan (Id x) = Id (atan x)+  {-# INLINE atan #-}+  sinh (Id x) = Id (sinh x)+  {-# INLINE sinh #-}+  cosh (Id x) = Id (cosh x)+  {-# INLINE cosh #-}+  tanh (Id x) = Id (tanh x)+  {-# INLINE tanh #-}+  asinh (Id x) = Id (asinh x)+  {-# INLINE asinh #-}+  acosh (Id x) = Id (acosh x)+  {-# INLINE acosh #-}+  atanh (Id x) = Id (atanh x)+  {-# INLINE atanh #-}+ -- | -- >>> let x = Id Proxy :: IdProxy Int in x -- Id Proxy@@ -989,7 +1175,21 @@     (Id (Tagged s') a') idTagged =   iso (over __Wrapped (Tagged . view _Wrapped)) (over __Wrapped (Identity . untag))+{-# INLINE idTagged #-} +idIdentity ::+  Iso+    (IdIdentity a)+    (IdIdentity a')+    a+    a'+idIdentity =+  _Wrapped .+    iso+      runIdentity+      Identity+{-# INLINE idIdentity #-}+ -- | -- >>> view idProxy (Id Proxy :: IdProxy Int) -- ()@@ -1004,6 +1204,7 @@     () idProxy =   iso (const ()) (const (Id Proxy))+{-# INLINE idProxy #-}  -- | -- >>> preview (just :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity Int) (IdIdentity Int)) (Id (Just 7))@@ -1034,6 +1235,7 @@   Prism s t a b just =   _Wrapped . _Just . _Unwrapped . _Unwrapped+{-# INLINE just #-}  -- | -- >>> view (rejust :: Getter (IdIdentity Int) (IdMaybe Int)) (Id (Identity 7))@@ -1052,6 +1254,7 @@   Getter b t rejust =   re just+{-# INLINE rejust #-}  -- | -- >>> preview (nothing :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity ()) (IdIdentity ())) (Id Nothing)@@ -1084,6 +1287,7 @@   Prism s t a b nothing =   _Wrapped . _Nothing . _Unwrapped . _Unwrapped+{-# INLINE nothing #-}  -- | -- >>> view (renothing :: Getter (IdIdentity ()) (IdMaybe Int)) (Id (Identity ()))@@ -1103,3 +1307,4 @@   Getter a t renothing =   re nothing+{-# INLINE renothing #-}

@@ -1,5 +1,3 @@-{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}- module Main where  import System.Exit (exitWith)