TypeCompose 0.9.12 → 0.9.13

raw patch · 5 files changed

+22/−8 lines, 5 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• TypeCompose.cabal +1/−1
• src/Control/Compose.hs +10/−3
• src/Data/CxMonoid.hs +6/−2
• src/Data/Title.hs +3/−2
• src/Data/Zip.hs +2/−0

@@ -1,5 +1,5 @@ Name:                TypeCompose-Version:             0.9.12+Version:             0.9.13 Synopsis: 	     Type composition classes & instances Category:            Composition, Control Cabal-Version:       >= 1.6

@@ -87,8 +87,8 @@  import Data.Orphans () import Data.Monoid+import qualified Data.Semigroup as Sem import Data.Foldable-import Data.Traversable import Control.Applicative import Control.Monad (join,liftM) @@ -592,10 +592,13 @@ instance Arrow arr => ContraFunctor (Flip arr b) where   contraFmap h (Flip f) = Flip (arr h >>> f) +instance (Applicative (j a), Sem.Semigroup o) => Sem.Semigroup (Flip j o a) where+  (<>) = inFlip2 (liftA2 (Sem.<>))+ -- Useful for (~>) = (->).  Maybe others. instance (Applicative (j a), Monoid o) => Monoid (Flip j o a) where   mempty  = Flip (pure mempty)-  mappend = inFlip2 (liftA2 mappend)+  mappend = (<>)  -- TODO: generalize (->) to (~>) with Applicative_f (~>) instance Monoid o => Monoid_f (Flip (->) o) where@@ -642,9 +645,12 @@ inApp2 h (App fa) = inApp (h fa)  -- Example: App IO ()+instance (Applicative f, Sem.Semigroup m) => Sem.Semigroup (App f m) where+  (<>) = inApp2 (liftA2 (Sem.<>))+ instance (Applicative f, Monoid m) => Monoid (App f m) where   mempty  =   App  (pure   mempty )-  mappend = inApp2 (liftA2 mappend)+  mappend = (<>)  --  App a `mappend` App b = App (liftA2 mappend a b) @@ -848,6 +854,7 @@  -- For ghc-6.6, use the "deriving" above, but for 6.8 use the "deriving" below. +deriving instance Sem.Semigroup (f a `j` g a) => Sem.Semigroup (Arrw j f g a) deriving instance Monoid (f a `j` g a) => Monoid (Arrw j f g a)  -- Replace with generalized bijection?

@@ -16,6 +16,7 @@ module Data.CxMonoid (MonoidDict, CxMonoid(..), biCxMonoid) where  import Data.Monoid (Monoid(..))+import qualified Data.Semigroup as Sem  import Data.Bijection import Data.Title@@ -30,10 +31,13 @@ biCxMonoid :: (MonoidDict a -> a) :<->: CxMonoid a biCxMonoid = Bi CxMonoid unCxMonoid +instance Sem.Semigroup (CxMonoid a) where+  CxMonoid f <> CxMonoid g  =+    CxMonoid (\ md@(_,op) -> f md `op` g md)+ instance Monoid (CxMonoid a) where   mempty = CxMonoid (\ (e,_) -> e)-  CxMonoid f `mappend` CxMonoid g  =-    CxMonoid (\ md@(_,op) -> f md `op` g md)+  mappend = (Sem.<>)  -- Exploit the function instance of 'Title' instance Title a => Title (CxMonoid a) where

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, OverlappingInstances, TypeOperators, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances, TypeOperators, TypeSynonymInstances #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- |@@ -40,7 +40,8 @@  instance Title_f g => Title_f (g :. f) where title_f str = inO (title_f str) -instance Title_f f => Title (f a) where title = title_f+instance {-# OVERLAPPABLE #-} Title_f f => Title (f a) where+  title = title_f  instance Title String where   title ttl str = (ttl ++ suffix ++ str)

@@ -5,6 +5,8 @@ #else {-# OPTIONS_GHC -fenable-rewrite-rules #-} #endif+{-# OPTIONS_GHC -Wno-inline-rule-shadowing #-}+  ---------------------------------------------------------------------- -- |