id 0.0.0.1 → 0.0.2

raw patch · 6 files changed

+821/−193 lines, 6 filesdep +contravariantdep +processdep +selectivedep ~semigroupoidsdep ~taggeddep ~transformerssetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: contravariant, process, selective

Dependency ranges changed: semigroupoids, tagged, transformers

API changes (from Hackage documentation)

Files

• LICENCE +22/−25
• Setup.hs +1/−0
• changelog.md +14/−1
• id.cabal +25/−14
• src/Data/Id.hs +741/−153
• test/Main.hs +18/−0

@@ -1,30 +1,27 @@-Copyright (c) 2025 Tony Morris+Copyright 2025-2026 Tony Morris  All rights reserved.  Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.--    * 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.--    * Neither the name of Tony Morris nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+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 author nor the names of his 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-OWNER 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.+THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.

@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain

@@ -1,3 +1,16 @@-0.0.0.1+0.0.2++* Add type classes: GetterId, HasId, ReviewId, AsId+* Add type aliases: IdProxy, IdMaybe, IdIdentity, IdEither, IdWriter, IdList, IdNonEmpty, IdConst, IdTagged+* Add functions: unId, mapId+* Add __Wrapped iso (fully type-changing) with specializations for all type aliases+* Add optics: idTagged, idProxy, just, rejust, nothing, renothing+* Add instances: Read, Data, Generic1, Eq1, Ord1, Show1, Read1, Selective, MonadFix, MonadFail, MonadPlus, MonadZip, Contravariant, Divisible, Decidable, Plus, Extend, FunctorWithIndex, FoldableWithIndex, TraversableWithIndex+* Add efficiency methods for Applicative and Foldable+* Fix MonadRWS instance to use distinct type variables+* Add contravariant dependency+* Add doctest suite, CI, ormolu/hlint configuration++0.0.1  * The initial version of id.

@@ -1,37 +1,48 @@+cabal-version:        2.4 name:                 id-version:              0.0.0.1+version:              0.0.2 synopsis:             Id (f a) data type-description:-  (f a) data type, with optics and functions for switching the type constructor (f)-  .-  <<https://logo.systemf.com.au/systemf-450x450.jpg>>-license:              BSD3+description:          (f a) data type, with optics and functions for switching the type constructor (f)+license:              BSD-3-Clause license-file:         LICENCE author:               Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> maintainer:           Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>-copyright:            Copyright (C) 2025 Tony Morris+copyright:            Copyright (C) 2025-2026 Tony Morris category:             Data build-type:           Simple-extra-source-files:   changelog.md-cabal-version:        >=1.10+extra-doc-files:      changelog.md homepage:             https://gitlab.com/system-f/code/id bug-reports:          https://gitlab.com/system-f/code/id/issues-tested-with:          GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.5, GHC == 9.4.8, GHC == 9.6.7+tested-with:          GHC == 9.6.7  source-repository     head   type:               git-  location:           git@github.com:system-f/code/id.git+  location:           git@gitlab.com:system-f/code/id.git  library   exposed-modules:    Data.Id    build-depends:        base >= 4.8 && < 6+                      , contravariant >= 1.4 && < 2                       , lens >= 4 && < 6                       , mtl >= 2.2 && < 3-                      , semigroupoids-                      , tagged-                      , transformers+                      , semigroupoids >= 6 && < 7+                      , tagged >= 0.8 && < 1+                      , selective >= 0.7 && < 1+                      , transformers >= 0.5 && < 1    hs-source-dirs:     src++  default-language:   Haskell2010++  ghc-options:        -Wall++test-suite doctest+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            Main.hs+  build-depends:      base >= 4.8 && < 6+                    , process >= 1 && < 2+  build-tool-depends: doctest:doctest >= 0.22   default-language:   Haskell2010   ghc-options:        -Wall

@@ -1,75 +1,248 @@-{-# OPTIONS_GHC -Wall #-}--{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall -Werror #-} -module Data.Id where+-- |+-- @Id f a@ — a newtype around @f a@, with optics and instances for switching+-- the type constructor @f@.+module Data.Id+  ( -- * Id data type+    Id (..), -import Control.Applicative ( Alternative(empty, (<|>)) )+    -- * Functions+    unId,+    mapId,++    -- * Type aliases+    IdProxy,+    IdMaybe,+    IdIdentity,+    IdEither,+    IdWriter,+    IdList,+    IdNonEmpty,+    IdConst,+    IdTagged,++    -- * Type classes++    -- ** GetterId+    GetterId (..),++    -- ** HasId+    HasId (..),++    -- ** ReviewId+    ReviewId (..),++    -- ** AsId+    AsId (..),++    -- * Optics+    __Wrapped,+    idTagged,+    idProxy,+    just,+    rejust,+    nothing,+    renothing,+  )+where++import Control.Applicative (Alternative (empty, (<|>))) import Control.Lens-    ( Wrapped(..),-      Rewrapped,-      Iso,-      Lens',-      Prism,-      Getter,-      iso,-      over,-      _Wrapped,-      view,-      _Just,-      _Unwrapped,-      re,-      _Nothing )-import Control.Monad.Cont ( MonadCont(..) )-import Control.Monad.Error.Class ( MonadError(..) )-import Control.Monad.IO.Class ( MonadIO(..) )-import Control.Monad.Reader.Class ( MonadReader(..) )-import Control.Monad.RWS.Class ( MonadRWS )-import Control.Monad.State.Class ( MonadState(..) )-import Control.Monad.Trans.Class ( MonadTrans(..) )-import Control.Monad.Writer( MonadWriter(..) )-import Data.Functor.Alt ( Alt((<!>)) )-import Data.Functor.Apply ( Apply((<.>)) )-import Data.Functor.Bind ( Bind((>>-)) )-import Data.Functor.Bind.Trans ( BindTrans(..) )+  ( FoldableWithIndex (..),+    FunctorWithIndex (..),+    Getter,+    Iso,+    Lens',+    Prism,+    Prism',+    Review,+    Rewrapped,+    TraversableWithIndex (..),+    Wrapped (..),+    iso,+    lens,+    over,+    prism',+    re,+    review,+    unto,+    view,+    _Just,+    _Nothing,+    _Unwrapped,+    _Wrapped,+  )+import Control.Monad (MonadPlus (..))+import Control.Monad.Cont (MonadCont (..))+import Control.Monad.Error.Class (MonadError (..))+import Control.Monad.Fix (MonadFix (..))+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.Trans.Class (MonadTrans (..))+import Control.Monad.Writer (MonadWriter (..))+import Control.Monad.Zip (MonadZip (..))+import Control.Selective (Selective (..))+import Data.Data (Data)+import Data.Functor.Alt (Alt ((<!>)))+import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Bind (Bind ((>>-)))+import Data.Functor.Bind.Trans (BindTrans (..)) import Data.Functor.Classes-    ( Eq1(..), Ord1(..), Show1(liftShowsPrec) )-import Data.Functor.Identity ( Identity(Identity) )-import Data.Semigroup.Foldable ( Foldable1(foldMap1) )-import Data.Semigroup.Traversable ( Traversable1(traverse1) )-import Data.Tagged ( Tagged(Tagged), untag )-import Data.Proxy ( Proxy )+  ( 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.Plus (Plus (..))+import Data.List.NonEmpty (NonEmpty)+import Data.Proxy (Proxy (..))+import Data.Semigroup.Foldable (Foldable1 (foldMap1))+import Data.Semigroup.Traversable (Traversable1 (traverse1))+import Data.Tagged (Tagged (Tagged), untag)+import GHC.Generics (Generic, Generic1) -newtype Id f a =-  Id (f a)-  deriving (Eq, Ord, Show)+-- $setup+-- >>> import Control.Lens (set, preview, review, from)+-- >>> import Data.Functor.Const (Const(..))+-- >>> import Data.List.NonEmpty (NonEmpty(..))+-- >>> import Data.Semigroup (Sum(..)) -instance Eq1 f => Eq1 (Id f) where+-- |+-- >>> Id [1,2,3]+-- Id [1,2,3]+--+-- >>> Id [1,2,3] == Id [1,2,3]+-- True+--+-- >>> Id [1,2,3] == Id [4,5,6]+-- False+--+-- >>> compare (Id [1,2,3]) (Id [1,2,4])+-- LT+--+-- >>> Id [1,2,3] <= Id [1,2,3]+-- True+newtype Id f a+  = Id (f a)+  deriving (Eq, Ord, Show, Read, Data, Generic, Generic1)++-- |+-- >>> liftEq (==) (Id [1,2,3]) (Id [1,2,3])+-- True+--+-- >>> liftEq (==) (Id [1,2,3]) (Id [4,5,6])+-- False+--+-- >>> liftEq (\_ _ -> True) (Id [1,2,3]) (Id [4,5,6])+-- True+instance (Eq1 f) => Eq1 (Id f) where   liftEq f (Id x) (Id y) =     liftEq f x y -instance Ord1 f => Ord1 (Id f) where+-- |+-- >>> liftCompare compare (Id [1,2,3]) (Id [1,2,4])+-- LT+--+-- >>> liftCompare compare (Id [1,2,3]) (Id [1,2,3])+-- EQ+--+-- >>> liftCompare (\_ _ -> GT) (Id [1]) (Id [2])+-- GT+instance (Ord1 f) => Ord1 (Id f) where   liftCompare f (Id x) (Id y) =     liftCompare f x y -instance Show1 f => Show1 (Id f) where+-- |+-- >>> liftShowsPrec showsPrec showList 0 (Id [1,2,3]) ""+-- "Id [1,2,3]"+--+-- >>> liftShowsPrec showsPrec showList 0 (Id (Just 'x')) ""+-- "Id (Just 'x')"+--+-- >>> liftShowsPrec showsPrec showList 11 (Id [1,2,3]) ""+-- "(Id [1,2,3])"+instance (Show1 f) => Show1 (Id f) where   liftShowsPrec sp l d (Id x) =-    ("Id (" <>) . liftShowsPrec sp l d x . (")" <>)+    showParen (d > 10) $ showString "Id " . liftShowsPrec sp l 11 x -instance (Id f a ~ x) =>+-- |+-- >>> 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) =>   Rewrapped (Id f a') x +-- |+-- >>> view _Wrapped' (Id [1,2,3])+-- [1,2,3]+--+-- >>> set _Wrapped' [4,5] (Id [1,2,3])+-- Id [4,5] instance Wrapped (Id f a) where-  type Unwrapped (Id f a) =-    f a+  type+    Unwrapped (Id f a) =+      f a   _Wrapped' =     iso (\(Id x) -> x) Id +-- |+-- >>> view __Wrapped (Id [1,2,3])+-- [1,2,3]+--+-- >>> view (from __Wrapped) [1,2,3] :: Id [] Int+-- Id [1,2,3]+--+-- >>> over __Wrapped (fmap (+1)) (Id [1,2,3])+-- Id [2,3,4]+{-# SPECIALIZE __Wrapped ::+  Iso (IdMaybe a) (IdMaybe a') (Maybe a) (Maybe a')+  #-}+{-# SPECIALIZE __Wrapped ::+  Iso (IdIdentity a) (IdIdentity a') (Identity a) (Identity a')+  #-}+{-# SPECIALIZE __Wrapped ::+  Iso (IdEither e a) (IdEither e' a') (Either e a) (Either e' a')+  #-}+{-# SPECIALIZE __Wrapped ::+  Iso (IdWriter w a) (IdWriter w' a') (w, a) (w', a')+  #-}+{-# SPECIALIZE __Wrapped ::+  Iso (IdList a) (IdList a') [a] [a']+  #-}+{-# SPECIALIZE __Wrapped ::+  Iso (IdNonEmpty a) (IdNonEmpty a') (NonEmpty a) (NonEmpty a')+  #-}+{-# SPECIALIZE __Wrapped ::+  Iso (IdConst c a) (IdConst c' a') (Const c a) (Const c' a')+  #-} __Wrapped ::   Iso     (Id f a)@@ -81,101 +254,322 @@     (\(Id x) -> x)     Id -class HasId a f a' | a -> f a' where-  id' ::-    Lens' a (Id f a')+-- |+-- >>> unId (Id [1,2,3])+-- [1,2,3]+--+-- >>> unId (Id (Identity 7))+-- Identity 7+unId :: Id f a -> f a+unId (Id x) = x -instance HasId (Id f a') f a' where-  id' =+-- |+-- >>> mapId reverse (Id [1,2,3])+-- Id [3,2,1]+--+-- >>> mapId (Just . head) (Id [1,2,3])+-- Id (Just 1)+--+-- >>> mapId Identity (Id [1,2,3])+-- Id (Identity [1,2,3])+mapId :: (f a -> g b) -> Id f a -> Id g b+mapId = over __Wrapped++-- |+-- >>> view getId (Id [1,2,3])+-- Id [1,2,3]+--+-- >>> view getId (Id (Identity 7))+-- Id (Identity 7)+class GetterId a f x | a -> f x where+  getId ::+    Getter a (Id f x)++instance GetterId (Id f a) f a where+  getId =     id -class AsId a f a' | a -> f a' where-  _Id ::-    Lens' a (Id f a')+-- |+-- >>> view id' (Id [1,2,3])+-- Id [1,2,3]+--+-- >>> set id' (Id [4,5]) (Id [1,2,3])+-- Id [4,5]+class (GetterId a f x) => HasId a f x | a -> f x where+  {-# MINIMAL setId #-}+  setId ::+    Id f x -> a -> a+  id' ::+    Lens' a (Id f x)+  id' =+    lens (view getId) (flip setId) -instance AsId (Id f a') f a' where+instance HasId (Id f a) f a where+  setId =+    const++-- |+-- >>> review reviewId [1,2,3] :: Id [] Int+-- Id [1,2,3]+--+-- >>> review reviewId (Identity 7) :: IdIdentity Int+-- Id (Identity 7)+class ReviewId a f x | a -> f x where+  reviewId ::+    Review a (f x)++instance ReviewId (Id f a) f a where+  reviewId =+    unto Id++-- |+-- >>> preview _Id (Id [1,2,3])+-- Just (Id [1,2,3])+--+-- >>> review _Id (Id [1,2,3]) :: Id [] Int+-- Id [1,2,3]+class (ReviewId a f x) => AsId a f x | a -> f x where+  {-# MINIMAL matchId #-}+  matchId ::+    a -> Maybe (Id f x)+  _Id ::+    Prism' a (Id f x)   _Id =-    id+    prism' (review reviewId . unId) matchId -instance Semigroup (f a) => Semigroup (Id f a) where+instance AsId (Id f a) f a where+  matchId =+    Just++-- |+-- >>> Id [1,2,3] <> Id [4,5]+-- Id [1,2,3,4,5]+--+-- >>> Id "hello" <> Id " world"+-- Id "hello world"+instance (Semigroup (f a)) => Semigroup (Id f a) where   Id x <> Id y =     Id (x <> y) -instance Monoid (f a) => Monoid (Id f a) where+-- |+-- >>> mempty :: Id [] Int+-- Id []+--+-- >>> Id [1,2] <> mempty+-- Id [1,2]+--+-- >>> mempty <> Id [1,2] :: Id [] Int+-- Id [1,2]+instance (Monoid (f a)) => Monoid (Id f a) where   mempty =     Id mempty -instance Functor f => Functor (Id f) where+-- |+-- >>> fmap (+1) (Id [1,2,3])+-- Id [2,3,4]+--+-- >>> fmap (*2) (Id (Identity 5))+-- Id (Identity 10)+--+-- >>> fmap show (Id [1,2,3])+-- Id ["1","2","3"]+instance (Functor f) => Functor (Id f) where   fmap =     over _Wrapped . fmap -instance Apply f => Apply (Id f) where+-- |+-- >>> Id [(+1), (*2)] <.> Id [3,4]+-- Id [4,5,6,8]+--+-- >>> Id (Identity (+1)) <.> Id (Identity 5)+-- Id (Identity 6)+instance (Apply f) => Apply (Id f) where   Id x <.> Id y =     Id (x <.> y) -instance Applicative f => Applicative (Id f) where+-- |+-- >>> Id [(+1), (*2)] <*> Id [3,4]+-- Id [4,5,6,8]+--+-- >>> pure 7 :: Id [] Int+-- Id [7]+--+-- >>> pure 'x' :: Id Identity Char+-- Id (Identity 'x')+instance (Applicative f) => Applicative (Id f) where   Id x <*> Id y =     Id (x <*> y)   pure =     Id . pure+  liftA2 f (Id x) (Id y) =+    Id (liftA2 f x y)+  Id x *> Id y =+    Id (x *> y)+  Id x <* Id y =+    Id (x <* y) -instance Alt f => Alt (Id f) where+-- |+-- >>> select (Id [Right 7]) (Id [const 0])+-- Id [7]+--+-- >>> select (Id [Left 3]) (Id [(+1)])+-- Id [4]+--+-- >>> select (Id [Left 3, Right 7]) (Id [(+1), (*2)])+-- Id [4,6,7]+instance (Selective f) => Selective (Id f) where+  select (Id x) (Id y) =+    Id (select x y)++-- |+-- >>> Id [1,2] <!> Id [3,4]+-- Id [1,2,3,4]+--+-- >>> Id (Just 1) <!> Id (Just 2)+-- Id (Just 1)+--+-- >>> Id Nothing <!> Id (Just 2)+-- Id (Just 2)+instance (Alt f) => Alt (Id f) where   Id x <!> Id y =     Id (x <!> y) -instance Alternative f => Alternative (Id f) where+-- |+-- >>> Id [1,2] <|> Id [3,4]+-- Id [1,2,3,4]+--+-- >>> Id Nothing <|> Id (Just 2)+-- Id (Just 2)+--+-- >>> empty :: Id [] Int+-- Id []+--+-- >>> empty :: Id Maybe Int+-- Id Nothing+instance (Alternative f) => Alternative (Id f) where   Id x <|> Id y =     Id (x <|> y)   empty =     Id empty -instance Bind f => Bind (Id f) where+-- |+-- >>> Id [1,2,3] >>- (\x -> Id [x, x*10])+-- Id [1,10,2,20,3,30]+--+-- >>> Id (Identity 5) >>- (Id . Identity . (+1))+-- Id (Identity 6)+instance (Bind f) => Bind (Id f) where   Id x >>- f =     Id (x >>- view _Wrapped . f) -instance Monad f => Monad (Id f) where+-- |+-- >>> Id [1,2,3] >>= (\x -> Id [x, x*10])+-- Id [1,10,2,20,3,30]+--+-- >>> Id (Identity 5) >>= (Id . Identity . (+1))+-- Id (Identity 6)+instance (Monad f) => Monad (Id f) where   Id x >>= f =     Id (x >>= view _Wrapped . f) -instance Foldable f => Foldable (Id f) where+-- |+-- >>> foldMap show (Id [1,2,3])+-- "123"+--+-- >>> foldMap Sum (Id [1,2,3])+-- Sum {getSum = 6}+--+-- >>> foldr (:) [] (Id [1,2,3])+-- [1,2,3]+instance (Foldable f) => Foldable (Id f) where   foldMap f (Id x) =     foldMap f x+  foldr f z (Id x) =+    foldr f z x+  null (Id x) =+    null x+  length (Id x) =+    length x -instance Foldable1 f => Foldable1 (Id f) where+-- |+-- >>> foldMap1 show (Id (Identity 7))+-- "7"+instance (Foldable1 f) => Foldable1 (Id f) where   foldMap1 f (Id x) =     foldMap1 f x -instance Traversable f => Traversable (Id f) where+-- |+-- >>> traverse Just (Id [1,2,3])+-- Just (Id [1,2,3])+--+-- >>> traverse (\x -> if x > 2 then Nothing else Just x) (Id [1,2,3])+-- Nothing+--+-- >>> traverse (\x -> if x > 3 then Nothing else Just x) (Id [1,2,3])+-- Just (Id [1,2,3])+instance (Traversable f) => Traversable (Id f) where   traverse f (Id x) =     Id <$> traverse f x -instance Traversable1 f => Traversable1 (Id f) where+-- |+-- >>> traverse1 Just (Id (Identity 7))+-- Just (Id (Identity 7))+instance (Traversable1 f) => Traversable1 (Id f) where   traverse1 f (Id x) =     Id <$> traverse1 f x -instance MonadIO f => MonadIO (Id f) where+-- |+-- >>> unId (liftIO (pure 7) :: Id IO Int)+-- 7+instance (MonadIO f) => MonadIO (Id f) where   liftIO =     Id . liftIO +-- |+-- >>> lift [1,2,3] :: Id [] Int+-- Id [1,2,3]+--+-- >>> lift (Identity 5) :: Id Identity Int+-- Id (Identity 5) instance MonadTrans Id where   lift =     Id +-- |+-- >>> liftB [1,2,3] :: Id [] Int+-- Id [1,2,3] instance BindTrans Id where   liftB =     Id -instance MonadError a f => MonadError a (Id f) where+-- |+-- >>> throwError "oops" :: Id (Either String) Int+-- Id (Left "oops")+--+-- >>> catchError (Id (Left "oops")) (\_ -> Id (Right 42)) :: Id (Either String) Int+-- Id (Right 42)+instance (MonadError a f) => MonadError a (Id f) where   throwError =     Id . throwError   catchError (Id x) f =     Id (catchError x (view _Wrapped . f)) -instance MonadCont f => MonadCont (Id f) where+-- |+-- >>> import Control.Monad.Cont (runCont)+-- >>> runCont (callCC (\k -> k (Id [7]))) unId :: [Int]+-- [7]+instance (MonadCont f) => MonadCont (Id f) where   callCC f =     Id (callCC (\k -> view _Wrapped (f (Id . k)))) -instance MonadReader a f => MonadReader a (Id f) where+-- |+-- >>> import Control.Monad.Reader (runReader)+-- >>> runReader (unId ask) "hello"+-- "hello"+--+-- >>> runReader (unId (local (++" world") ask)) "hello"+-- "hello world"+instance (MonadReader a f) => MonadReader a (Id f) where   ask =     Id ask   local f (Id x) =@@ -183,7 +577,14 @@   reader =     Id . reader -instance MonadWriter a f => MonadWriter a (Id f) where+-- |+-- >>> import Control.Monad.Writer (runWriter)+-- >>> runWriter (unId (tell "hello" >> tell " world"))+-- ((),"hello world")+--+-- >>> runWriter (unId (writer (7, "log")))+-- (7,"log")+instance (MonadWriter a f) => MonadWriter a (Id f) where   writer aw =     Id (writer aw)   tell =@@ -193,7 +594,11 @@   pass =     over _Wrapped pass -instance MonadState a f => MonadState a (Id f) where+-- |+-- >>> import Control.Monad.State (runState)+-- >>> runState (unId (get >>= \s -> put (s + 1) >> pure s)) 10+-- (10,11)+instance (MonadState a f) => MonadState a (Id f) where   get =     Id get   put =@@ -201,91 +606,291 @@   state =     Id . state -instance MonadRWS a a a f => MonadRWS a a a (Id f) where+instance (MonadRWS r w s f) => MonadRWS r w s (Id f) -type Id0 a =+-- |+-- >>> mfix (\_ -> Id [1,2,3])+-- Id [1,2,3]+instance (MonadFix f) => MonadFix (Id f) where+  mfix g =+    Id (mfix (unId . g))++-- |+-- >>> fail "oops" :: Id Maybe Int+-- Id Nothing+instance (MonadFail f) => MonadFail (Id f) where+  fail =+    Id . fail++-- |+-- >>> mzero :: Id [] Int+-- Id []+--+-- >>> mplus (Id [1,2]) (Id [3,4])+-- Id [1,2,3,4]+instance (MonadPlus f) => MonadPlus (Id f)++-- |+-- >>> mzipWith (+) (Id [1,2,3]) (Id [10,20,30])+-- Id [11,22,33]+instance (MonadZip f) => MonadZip (Id f) where+  mzipWith f (Id x) (Id y) =+    Id (mzipWith f x y)++-- |+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)+-- >>> getPredicate (unId (contramap length (Id (Predicate (> 3))))) "hello"+-- True+--+-- >>> getPredicate (unId (contramap length (Id (Predicate (> 3))))) "hi"+-- False+instance (Contravariant f) => Contravariant (Id f) where+  contramap f (Id x) =+    Id (contramap f x)++-- |+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)+-- >>> import Data.Functor.Contravariant.Divisible (divided)+-- >>> getPredicate (unId (divided (Id (Predicate even)) (Id (Predicate (> 0))))) (4, 1)+-- True+--+-- >>> getPredicate (unId (divided (Id (Predicate even)) (Id (Predicate (> 0))))) (3, 1)+-- False+instance (Divisible f) => Divisible (Id f) where+  divide f (Id x) (Id y) =+    Id (divide f x y)+  conquer =+    Id conquer++-- |+-- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)+-- >>> import Data.Functor.Contravariant.Divisible (chosen)+-- >>> getPredicate (unId (chosen (Id (Predicate even)) (Id (Predicate (> 0))))) (Left 4)+-- True+--+-- >>> getPredicate (unId (chosen (Id (Predicate even)) (Id (Predicate (> 0))))) (Right 0)+-- False+instance (Decidable f) => Decidable (Id f) where+  choose f (Id x) (Id y) =+    Id (choose f x y)+  lose f =+    Id (lose f)++-- |+-- >>> zero :: Id [] Int+-- Id []+instance (Plus f) => Plus (Id f) where+  zero =+    Id zero++-- |+-- >>> duplicated (Id (Identity 7))+-- Id (Identity (Id (Identity 7)))+instance (Extend f) => Extend (Id f) where+  duplicated (Id x) =+    Id (Id <$> duplicated x)++-- |+-- >>> 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)++-- |+-- >>> import Control.Lens (ifoldMap)+-- >>> ifoldMap (\i x -> [(i, x)]) (Id [10,20,30])+-- [(0,10),(1,20),(2,30)]+instance (FoldableWithIndex i f) => FoldableWithIndex i (Id f) where+  ifoldMap f (Id x) =+    ifoldMap f x++-- |+-- >>> import Control.Lens (itraverse)+-- >>> itraverse (\i x -> if i > 1 then Nothing else Just (x * 10)) (Id [1,2,3])+-- Nothing+--+-- >>> itraverse (\i x -> if i > 2 then Nothing else Just (x * 10)) (Id [1,2,3])+-- Just (Id [10,20,30])+instance (TraversableWithIndex i f) => TraversableWithIndex i (Id f) where+  itraverse f (Id x) =+    Id <$> itraverse f x++-- |+-- >>> let x = Id Proxy :: IdProxy Int in x+-- Id Proxy+type IdProxy a =   Id Proxy a -type IdB a =+-- |+-- >>> Id (Just 3) :: IdMaybe Int+-- Id (Just 3)+--+-- >>> Id Nothing :: IdMaybe Int+-- Id Nothing+type IdMaybe a =   Id Maybe a -type Id1 a =+-- |+-- >>> Id (Identity 7) :: IdIdentity Int+-- Id (Identity 7)+type IdIdentity a =   Id Identity a +-- |+-- >>> Id (Left "err") :: IdEither String Int+-- Id (Left "err")+--+-- >>> Id (Right 7) :: IdEither String Int+-- Id (Right 7)+type IdEither e a =+  Id (Either e) a++-- |+-- >>> Id ("log", 7) :: IdWriter String Int+-- Id ("log",7)+type IdWriter w a =+  Id ((,) w) a++-- |+-- >>> Id [1,2,3] :: IdList Int+-- Id [1,2,3]+--+-- >>> Id [] :: IdList Int+-- Id []+type IdList a =+  Id [] a++-- |+-- >>> Id (1 :| [2,3]) :: IdNonEmpty Int+-- Id (1 :| [2,3])+type IdNonEmpty a =+  Id NonEmpty a++-- |+-- >>> Id (Const "hello") :: IdConst String Int+-- Id (Const "hello")+type IdConst c a =+  Id (Const c) a++-- |+-- >>> Id (Tagged 7) :: IdTagged Bool Int+-- Id (Tagged 7) type IdTagged f a =   Id (Tagged f) a -{-#-  SPECIALIZE-  idTagged ::-    Iso-      (Id1 a)-      (Id1 a')-      (IdTagged f a)-      (IdTagged f a')+-- |+-- >>> view idTagged (Id (Identity 7)) :: IdTagged Bool Int+-- Id (Tagged 7)+--+-- >>> view (from idTagged) (Id (Tagged 7) :: IdTagged Bool Int) :: IdIdentity Int+-- Id (Identity 7)+{-# SPECIALIZE idTagged ::+  Iso+    (IdIdentity a)+    (IdIdentity a')+    (IdTagged f a)+    (IdTagged f a')   #-} idTagged ::-  Rewrapped (f a) (f a) =>+  (Rewrapped (f a) (f a)) =>   Iso     (Id f a)-    (Id1 a')+    (IdIdentity a')     (Id (Tagged s) (Unwrapped (f a)))     (Id (Tagged s') a') idTagged =   iso (over __Wrapped (Tagged . view _Wrapped)) (over __Wrapped (Identity . untag)) -{-#-  SPECIALIZE-  just ::-    Prism-      (IdB a)-      (IdB a')-      (Id1 a)-      (Id1 a')+-- |+-- >>> view idProxy (Id Proxy :: IdProxy Int)+-- ()+--+-- >>> set idProxy () (Id Proxy :: IdProxy Int)+-- Id Proxy+idProxy ::+  Iso+    (IdProxy a)+    (IdProxy a')+    ()+    ()+idProxy =+  iso (const ()) (const (Id Proxy))++-- |+-- >>> preview (just :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity Int) (IdIdentity Int)) (Id (Just 7))+-- Just (Id (Identity 7))+--+-- >>> preview (just :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity Int) (IdIdentity Int)) (Id Nothing)+-- Nothing+--+-- >>> review (just :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity Int) (IdIdentity Int)) (Id (Identity 7))+-- Id (Just 7)+{-# SPECIALIZE just ::+  Prism+    (IdMaybe a)+    (IdMaybe a')+    (IdIdentity a)+    (IdIdentity a')   #-} just ::-  (-    Unwrapped s ~ Maybe (Unwrapped (Unwrapped a)),+  ( Unwrapped s ~ Maybe (Unwrapped (Unwrapped a)),     Unwrapped t ~ Maybe (Unwrapped (Unwrapped b)),-    Rewrapped s t, Rewrapped t s, Rewrapped b a,-    Rewrapped a b, Rewrapped (Unwrapped b) (Unwrapped a),+    Rewrapped s t,+    Rewrapped t s,+    Rewrapped b a,+    Rewrapped a b,+    Rewrapped (Unwrapped b) (Unwrapped a),     Rewrapped (Unwrapped a) (Unwrapped b)   ) =>   Prism s t a b just =   _Wrapped . _Just . _Unwrapped . _Unwrapped -{-#-  SPECIALIZE-  rejust ::-    Getter-      (Id1 a)-      (IdB a)+-- |+-- >>> view (rejust :: Getter (IdIdentity Int) (IdMaybe Int)) (Id (Identity 7))+-- Id (Just 7)+{-# SPECIALIZE rejust ::+  Getter+    (IdIdentity a)+    (IdMaybe a)   #-} rejust ::-  (-    Unwrapped t ~ Maybe (Unwrapped (Unwrapped b)), Rewrapped t t,-    Rewrapped b b, Rewrapped (Unwrapped b) (Unwrapped b)+  ( Unwrapped t ~ Maybe (Unwrapped (Unwrapped b)),+    Rewrapped t t,+    Rewrapped b b,+    Rewrapped (Unwrapped b) (Unwrapped b)   ) =>   Getter b t rejust =   re just -{-#-  SPECIALIZE-  nothing ::-    Prism-      (IdB a)-      (IdB a)-      (Id1 ())-      (Id1 ())+-- |+-- >>> preview (nothing :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity ()) (IdIdentity ())) (Id Nothing)+-- Just (Id (Identity ()))+--+-- >>> preview (nothing :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity ()) (IdIdentity ())) (Id (Just 7))+-- Nothing+--+-- >>> review (nothing :: Prism (IdMaybe Int) (IdMaybe Int) (IdIdentity ()) (IdIdentity ())) (Id (Identity ()))+-- Id Nothing+{-# SPECIALIZE nothing ::+  Prism+    (IdMaybe a)+    (IdMaybe a)+    (IdIdentity ())+    (IdIdentity ())   #-} nothing ::-  (-    Unwrapped t ~ Maybe x, Unwrapped s ~ Maybe x,-    Unwrapped (Unwrapped a) ~ (), Unwrapped (Unwrapped b) ~ (),-    Rewrapped s t, Rewrapped t s,-    Rewrapped b a, Rewrapped a b,+  ( Unwrapped t ~ Maybe x,+    Unwrapped s ~ Maybe x,+    Unwrapped (Unwrapped a) ~ (),+    Unwrapped (Unwrapped b) ~ (),+    Rewrapped s t,+    Rewrapped t s,+    Rewrapped b a,+    Rewrapped a b,     Rewrapped (Unwrapped b) (Unwrapped a),     Rewrapped (Unwrapped a) (Unwrapped b)   ) =>@@ -293,38 +898,21 @@ nothing =   _Wrapped . _Nothing . _Unwrapped . _Unwrapped -{-#-  SPECIALIZE-  renothing ::-    Getter-      (Id1 ())-      (IdB a)+-- |+-- >>> view (renothing :: Getter (IdIdentity ()) (IdMaybe Int)) (Id (Identity ()))+-- Id Nothing+{-# SPECIALIZE renothing ::+  Getter+    (IdIdentity ())+    (IdMaybe a)   #-} renothing ::-  (-    Unwrapped t ~ Maybe x, Unwrapped (Unwrapped a) ~ (),-    Rewrapped t t, Rewrapped a a,+  ( Unwrapped t ~ Maybe x,+    Unwrapped (Unwrapped a) ~ (),+    Rewrapped t t,+    Rewrapped a a,     Rewrapped (Unwrapped a) (Unwrapped a)   ) =>   Getter a t renothing =   re nothing--{-#-  SPECIALIZE-  id1 ::-    Iso-    (Id1 a)-    (Id1 a')-    a-    a'-  #-}-id1 ::-  (-    Rewrapped s t, Rewrapped t s,-    Rewrapped (Unwrapped s) (Unwrapped t),-    Rewrapped (Unwrapped t) (Unwrapped s)-  ) =>-  Iso s t (Unwrapped (Unwrapped s)) (Unwrapped (Unwrapped t))-id1 =-  _Wrapped . _Wrapped

@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}++module Main where++import System.Exit (exitWith)+import System.Process (rawSystem)++main :: IO ()+main =+  exitWith+    =<< rawSystem+      "cabal"+      [ "repl",+        "--with-compiler=doctest",+        "--repl-options=-w",+        "--repl-options=-Wdefault",+        "lib:id"+      ]