bound 0.6 → 0.6.1

raw patch · 5 files changed

+107/−19 lines, 5 filesdep +profunctorsdep ~bifunctorsdep ~comonaddep ~prelude-extrasPVP ok

version bump matches the API change (PVP)

Dependencies added: profunctors

Dependency ranges changed: bifunctors, comonad, prelude-extras

API changes (from Hackage documentation)

Files

• bound.cabal +5/−4
• src/Bound/Class.hs +2/−0
• src/Bound/Name.hs +39/−8
• src/Bound/Scope.hs +11/−2
• src/Bound/Var.hs +50/−5

@@ -1,6 +1,6 @@ name:          bound category:      Language, Compilers/Interpreters-version:       0.6+version:       0.6.1 license:       BSD3 cabal-version: >= 1.9.2 license-file:  LICENSE@@ -59,9 +59,10 @@    build-depends:     base           >= 4 && < 5,-    bifunctors     >= 3,-    comonad        >= 3,-    prelude-extras >= 0.3,+    bifunctors     >= 3 && < 4,+    comonad        >= 3 && < 4,+    prelude-extras >= 0.3 && < 1,+    profunctors    >= 3.3 && < 4,     transformers   >= 0.2 && < 0.4    ghc-options: -Wall -O2 -fspec-constr -fdicts-cheap -funbox-strict-fields

@@ -47,6 +47,7 @@   default (>>>=) :: (MonadTrans t, Monad f, Monad (t f)) =>                     t f a -> (a -> f c) -> t f c   m >>>= f = m >>= lift . f+  {-# INLINE (>>>=) #-} #endif  infixr 1 =<<<@@ -55,3 +56,4 @@ -- @('=<<<') = 'flip' ('>>>=')@ (=<<<) :: (Bound t, Monad f) => (a -> f c) -> t f a -> t f c (=<<<) = flip (>>>=)+{-# INLINE (=<<<) #-}

@@ -30,6 +30,7 @@ ---------------------------------------------------------------------------- module Bound.Name   ( Name(..)+  , _Name   , name   , abstractName   , abstract1Name@@ -39,6 +40,9 @@  import Bound.Scope import Bound.Var+import Control.Applicative+import Control.Comonad+import Control.Monad (liftM) import Data.Foldable import Data.Traversable import Data.Monoid@@ -51,9 +55,7 @@ import GHC.Generics # endif #endif-import Control.Applicative-import Control.Comonad-import Control.Monad (liftM)+import Data.Profunctor import Prelude.Extras  -------------------------------------------------------------------------------@@ -80,47 +82,77 @@ -- | Extract the 'name'. name :: Name n b -> n name (Name n _) = n+{-# INLINE name #-} +-- |+--+-- This provides an 'Iso' that can be used to access the parts of a 'Name'.+--+-- @+-- '_Name' :: Iso ('Name' n a) ('Name' m b) (n, a) (m, b)+-- @+_Name :: (Profunctor p, Functor f) => p (n, a) (f (m,b)) -> p (Name n a) (f (Name m b))+_Name = dimap (\(Name n a) -> (n, a)) (fmap (uncurry Name))+{-# INLINE _Name #-}+ ------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------  instance Eq b => Eq (Name n b) where   Name _ a == Name _ b = a == b+  {-# INLINE (==) #-}  instance Ord b => Ord (Name n b) where   Name _ a `compare` Name _ b = compare a b+  {-# INLINE compare #-}  instance Functor (Name n) where   fmap f (Name n a) = Name n (f a)+  {-# INLINE fmap #-}  instance Foldable (Name n) where   foldMap f (Name _ a) = f a+  {-# INLINE foldMap #-}  instance Traversable (Name n) where   traverse f (Name n a) = Name n <$> f a+  {-# INLINE traverse #-}  instance Bifunctor Name where   bimap f g (Name n a) = Name (f n) (g a)+  {-# INLINE bimap #-}  instance Bifoldable Name where   bifoldMap f g (Name n a) = f n `mappend` g a+  {-# INLINE bifoldMap #-}  instance Bitraversable Name where   bitraverse f g (Name n a) = Name <$> f n <*> g a+  {-# INLINE bitraverse #-}  instance Comonad (Name n) where   extract (Name _ b) = b+  {-# INLINE extract #-}   extend f w@(Name n _) = Name n (f w)+  {-# INLINE extend #-} -instance Eq1   (Name b) where (==#)      = (==)-instance Ord1  (Name b) where compare1   = compare+instance Eq1   (Name b) where+  (==#)      = (==)+  {-# INLINE (==#) #-}+instance Ord1  (Name b) where+  compare1   = compare+  {-# INLINE compare1 #-} instance Show b => Show1 (Name b) where showsPrec1 = showsPrec instance Read b => Read1 (Name b) where readsPrec1 = readsPrec  -- these are slightly too restrictive, but still safe-instance Eq2 Name   where (==##)     = (==)-instance Ord2 Name  where compare2   = compare+instance Eq2 Name   where+  (==##)     = (==)+  {-# INLINE (==##) #-}+instance Ord2 Name  where+  compare2   = compare+  {-# INLINE compare2 #-} instance Show2 Name where showsPrec2 = showsPrec instance Read2 Name where readsPrec2  = readsPrec @@ -152,7 +184,6 @@   B b -> k (extract b)   F a -> a {-# INLINE instantiateName #-}-  -- | Enter a 'Scope' that binds one (named) variable, instantiating it. --

@@ -86,36 +86,44 @@  instance Functor f => Functor (Scope b f) where   fmap f (Scope a) = Scope (fmap (fmap (fmap f)) a)+  {-# INLINE fmap #-}  -- | @'toList'@ is provides a list (with duplicates) of the free variables instance Foldable f => Foldable (Scope b f) where   foldMap f (Scope a) = foldMap (foldMap (foldMap f)) a+  {-# INLINE foldMap #-}  instance Traversable f => Traversable (Scope b f) where   traverse f (Scope a) = Scope <$> traverse (traverse (traverse f)) a+  {-# INLINE traverse #-}  -- | The monad permits substitution on free variables, while preserving -- bound variables instance Monad f => Monad (Scope b f) where   return a = Scope (return (F (return a)))+  {-# INLINE return #-}   Scope e >>= f = Scope $ e >>= \v -> case v of     B b -> return (B b)     F ea -> ea >>= unscope . f+  {-# INLINE (>>=) #-}  instance MonadTrans (Scope b) where   lift m = Scope (return (F m))+  {-# INLINE lift #-}  instance (Monad f, Eq b, Eq1 f, Eq a) => Eq  (Scope b f a) where   (==) = (==#)+  {-# INLINE (==) #-} instance (Monad f, Eq b, Eq1 f)       => Eq1 (Scope b f)   where   a ==# b = liftM Lift2 (fromScope a) ==# liftM Lift2 (fromScope b)-  -- a ==# b = mangleScope a ==# mangleScope b+  {-# INLINE (==#) #-}  instance (Monad f, Ord b, Ord1 f, Ord a) => Ord  (Scope b f a) where   compare = compare1+  {-# INLINE compare #-} instance (Monad f, Ord b, Ord1 f)        => Ord1 (Scope b f) where   compare1 a b = liftM Lift2 (fromScope a) `compare1` liftM Lift2 (fromScope b)-  -- compare1 a b = compare1 (mangleScope a) (mangleScope b)+  {-# INLINE compare1 #-}  instance (Functor f, Show b, Show1 f, Show a) => Show (Scope b f a) where   showsPrec = showsPrec1@@ -133,6 +141,7 @@  instance Bound (Scope b) where   Scope m >>>= f = Scope (liftM (fmap (>>= f)) m)+  {-# INLINE (>>>=) #-}  ------------------------------------------------------------------------------- -- Abstraction

@@ -21,6 +21,7 @@ ---------------------------------------------------------------------------- module Bound.Var   ( Var(..)+  , unvar   ) where  import Control.Applicative@@ -37,6 +38,7 @@ import GHC.Generics # endif #endif+import Data.Profunctor import Prelude.Extras  ----------------------------------------------------------------------------@@ -66,6 +68,31 @@ #endif   ) +unvar :: (b -> r) -> (a -> r) -> Var b a -> r+unvar f _ (B b) = f b+unvar _ g (F a) = g a+{-# INLINE unvar #-}++-- |+-- This provides a @Prism@ that can be used with @lens@ library to access a bound 'Var'.+--+-- @+-- '_B' :: 'Prism' (Var b a) (Var b' a) b b'@+-- @+_B :: (Choice p, Applicative f) => p b (f b') -> p (Var b a) (f (Var b' a))+_B = dimap (unvar Right (Left . F)) (either pure (fmap B)) . right'+{-# INLINE _B #-}++-- |+-- This provides a @Prism@ that can be used with @lens@ library to access a free 'Var'.+--+-- @+-- '_F' :: 'Prism' (Var b a) (Var b a') a a'@+-- @+_F :: (Choice p, Applicative f) => p a (f a') -> p (Var b a) (f (Var b a'))+_F = dimap (unvar (Left . B) Right) (either pure (fmap F)) . right'+{-# INLINE _F #-}+ ---------------------------------------------------------------------------- -- Instances ----------------------------------------------------------------------------@@ -73,42 +100,60 @@ instance Functor (Var b) where   fmap _ (B b) = B b   fmap f (F a) = F (f a)+  {-# INLINE fmap #-}  instance Foldable (Var b) where   foldMap f (F a) = f a   foldMap _ _ = mempty+  {-# INLINE foldMap #-}  instance Traversable (Var b) where   traverse f (F a) = F <$> f a   traverse _ (B b) = pure (B b)+  {-# INLINE traverse #-}  instance Applicative (Var b) where   pure = F+  {-# INLINE pure #-}   (<*>) = ap+  {-# INLINE (<*>) #-}  instance Monad (Var b) where   return = F-  F a  >>= f = f a+  {-# INLINE return #-}+  F a >>= f = f a   B b >>= _ = B b+  {-# INLINE (>>=) #-}  instance Bifunctor Var where   bimap f _ (B b) = B (f b)   bimap _ g (F a) = F (g a)+  {-# INLINE bimap #-}  instance Bifoldable Var where   bifoldMap f _ (B b) = f b   bifoldMap _ g (F a) = g a+  {-# INLINE bifoldMap #-}  instance Bitraversable Var where   bitraverse f _ (B b) = B <$> f b   bitraverse _ g (F a) = F <$> g a+  {-# INLINE bitraverse #-} -instance Eq2 Var   where (==##)     = (==)-instance Ord2 Var  where compare2   = compare+instance Eq2 Var   where+  (==##)     = (==)+  {-# INLINE (==##) #-}+instance Ord2 Var  where+  compare2   = compare+  {-# INLINE compare2 #-} instance Show2 Var where showsPrec2 = showsPrec instance Read2 Var where readsPrec2  = readsPrec -instance Eq b   => Eq1   (Var b) where (==#)      = (==)-instance Ord b  => Ord1  (Var b) where compare1   = compare+instance Eq b   => Eq1   (Var b) where+  (==#)      = (==)+  {-# INLINE (==#) #-}+instance Ord b  => Ord1  (Var b) where+  compare1   = compare+  {-# INLINE compare1 #-} instance Show b => Show1 (Var b) where showsPrec1 = showsPrec instance Read b => Read1 (Var b) where readsPrec1  = readsPrec