added ZipWith constraints. simplified (:->:) to remove attached context

Control/Monad/Reader/Trie.hs

@@ -32,7 +32,7 @@ import Data.Monoid
 import Data.Traversable
 import Data.Semigroup.Foldable
 import Data.Semigroup.Traversable
-import Prelude hiding (lookup)
+import Prelude hiding (lookup,zipWith)
 
 type instance Key (ReaderTrieT a m) = (a, Key m)
 
@@ -65,6 +65,12 @@ instance HasTrie a => MonadTrans (ReaderTrieT a) where
 instance (HasTrie a, Distributive m) => Distributive (ReaderTrieT a m) where
   distribute = ReaderTrieT . fmap distribute . collect runReaderTrieT
 
+instance (HasTrie a, Zip m) => Zip (ReaderTrieT a m) where
+  zipWith f (ReaderTrieT m) (ReaderTrieT n) = ReaderTrieT $ zipWith (zipWith f) m n 
+
+instance (HasTrie a, ZipWithKey m) => ZipWithKey (ReaderTrieT a m) where
+  zipWithKey f (ReaderTrieT m) (ReaderTrieT n) = ReaderTrieT $ zipWithKey (\k -> zipWithKey (f . (,) k)) m n 
+
 instance (HasTrie a, Keyed m) => Keyed (ReaderTrieT a m) where
   mapWithKey f = ReaderTrieT . mapWithKey (\k -> mapWithKey (f . (,) k)) . runReaderTrieT
 

Data/Functor/Representable/Trie.hs

@@ -22,7 +22,6 @@ module Data.Functor.Representable.Trie
   , trie, untrie
   , (:->:)(..)
   , Entry(..)
-  , runTrie
   ) where
 
 import Control.Applicative
@@ -47,7 +46,6 @@ import Data.Key
 import Data.Monoid as Monoid
 import Data.Semigroup.Foldable
 import Data.Semigroup.Traversable
-import Data.Semigroupoid
 import Data.Sequence (Seq, (<|))
 import qualified Data.Sequence as Seq
 import Data.Map (Map)
@@ -67,24 +65,20 @@ class (Adjustable (BaseTrie a), TraversableWithKey1 (BaseTrie a), Representable
   validKey _ = True
 -}
 
-data a :->: b where
-  Trie :: HasTrie a => BaseTrie a b -> a :->: b
+newtype a :->: b = Trie { runTrie :: BaseTrie a b } 
 
 type instance Key ((:->:) a) = a
 
 data Entry a b = Entry a b
 
 -- * Combinators
 
-runTrie :: (a :->: b) -> BaseTrie a b
-runTrie (Trie f) = f
-
 -- Matt Hellige's notation for @argument f . result g@.
 -- <http://matt.immute.net/content/pointless-fun>
 (~>) :: (a' -> a) -> (b -> b') -> (a -> b) -> a' -> b'
 g ~> f = (f .) . (. g)
 
-untrie :: (t :->: a) -> t -> a
+untrie :: HasTrie t => (t :->: a) -> t -> a
 untrie = index
 
 trie :: HasTrie t => (t -> a) -> (t :->: a)
@@ -138,10 +132,10 @@ inTrie3 = untrie ~> inTrie2
 instance Functor (Entry a) where
   fmap f (Entry a b) = Entry a (f b)
 
-instance Lookup ((:->:)e) where
+instance HasTrie e => Lookup ((:->:)e) where
   lookup = lookupDefault
 
-instance Indexable ((:->:)e) where
+instance HasTrie e => Indexable ((:->:)e) where
   index (Trie f) = index f . embedKey
 
 instance HasTrie e => Distributive ((:->:) e) where
@@ -153,66 +147,65 @@ instance HasTrie e => Representable ((:->:) e) where
 instance HasTrie e => Adjustable ((:->:) e) where
   adjust f k (Trie as) = Trie (adjust f (embedKey k) as)
 
+instance HasTrie e => Zip ((:->:) e)
+
+instance HasTrie e => ZipWithKey ((:->:) e) 
+
 instance HasTrie e => Adjunction (Entry e) ((:->:) e) where
   unit = mapWithKey Entry . pure
   counit (Entry a t) = index t a
 
-instance Functor ((:->:) a) where
+instance HasTrie a => Functor ((:->:) a) where
   fmap f (Trie g) = Trie (fmap f g)
 
-instance Keyed ((:->:) a) where
+instance HasTrie a => Keyed ((:->:) a) where
   mapWithKey f (Trie a) = Trie (mapWithKey (f . projectKey) a)
 
-instance Foldable ((:->:) a) where
+instance HasTrie a => Foldable ((:->:) a) where
   foldMap f (Trie a) = foldMap f a
 
-instance FoldableWithKey ((:->:) a) where
+instance HasTrie a => FoldableWithKey ((:->:) a) where
   foldMapWithKey f (Trie a) = foldMapWithKey (f . projectKey) a
 
-instance Traversable ((:->:) a) where
+instance HasTrie a => Traversable ((:->:) a) where
   traverse f (Trie a) = Trie <$> traverse f a
 
-instance TraversableWithKey ((:->:) a) where
+instance HasTrie a => TraversableWithKey ((:->:) a) where
   traverseWithKey f (Trie a) = Trie <$> traverseWithKey (f . projectKey) a
 
-instance Foldable1 ((:->:) a) where
+instance HasTrie a => Foldable1 ((:->:) a) where
   foldMap1 f (Trie a) = foldMap1 f a
 
-instance FoldableWithKey1 ((:->:) a) where
+instance HasTrie a => FoldableWithKey1 ((:->:) a) where
   foldMapWithKey1 f (Trie a) = foldMapWithKey1 (f . projectKey) a
 
-instance Traversable1 ((:->:) a) where
+instance HasTrie a => Traversable1 ((:->:) a) where
   traverse1 f (Trie a) = Trie <$> traverse1 f a
 
-instance TraversableWithKey1 ((:->:) a) where
+instance HasTrie a => TraversableWithKey1 ((:->:) a) where
   traverseWithKey1 f (Trie a) = Trie <$> traverseWithKey1 (f . projectKey) a
 
-instance Eq b => Eq (a :->: b) where
+instance (HasTrie a, Eq b) => Eq (a :->: b) where
   (==) = (==) `on` toList
 
-instance Ord b => Ord (a :->: b) where
+instance (HasTrie a, Ord b) => Ord (a :->: b) where
   compare = compare `on` toList
 
-instance (Show a, Show b) => Show (a :->: b) where 
+instance (HasTrie a, Show a, Show b) => Show (a :->: b) where 
   showsPrec d = showsPrec d . toKeyedList
 
-instance Apply ((:->:) a) where
+instance HasTrie a => Apply ((:->:) a) where
   Trie f <.> Trie g = Trie (f <.> g)
   a <. _ = a
   _ .> b = b
 
-instance Semigroupoid (:->:) where
-  o (Trie f) = fmap (index f . embedKey)
-
--- instance HasTrie a => Ob (:->:) a where semiid = Trie return
-
 instance HasTrie a => Applicative ((:->:) a) where
   pure a = Trie (pure a)
   Trie f <*> Trie g = Trie (f <*> g)
   a <* _ = a
   _ *> b = b
 
-instance Bind ((:->:) a) where
+instance HasTrie a => Bind ((:->:) a) where
   Trie m >>- f = Trie (tabulate (\a -> index (runTrie (f (index m a))) a))
 
 instance HasTrie a => Monad ((:->:) a) where
@@ -229,6 +222,7 @@ instance HasTrie a => MonadReader a ((:->:) a) where
 instance (HasTrie m, Semigroup m, Monoid m) => Comonad ((:->:) m) where
   extract = flip index mempty
 
+
 instance (HasTrie m, Semigroup m) => Extend ((:->:) m) where
   duplicate = duplicateRep
 

Data/Functor/Representable/Trie/Bool.hs

@@ -62,6 +62,12 @@ instance Monad BoolTrie where
 instance Keyed BoolTrie where
   mapWithKey f (BoolTrie a b) = BoolTrie (f False a) (f True b)
 
+instance Zip BoolTrie where
+  zipWith f (BoolTrie a b) (BoolTrie c d) = BoolTrie (f a c) (f b d)
+
+instance ZipWithKey BoolTrie where
+  zipWithKey f (BoolTrie a b) (BoolTrie c d) = BoolTrie (f False a c) (f True b d)
+
 instance Foldable BoolTrie where
   foldMap f (BoolTrie a b) = f a `mappend` f b
 

Data/Functor/Representable/Trie/Either.hs

@@ -28,7 +28,7 @@ import Data.Semigroup
 import Data.Semigroup.Foldable
 import Data.Semigroup.Traversable
 import Data.Key
-import Prelude hiding (lookup)
+import Prelude hiding (lookup,zipWith)
 
 -- the product functor would be the trie of an either, but we fair traversal
 data EitherTrie f g a = EitherTrie (f a) (g a)
@@ -75,6 +75,12 @@ instance (Representable f, Representable g) => Monad (EitherTrie f g) where
 instance (Keyed f, Keyed g) => Keyed (EitherTrie f g) where
   mapWithKey f (EitherTrie fs gs) = EitherTrie (mapWithKey (f . Left) fs) (mapWithKey (f . Right) gs)
 
+instance (Zip f, Zip g) => Zip (EitherTrie f g) where
+  zipWith f (EitherTrie fs gs) (EitherTrie hs is) = EitherTrie (zipWith f fs hs) (zipWith f gs is)
+
+instance (ZipWithKey f, ZipWithKey g) => ZipWithKey (EitherTrie f g) where
+  zipWithKey f (EitherTrie fs gs) (EitherTrie hs is) = EitherTrie (zipWithKey (f . Left) fs hs) (zipWithKey (f . Right) gs is)
+
 instance (Foldable f, Foldable g) => Foldable (EitherTrie f g) where
   foldMap f (EitherTrie fs gs) = foldMapBoth f fs gs
 

Data/Functor/Representable/Trie/List.hs

@@ -27,7 +27,7 @@ import Data.Semigroup
 import Data.Semigroup.Foldable
 import Data.Semigroup.Traversable
 import Data.Key
-import Prelude hiding (lookup)
+import Prelude hiding (lookup,zipWith)
 
 -- the f-branching stream comonad is the trie of a list 
 data ListTrie f a = ListTrie a (f (ListTrie f a)) -- deriving (Eq,Ord,Show,Read)
@@ -63,6 +63,12 @@ instance Representable f => Monad (ListTrie f) where
   (>>=) = bindRep
   _ >> a = a
 
+instance Zip f => Zip (ListTrie f) where
+  zipWith f (ListTrie a as) (ListTrie b bs) = ListTrie (f a b) (zipWith (zipWith f) as bs)
+
+instance ZipWithKey f => ZipWithKey (ListTrie f) where
+  zipWithKey f (ListTrie a as) (ListTrie b bs) = ListTrie (f [] a b) (zipWithKey (\x -> zipWithKey (f . (x:))) as bs)
+
 instance Keyed f => Keyed (ListTrie f) where
   mapWithKey f (ListTrie a as) = ListTrie (f [] a) (mapWithKey (\x -> mapWithKey (f . (x:))) as)
 

representable-tries.cabal

@@ -1,6 +1,6 @@
 name:          representable-tries
 category:      Data Structures, Functors, Monads, Comonads
-version:       1.8.1
+version:       2.0
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -28,10 +28,10 @@ library
     semigroups >= 0.5 && < 0.6,
     semigroupoids >= 1.2.2 && < 1.3.0,
     transformers >= 0.2.0 && < 0.3,
-    adjunctions            >= 1.8 && < 1.9,
     keys                   >= 1.8 && < 1.9,
     comonad-transformers   >= 1.8 && < 1.9,
-    representable-functors >= 1.8 && < 1.9
+    adjunctions            >= 2.0 && < 2.1,
+    representable-functors >= 2.0 && < 2.1
 
   exposed-modules:
     Control.Monad.Reader.Trie