From 8d477cb7e3696ac5e8362b2628baed34652bfecc Mon Sep 17 00:00:00 2001 From: Edward Kmett Date: Thu, 5 Jul 2012 07:31:03 -0400 Subject: [PATCH] 3.0 refactoring --- representable-tries.cabal | 20 +++--- {Control => src/Control}/Monad/Reader/Trie.hs | 33 +++++----- .../Data}/Functor/Representable/Trie.hs | 63 ++++++++++--------- .../Data}/Functor/Representable/Trie/Bool.hs | 0 .../Functor/Representable/Trie/Either.hs | 0 .../Data}/Functor/Representable/Trie/List.hs | 0 .../Functor/Representable/Trie/Vector.hs | 0 {Data => src/Data}/Traversable/Fair.hs | 0 {Data => src/Data}/Vector/Zeroless.hs | 0 {Numeric => src/Numeric}/Nat/Zeroless.hs | 0 10 files changed, 61 insertions(+), 55 deletions(-) rename {Control => src/Control}/Monad/Reader/Trie.hs (92%) rename {Data => src/Data}/Functor/Representable/Trie.hs (92%) rename {Data => src/Data}/Functor/Representable/Trie/Bool.hs (100%) rename {Data => src/Data}/Functor/Representable/Trie/Either.hs (100%) rename {Data => src/Data}/Functor/Representable/Trie/List.hs (100%) rename {Data => src/Data}/Functor/Representable/Trie/Vector.hs (100%) rename {Data => src/Data}/Traversable/Fair.hs (100%) rename {Data => src/Data}/Vector/Zeroless.hs (100%) rename {Numeric => src/Numeric}/Nat/Zeroless.hs (100%) diff --git a/representable-tries.cabal b/representable-tries.cabal index f01e262..8c57562 100644 --- a/representable-tries.cabal +++ b/representable-tries.cabal @@ -1,6 +1,6 @@ name: representable-tries category: Data Structures, Functors, Monads, Comonads -version: 2.5 +version: 3.0 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE @@ -20,6 +20,8 @@ source-repository head location: git://github.com/ekmett/representable-tries.git library + hs-source-dirs: src + other-extensions: CPP EmptyDataDecls @@ -34,19 +36,19 @@ library UndecidableInstances build-depends: + adjunctions == 3.0.*, base >= 4 && < 5, + bifunctors == 3.0.*, + comonad == 3.0.*, + comonad-transformers == 3.0.*, containers >= 0.3 && < 0.6, + distributive >= 0.2.2 && < 0.3, + keys == 3.0.*, mtl >= 2.0.1 && < 2.2, transformers >= 0.2 && < 0.4, - bifunctors >= 0.1.3.1 && < 0.2, - comonad >= 1.1.1.5 && < 1.2, - distributive >= 0.2.2 && < 0.3, + representable-functors == 3.0.*, semigroups >= 0.8.3.1 && < 0.9, - semigroupoids >= 1.3.1.2 && < 1.4, - keys >= 2.2 && < 2.3, - comonad-transformers >= 2.1.1.1 && < 2.2, - adjunctions >= 2.5 && < 2.6, - representable-functors >= 2.5 && < 2.6 + semigroupoids == 3.0.* exposed-modules: Control.Monad.Reader.Trie diff --git a/Control/Monad/Reader/Trie.hs b/src/Control/Monad/Reader/Trie.hs similarity index 92% rename from Control/Monad/Reader/Trie.hs rename to src/Control/Monad/Reader/Trie.hs index 45cda52..b58fb78 100644 --- a/Control/Monad/Reader/Trie.hs +++ b/src/Control/Monad/Reader/Trie.hs @@ -4,13 +4,13 @@ -- Module : Control.Monad.Reader.Trie -- Copyright : (c) Edward Kmett 2011 -- License : BSD3 --- +-- -- Maintainer : ekmett@gmail.com -- Stability : experimental --- +-- ---------------------------------------------------------------------- -module Control.Monad.Reader.Trie ( +module Control.Monad.Reader.Trie ( -- * A "Representable Trie"-based Reader monad transformer ReaderTrieT(..) , module Data.Functor.Representable.Trie @@ -24,6 +24,7 @@ import Control.Monad.Reader.Class import Control.Monad.Writer.Class as Writer import Data.Distributive import Data.Functor.Bind +import Data.Functor.Extend import Data.Functor.Representable import Data.Functor.Representable.Trie import Data.Foldable @@ -36,7 +37,7 @@ import Prelude hiding (lookup,zipWith) type instance Key (ReaderTrieT a m) = (a, Key m) -newtype ReaderTrieT a m b = ReaderTrieT { runReaderTrieT :: a :->: m b } +newtype ReaderTrieT a m b = ReaderTrieT { runReaderTrieT :: a :->: m b } instance (HasTrie a, Functor m) => Functor (ReaderTrieT a m) where fmap f = ReaderTrieT . fmap (fmap f) . runReaderTrieT @@ -45,7 +46,7 @@ instance (HasTrie a, Apply m) => Apply (ReaderTrieT a m) where ReaderTrieT ff <.> ReaderTrieT fa = ReaderTrieT ((<.>) <$> ff <.> fa) instance (HasTrie a, Applicative m) => Applicative (ReaderTrieT a m) where - pure = ReaderTrieT . pure . pure + pure = ReaderTrieT . pure . pure ReaderTrieT ff <*> ReaderTrieT fa = ReaderTrieT ((<*>) <$> ff <*> fa) instance (HasTrie a, Bind m) => Bind (ReaderTrieT a m) where @@ -55,21 +56,21 @@ instance (HasTrie a, Monad m) => Monad (ReaderTrieT a m) where return = ReaderTrieT . pure . return ReaderTrieT fm >>= f = ReaderTrieT $ tabulate (\a -> index fm a >>= flip index a . runReaderTrieT . f) -instance (HasTrie a, Monad m) => MonadReader a (ReaderTrieT a m) where +instance (HasTrie a, Monad m) => MonadReader a (ReaderTrieT a m) where ask = ReaderTrieT (trie return) local f (ReaderTrieT fm) = ReaderTrieT (tabulate (index fm . f)) instance HasTrie a => MonadTrans (ReaderTrieT a) where - lift = ReaderTrieT . pure + lift = ReaderTrieT . pure 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 + 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 + 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 @@ -78,14 +79,14 @@ instance (HasTrie a, Indexable m) => Indexable (ReaderTrieT a m) where index = uncurry . fmap index . untrie . runReaderTrieT instance (HasTrie a, Adjustable m) => Adjustable (ReaderTrieT a m) where - adjust f (a,k) = ReaderTrieT . adjust (adjust f k) a . runReaderTrieT + adjust f (a,k) = ReaderTrieT . adjust (adjust f k) a . runReaderTrieT instance (HasTrie a, Lookup ((:->:) a), Lookup m) => Lookup (ReaderTrieT a m) where lookup (k,k') (ReaderTrieT fm) = lookup k fm >>= lookup k' instance (HasTrie a, Representable m) => Representable (ReaderTrieT a m) where tabulate = ReaderTrieT . trie . fmap tabulate . curry - + instance (HasTrie a, Foldable m) => Foldable (ReaderTrieT a m) where foldMap f = foldMap (foldMap f) . runReaderTrieT @@ -96,7 +97,7 @@ instance (HasTrie a, FoldableWithKey m) => FoldableWithKey (ReaderTrieT a m) whe foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) k)) . runReaderTrieT instance (HasTrie a, FoldableWithKey1 m) => FoldableWithKey1 (ReaderTrieT a m) where - foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . runReaderTrieT + foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . runReaderTrieT instance (HasTrie a, Traversable m) => Traversable (ReaderTrieT a m) where traverse f = fmap ReaderTrieT . traverse (traverse f) . runReaderTrieT @@ -111,14 +112,16 @@ instance (HasTrie a, TraversableWithKey1 m) => TraversableWithKey1 (ReaderTrieT traverseWithKey1 f = fmap ReaderTrieT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . runReaderTrieT instance (HasTrie a, Representable m, Semigroup a, Semigroup (Key m)) => Extend (ReaderTrieT a m) where + extended = extendedRep + duplicated = duplicatedRep + +instance (HasTrie a, Representable m, Monoid a, Monoid (Key m)) => Comonad (ReaderTrieT a m) where extend = extendRep duplicate = duplicateRep - -instance (HasTrie a, Representable m, Semigroup a, Semigroup (Key m), Monoid a, Monoid (Key m)) => Comonad (ReaderTrieT a m) where extract = extractRep instance (HasTrie a, MonadIO m) => MonadIO (ReaderTrieT a m) where - liftIO = lift . liftIO + liftIO = lift . liftIO instance (HasTrie a, MonadWriter w m) => MonadWriter w (ReaderTrieT a m) where tell = lift . tell diff --git a/Data/Functor/Representable/Trie.hs b/src/Data/Functor/Representable/Trie.hs similarity index 92% rename from Data/Functor/Representable/Trie.hs rename to src/Data/Functor/Representable/Trie.hs index af9085f..9be1a7e 100644 --- a/Data/Functor/Representable/Trie.hs +++ b/src/Data/Functor/Representable/Trie.hs @@ -5,14 +5,14 @@ -- Module : Data.Functor.Representable.Trie -- Copyright : (c) Edward Kmett 2011 -- License : BSD3 --- +-- -- Maintainer : ekmett@gmail.com -- Stability : experimental --- +-- ---------------------------------------------------------------------- module Data.Functor.Representable.Trie - ( + ( -- * Representations of polynomial functors HasTrie(..) -- * Memoizing functions @@ -38,6 +38,7 @@ import Data.Foldable import Data.Function (on) import Data.Functor.Adjunction import Data.Functor.Bind +import Data.Functor.Extend import Data.Functor.Identity import Data.Functor.Representable.Trie.Bool import Data.Functor.Representable.Trie.Either @@ -65,7 +66,7 @@ class (Adjustable (BaseTrie a), TraversableWithKey1 (BaseTrie a), Representable validKey _ = True -} -newtype a :->: b = Trie { runTrie :: BaseTrie a b } +newtype a :->: b = Trie { runTrie :: BaseTrie a b } type instance Key ((:->:) a) = a @@ -107,22 +108,22 @@ memo3 :: (HasTrie r, HasTrie s, HasTrie t) => (r -> s -> t -> a) -> r -> s -> t memo3 = mup memo2 -- | Apply a unary function inside of a tabulate -inTrie - :: (HasTrie a, HasTrie c) +inTrie + :: (HasTrie a, HasTrie c) => ((a -> b) -> c -> d) -> (a :->: b) -> c :->: d inTrie = untrie ~> trie -- | Apply a binary function inside of a tabulate -inTrie2 - :: (HasTrie a, HasTrie c, HasTrie e) +inTrie2 + :: (HasTrie a, HasTrie c, HasTrie e) => ((a -> b) -> (c -> d) -> e -> f) -> (a :->: b) -> (c :->: d) -> e :->: f inTrie2 = untrie ~> inTrie -- | Apply a ternary function inside of a tabulate -inTrie3 - :: (HasTrie a, HasTrie c, HasTrie e, HasTrie g) +inTrie3 + :: (HasTrie a, HasTrie c, HasTrie e, HasTrie g) => ((a -> b) -> (c -> d) -> (e -> f) -> g -> h) -> (a :->: b) -> (c :->: d) -> (e :->: f) -> g :->: h inTrie3 = untrie ~> inTrie2 @@ -149,7 +150,7 @@ instance HasTrie e => Adjustable ((:->:) e) where instance HasTrie e => Zip ((:->:) e) -instance HasTrie e => ZipWithKey ((:->:) e) +instance HasTrie e => ZipWithKey ((:->:) e) instance HasTrie e => Adjunction (Entry e) ((:->:) e) where unit = mapWithKey Entry . pure @@ -191,7 +192,7 @@ instance (HasTrie a, Eq b) => Eq (a :->: b) where instance (HasTrie a, Ord b) => Ord (a :->: b) where compare = compare `on` toList -instance (HasTrie a, 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 HasTrie a => Apply ((:->:) a) where @@ -207,7 +208,7 @@ instance HasTrie a => Applicative ((:->:) 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 return a = Trie (pureRep a) (>>=) = (>>-) @@ -217,14 +218,14 @@ instance HasTrie a => MonadReader a ((:->:) a) where ask = askRep local = localRep --- TODO: remove dependency on HasTrie in these: +-- TODO: remove dependency on HasTrie in these: -instance (HasTrie m, Semigroup m, Monoid m) => Comonad ((:->:) m) where +instance (HasTrie m, Monoid m) => Comonad ((:->:) m) where + duplicate = duplicateRep extract = flip index mempty - instance (HasTrie m, Semigroup m) => Extend ((:->:) m) where - duplicate = duplicateRep + duplicated = duplicatedRep -- * Instances @@ -246,17 +247,17 @@ instance HasTrie Any where instance HasTrie a => HasTrie (Dual a) where type BaseTrie (Dual a) = BaseTrie a embedKey = embedKey . getDual - projectKey = Dual . projectKey + projectKey = Dual . projectKey instance HasTrie a => HasTrie (Sum a) where type BaseTrie (Sum a) = BaseTrie a embedKey = embedKey . getSum - projectKey = Sum . projectKey + projectKey = Sum . projectKey instance HasTrie a => HasTrie (Monoid.Product a) where type BaseTrie (Monoid.Product a) = BaseTrie a embedKey = embedKey . Monoid.getProduct - projectKey = Monoid.Product . projectKey + projectKey = Monoid.Product . projectKey instance (HasTrie a, HasTrie b) => HasTrie (a, b) where type BaseTrie (a, b) = ReaderT (BaseTrie a) (BaseTrie b) @@ -298,7 +299,7 @@ instance (HasTrie v) => HasTrie (IntMap v) where embedKey = foldrWithKey (\k v t -> embedKey (k,v) : t) [] projectKey = IntMap.fromDistinctAscList . map projectKey - + -- | Extract bits in little-endian order bits :: Bits t => t -> [Bool] bits 0 = [] @@ -326,48 +327,48 @@ bitsZ = (>= 0) &&& (bits . abs) -- TODO: fix the show instance of this instance HasTrie Int where type BaseTrie Int = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Int8 where type BaseTrie Int8 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Int16 where type BaseTrie Int16 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Int32 where type BaseTrie Int32 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Int64 where type BaseTrie Int64 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Word where type BaseTrie Word = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Word8 where type BaseTrie Word8 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Word16 where type BaseTrie Word16 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Word32 where type BaseTrie Word32 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey instance HasTrie Word64 where type BaseTrie Word64 = BaseTrie (Bool, [Bool]) - embedKey = embedKey . bitsZ + embedKey = embedKey . bitsZ projectKey = unbitsZ . projectKey -- TODO: fix tree to 21 bit depth diff --git a/Data/Functor/Representable/Trie/Bool.hs b/src/Data/Functor/Representable/Trie/Bool.hs similarity index 100% rename from Data/Functor/Representable/Trie/Bool.hs rename to src/Data/Functor/Representable/Trie/Bool.hs diff --git a/Data/Functor/Representable/Trie/Either.hs b/src/Data/Functor/Representable/Trie/Either.hs similarity index 100% rename from Data/Functor/Representable/Trie/Either.hs rename to src/Data/Functor/Representable/Trie/Either.hs diff --git a/Data/Functor/Representable/Trie/List.hs b/src/Data/Functor/Representable/Trie/List.hs similarity index 100% rename from Data/Functor/Representable/Trie/List.hs rename to src/Data/Functor/Representable/Trie/List.hs diff --git a/Data/Functor/Representable/Trie/Vector.hs b/src/Data/Functor/Representable/Trie/Vector.hs similarity index 100% rename from Data/Functor/Representable/Trie/Vector.hs rename to src/Data/Functor/Representable/Trie/Vector.hs diff --git a/Data/Traversable/Fair.hs b/src/Data/Traversable/Fair.hs similarity index 100% rename from Data/Traversable/Fair.hs rename to src/Data/Traversable/Fair.hs diff --git a/Data/Vector/Zeroless.hs b/src/Data/Vector/Zeroless.hs similarity index 100% rename from Data/Vector/Zeroless.hs rename to src/Data/Vector/Zeroless.hs diff --git a/Numeric/Nat/Zeroless.hs b/src/Numeric/Nat/Zeroless.hs similarity index 100% rename from Numeric/Nat/Zeroless.hs rename to src/Numeric/Nat/Zeroless.hs