invariant 0.2.2 → 0.3

raw patch · 3 files changed

+171/−38 lines, 3 filesdep +StateVardep ~basedep ~bifunctorsdep ~contravariantPVP ok

version bump matches the API change (PVP)

Dependencies added: StateVar

Dependency ranges changed: base, bifunctors, contravariant, profunctors, template-haskell

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• invariant.cabal +13/−6
• src/Data/Functor/Invariant.hs +148/−32

@@ -1,3 +1,13 @@+# 0.3+* Require `bifunctors-5.2` and `profunctors-5.2`. Add `Invariant(2)` instances+  for newly introduced datatypes from those packages.+* Add `ProfunctorFunctor`, `ProfunctorMonad`, `ProfunctorComonad`, `Mapping`,+  and `Traversing` instances for `WrappedProfunctor`+* Add `StateVar` as a dependency. Add `Invariant` instances for `StateVar` and+  `SettableStateVar`.+* Add `Invariant` instances for `URec` (added to `GHC.Generics` in+  `base-4.9.0.0`)+ # 0.2.2 * Add `genericInvmap` function (and make it the default implementation of   `invmap` for `Invariant` instances) on GHC 7.2 or later

@@ -1,5 +1,5 @@ name:                invariant-version:             0.2.2+version:             0.3 synopsis:            Haskell 98 invariant functors description:         Haskell 98 invariant functors category:            Control, Data@@ -12,6 +12,12 @@                      Ryan Scott <ryan.gl.scott@gmail.com> build-type:          Simple cabal-version:       >= 1.9.2+tested-with:         GHC == 7.0.4+                   , GHC == 7.2.2+                   , GHC == 7.4.2+                   , GHC == 7.6.3+                   , GHC == 7.8.4+                   , GHC == 7.10.3 extra-source-files:  CHANGELOG.md, README.md  source-repository head@@ -26,21 +32,22 @@   hs-source-dirs:      src   build-depends:       array                >= 0.3    && < 0.6                      , base                 >= 4      && < 5-                     , bifunctors           >= 5      && < 6+                     , bifunctors           >= 5.2    && < 6                      , containers           >= 0.1    && < 0.6-                     , contravariant        >= 0.1.2  && < 2+                     , contravariant        >= 0.5    && < 2                      , ghc-prim-                     , profunctors          >= 5      && < 6+                     , profunctors          >= 5.2    && < 6                      , semigroups           >= 0.16.2 && < 1+                     , StateVar             >= 1.1    && < 2                      , stm                  >= 2.2    && < 3                      , tagged               >= 0.7.3  && < 1                      , template-haskell     >= 2.4    && < 2.12-                     , transformers         >= 0.2    && < 0.5+                     , transformers         >= 0.2    && < 0.6                      , transformers-compat  >= 0.3    && < 1                      , unordered-containers >= 0.2.4  && < 0.3   ghc-options:         -Wall -test-suite qc-tests+test-suite spec   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Spec.hs

@@ -6,6 +6,8 @@ #if GHC_GENERICS_OK {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} #endif  #if __GLASGOW_HASKELL__ >= 706@@ -48,7 +50,7 @@  -- base import qualified Control.Category as Cat-import           Control.Arrow+import           Control.Arrow hiding (first) import           Control.Applicative as App import           Control.Exception (Handler(..)) import           Control.Monad (MonadPlus(..), liftM)@@ -77,13 +79,15 @@ import           Data.Array (Array)  -- bifunctors-import           Data.Bifunctor hiding (first)+import           Data.Bifunctor import           Data.Bifunctor.Biff import           Data.Bifunctor.Clown+import           Data.Bifunctor.Fix import           Data.Bifunctor.Flip import           Data.Bifunctor.Join import           Data.Bifunctor.Joker-import qualified Data.Bifunctor.Product as Bifunctors+import qualified Data.Bifunctor.Product as Bifunctor+import qualified Data.Bifunctor.Sum as Bifunctor import           Data.Bifunctor.Tannen import           Data.Bifunctor.Wrapped @@ -101,17 +105,25 @@ -- profunctors import           Data.Profunctor as Pro import           Data.Profunctor.Cayley+import           Data.Profunctor.Choice import           Data.Profunctor.Closed-import           Data.Profunctor.Codensity import           Data.Profunctor.Composition+import           Data.Profunctor.Mapping+import           Data.Profunctor.Monad+import           Data.Profunctor.Rep import           Data.Profunctor.Ran-import           Data.Profunctor.Tambara+import           Data.Profunctor.Strong+import           Data.Profunctor.Traversing+import           Data.Profunctor.Unsafe  -- semigroups import           Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Semigroup as Semigroup (First(..), Last(..), Option(..)) import           Data.Semigroup (Min(..), Max(..), Arg(..)) +-- StateVar+import           Data.StateVar (StateVar(..), SettableStateVar(..))+ -- stm import           Control.Concurrent.STM (STM) @@ -207,7 +219,7 @@   ArrowApply a #endif   => Invariant (ArrowMonad a) where-  invmap f _ (ArrowMonad m) = ArrowMonad $ m >>> arr f+  invmap f _ (ArrowMonad m) = ArrowMonad (m >>> arr f)  -- | from @Control.Exception@ instance Invariant Handler where@@ -267,6 +279,9 @@ instance Invariant (Clown f a) where   invmap = invmapFunctor -- | from the @bifunctors@ package+instance Invariant2 p => Invariant (Fix p) where+  invmap f g = In . invmap2 (invmap f g) (invmap g f) f g . out+-- | from the @bifunctors@ package instance Invariant2 p => Invariant (Flip p a) where   invmap = invmap2 id id -- | from the @bifunctors@ package@@ -274,7 +289,7 @@   invmap f g = Join . invmap2 f g f g . runJoin -- | from the @bifunctors@ package instance Invariant g => Invariant (Joker g a) where-  invmap = invmap2 id id+  invmap f g = Joker . invmap f g . runJoker -- | from the @bifunctors@ package instance (Invariant f, Invariant2 p) => Invariant (Tannen f p a) where   invmap = invmap2 id id@@ -339,6 +354,12 @@ instance Invariant2 p => Invariant (Codensity p a) where   invmap = invmap2 id id -- | from the @profunctors@ package+instance Invariant2 p => Invariant (Coprep p) where+  invmap f g (Coprep h) = Coprep (h . invmap2 g f id id)+-- | from the @profunctors@ package+instance Invariant2 p => Invariant (Prep p) where+  invmap f g (Prep x p) = Prep x (invmap2 id id f g p)+-- | from the @profunctors@ package instance Invariant2 p => Invariant (Procompose p q a) where   invmap k k' (Procompose f g) = Procompose (invmap2 id id k k' f) g -- | from the @profunctors@ package@@ -351,7 +372,13 @@ instance Invariant2 p => Invariant (Tambara p a) where   invmap = invmap2 id id -- | from the @profunctors@ package-instance Invariant2 p => Invariant (Cotambara p a) where+instance Invariant (Cotambara p a) where+  invmap = invmapFunctor+-- | from the @profunctors@ package+instance Invariant (CotambaraSum p a) where+  invmap = invmapFunctor+-- | from the @profunctors@ package+instance Invariant2 p => Invariant (TambaraSum p a) where   invmap = invmap2 id id  -- | from the @semigroups@ package@@ -376,6 +403,13 @@ instance Invariant (Arg a) where   invmap = invmapFunctor +-- | from the @StateVar@ package+instance Invariant StateVar where+  invmap f g (StateVar ga sa) = StateVar (fmap f ga) (lmap g sa)+-- | from the @StateVar@ package+instance Invariant SettableStateVar where+  invmap = invmapContravariant+ -- | from the @stm@ package instance Invariant STM where   invmap = invmapFunctor@@ -413,12 +447,14 @@ instance Invariant m => Invariant (Lazy.RWST r w s m) where   invmap f g m = Lazy.RWST $ \r s ->     invmap (mapFstTriple f) (mapFstTriple g) $ Lazy.runRWST m r s-      where mapFstTriple h ~(a, s, w) = (h a, s, w)+      where mapFstTriple :: (a -> b) -> (a, c, d) -> (b, c, d)+            mapFstTriple h ~(a, s, w) = (h a, s, w) -- | from the @transformers@ package instance Invariant m => Invariant (Strict.RWST r w s m) where   invmap f g m = Strict.RWST $ \r s ->     invmap (mapFstTriple f) (mapFstTriple g) $ Strict.runRWST m r s-      where mapFstTriple h (a, s, w) = (h a, s, w)+      where mapFstTriple :: (a -> b) -> (a, c, d) -> (b, c, d)+            mapFstTriple h (a, s, w) = (h a, s, w) -- | from the @transformers@ package instance Invariant m => Invariant (ReaderT r m) where   invmap f g = mapReaderT (invmap f g)@@ -426,20 +462,24 @@ instance Invariant m => Invariant (Lazy.StateT s m) where   invmap f g m = Lazy.StateT $ \s ->     invmap (mapFstPair f) (mapFstPair g) $ Lazy.runStateT m s-      where mapFstPair h ~(a, s) = (h a, s)+      where mapFstPair :: (a -> b) -> (a, c) -> (b, c)+            mapFstPair h ~(a, s) = (h a, s) -- | from the @transformers@ package instance Invariant m => Invariant (Strict.StateT s m) where   invmap f g m = Strict.StateT $ \s ->     invmap (mapFstPair f) (mapFstPair g) $ Strict.runStateT m s-      where mapFstPair h (a, s) = (h a, s)+      where mapFstPair :: (a -> b) -> (a, c) -> (b, c)+            mapFstPair h (a, s) = (h a, s) -- | from the @transformers@ package instance Invariant m => Invariant (Lazy.WriterT w m) where   invmap f g = Lazy.mapWriterT $ invmap (mapFstPair f) (mapFstPair g)-    where mapFstPair h ~(a, w) = (h a, w)+    where mapFstPair :: (a -> b) -> (a, c) -> (b, c)+          mapFstPair h ~(a, w) = (h a, w) -- | from the @transformers@ package instance Invariant m => Invariant (Strict.WriterT w m) where   invmap f g = Strict.mapWriterT $ invmap (mapFstPair f) (mapFstPair g)-    where mapFstPair h (a, w) = (h a, w)+    where mapFstPair :: (a -> b) -> (a, c) -> (b, c)+          mapFstPair h (a, w) = (h a, w) -- | from the @transformers@ package instance (Invariant f, Invariant g) => Invariant (Transformers.Compose f g) where   invmap f g (Transformers.Compose x) =@@ -471,26 +511,32 @@   deriving (Eq, Ord, Read, Show)  instance Functor f => Invariant (WrappedFunctor f) where-  invmap f g = WrapFunctor . invmapFunctor f g . unwrapFunctor+  invmap = invmapFunctor  instance Functor f => Functor (WrappedFunctor f) where   fmap f = WrapFunctor . fmap f . unwrapFunctor+  x <$ WrapFunctor f = WrapFunctor (x <$ f)  instance Applicative f => Applicative (WrappedFunctor f) where   pure = WrapFunctor . pure-  WrapFunctor f <*> WrapFunctor x = WrapFunctor $ f <*> x+  WrapFunctor f <*> WrapFunctor x = WrapFunctor (f <*> x)+  WrapFunctor a *>  WrapFunctor b = WrapFunctor (a *>  b)+  WrapFunctor a <*  WrapFunctor b = WrapFunctor (a <*  b)  instance Alternative f => Alternative (WrappedFunctor f) where   empty = WrapFunctor empty-  WrapFunctor x <|> WrapFunctor y = WrapFunctor $ x <|> y+  WrapFunctor x <|> WrapFunctor y = WrapFunctor (x <|> y)+  some = WrapFunctor . some . unwrapFunctor+  many = WrapFunctor . many . unwrapFunctor  instance Monad m => Monad (WrappedFunctor m) where   return = WrapFunctor . return-  WrapFunctor x >>= f = WrapFunctor $ x >>= unwrapFunctor . f+  WrapFunctor x >>= f = WrapFunctor (x >>= unwrapFunctor . f)+  WrapFunctor a >> WrapFunctor b = WrapFunctor (a >> b)  instance MonadPlus m => MonadPlus (WrappedFunctor m) where   mzero = WrapFunctor mzero-  WrapFunctor x `mplus` WrapFunctor y = WrapFunctor $ x `mplus` y+  WrapFunctor x `mplus` WrapFunctor y = WrapFunctor (x `mplus` y)  instance F.Foldable f => F.Foldable (WrappedFunctor f) where   fold       = F.fold       . unwrapFunctor@@ -529,10 +575,11 @@   deriving (Eq, Ord, Read, Show)  instance Contravariant f => Invariant (WrappedContravariant f) where-  invmap f g = WrapContravariant . invmapContravariant f g . unwrapContravariant+  invmap = invmapContravariant  instance Contravariant f => Contravariant (WrappedContravariant f) where   contramap f = WrapContravariant . contramap f . unwrapContravariant+  x >$ WrapContravariant f = WrapContravariant (x >$ f)  instance Divisible f => Divisible (WrappedContravariant f) where   divide f (WrapContravariant l) (WrapContravariant r) =@@ -606,16 +653,20 @@ instance Invariant g => Invariant2 (Joker g) where   invmap2 _ _ g g' = Joker . invmap g g' . runJoker -- | from the @bifunctors@ package-instance (Invariant2 f, Invariant2 g) => Invariant2 (Bifunctors.Product f g) where-  invmap2 f f' g g' (Bifunctors.Pair x y) =-    Bifunctors.Pair (invmap2 f f' g g' x) (invmap2 f f' g g' y)+instance (Invariant2 f, Invariant2 g) => Invariant2 (Bifunctor.Product f g) where+  invmap2 f f' g g' (Bifunctor.Pair x y) =+    Bifunctor.Pair (invmap2 f f' g g' x) (invmap2 f f' g g' y) -- | from the @bifunctors@ package+instance (Invariant2 p, Invariant2 q) => Invariant2 (Bifunctor.Sum p q) where+  invmap2 f f' g g' (Bifunctor.L2 l) = Bifunctor.L2 (invmap2 f f' g g' l)+  invmap2 f f' g g' (Bifunctor.R2 r) = Bifunctor.R2 (invmap2 f f' g g' r)+-- | from the @bifunctors@ package instance (Invariant f, Invariant2 p) => Invariant2 (Tannen f p) where   invmap2 f f' g g' =     Tannen . invmap (invmap2 f f' g g') (invmap2 f' f g' g) . runTannen -- | from the @bifunctors@ package instance Bifunctor p => Invariant2 (WrappedBifunctor p) where-  invmap2 f f' g g' = WrapBifunctor . invmap2Bifunctor f f' g g' . unwrapBifunctor+  invmap2 = invmap2Bifunctor  -- | from the @contravariant@ package instance Invariant2 Op where@@ -642,7 +693,7 @@   invmap2 f f' g g' (Closure p) = Closure $ invmap2 (f .) (f' .) (g .) (g' .) p -- | from the @profunctors@ package instance Invariant2 (Environment p) where-  invmap2 _ f' g _ (Environment l m r) = Environment (g . l) m (r . f')+  invmap2 = invmap2Profunctor -- | from the @profunctors@ package instance Invariant2 p => Invariant2 (Codensity p) where   invmap2 ac ca bd db (Codensity f) =@@ -662,15 +713,38 @@   invmap2 f f' g g' (Tambara p) =     Tambara $ invmap2 (first f) (first f') (first g) (first g') p -- | from the @profunctors@ package+instance Invariant2 (PastroSum p) where+  invmap2 = invmap2Profunctor+-- | from the @profunctors@ package+instance Invariant2 p => Invariant2 (CofreeMapping p) where+  invmap2 f f' g g' (CofreeMapping p) =+    CofreeMapping (invmap2 (fmap f) (fmap f') (fmap g) (fmap g') p)+-- | from the @profunctors@ package+instance Invariant2 (FreeMapping p) where+  invmap2 = invmap2Profunctor+-- | from the @profunctors@ package+instance Invariant2 p => Invariant2 (CofreeTraversing p) where+  invmap2 f f' g g' (CofreeTraversing p) =+    CofreeTraversing (invmap2 (fmap f) (fmap f') (fmap g) (fmap g') p)+-- | from the @profunctors@ package+instance Invariant2 (FreeTraversing p) where+  invmap2 = invmap2Profunctor+-- | from the @profunctors@ package instance Invariant2 (Pastro p) where-  invmap2 _ f' g _ (Pastro l m r) = Pastro (g . l) m (r . f')+  invmap2 = invmap2Profunctor -- | from the @profunctors@ package-instance Invariant2 p => Invariant2 (Cotambara p) where-  invmap2 f f' g g' (Cotambara p) =-    Cotambara $ invmap2 (left f) (left f') (left g) (left g') p+instance Invariant2 (Cotambara p) where+  invmap2 = invmap2Profunctor -- | from the @profunctors@ package-instance Invariant2 (Copastro p) where-  invmap2 _ f' g _ (Copastro l m r) = Copastro (g . l) m (r . f')+instance Invariant2 (CopastroSum p) where+  invmap2 = invmap2Profunctor+-- | from the @profunctors@ package+instance Invariant2 (CotambaraSum p) where+  invmap2 = invmap2Profunctor+-- | from the @profunctors@ package+instance Invariant2 p => Invariant2 (TambaraSum p) where+  invmap2 f f' g g' (TambaraSum p) =+    TambaraSum (invmap2 (first f) (first f') (first g) (first g') p)  -- | from the @semigroups@ package instance Invariant2 Arg where@@ -693,13 +767,17 @@   deriving (Eq, Ord, Read, Show)  instance Profunctor p => Invariant2 (WrappedProfunctor p) where-  invmap2 f f' g g' = WrapProfunctor . invmap2Profunctor f f' g g' . unwrapProfunctor+  invmap2 = invmap2Profunctor  instance Profunctor p => Invariant (WrappedProfunctor p a) where   invmap = invmap2 id id  instance Profunctor p => Profunctor (WrappedProfunctor p) where   dimap f g = WrapProfunctor . dimap f g . unwrapProfunctor+  lmap f    = WrapProfunctor . lmap f    . unwrapProfunctor+  rmap g    = WrapProfunctor . rmap g    . unwrapProfunctor+  WrapProfunctor x .# f = WrapProfunctor (x .# f)+  g #. WrapProfunctor x = WrapProfunctor (g #. x)  instance Strong p => Strong (WrappedProfunctor p) where   first'  = WrapProfunctor . first'  . unwrapProfunctor@@ -720,6 +798,24 @@ instance Closed p => Closed (WrappedProfunctor p) where   closed = WrapProfunctor . closed . unwrapProfunctor +instance Traversing p => Traversing (WrappedProfunctor p) where+  traverse' = WrapProfunctor . traverse' . unwrapProfunctor+  wander f  = WrapProfunctor . wander f  . unwrapProfunctor++instance Mapping p => Mapping (WrappedProfunctor p) where+  map' = WrapProfunctor . map' . unwrapProfunctor++instance ProfunctorFunctor WrappedProfunctor where+  promap f = WrapProfunctor . f . unwrapProfunctor++instance ProfunctorMonad WrappedProfunctor where+  proreturn = WrapProfunctor+  projoin   = unwrapProfunctor++instance ProfunctorComonad WrappedProfunctor where+  proextract   = unwrapProfunctor+  produplicate = WrapProfunctor+ #if GHC_GENERICS_OK ------------------------------------------------------------------------------- -- GHC Generics@@ -752,6 +848,26 @@ -- likely requires writing your 'Generic1' instance by hand instance (Invariant f, Invariant g) => Invariant ((:.:) f g) where   invmap f g (Comp1 fgp) = Comp1 $ invmap (invmap f g) (invmap g f) fgp++# if __GLASGOW_HASKELL__ >= 800+instance Invariant UAddr where+  invmap _ _ (UAddr a) = UAddr a++instance Invariant UChar where+  invmap _ _ (UChar c) = UChar c++instance Invariant UDouble where+  invmap _ _ (UDouble d) = UDouble d++instance Invariant UFloat where+  invmap _ _ (UFloat f) = UFloat f++instance Invariant UInt where+  invmap _ _ (UInt i) = UInt i++instance Invariant UWord where+  invmap _ _ (UWord w) = UWord w+# endif  {- $ghcgenerics With GHC 7.2 or later, 'Invariant' instances can be defined easily using GHC