packages feed

representable-tries 0.2 → 0.2.1

raw patch · 4 files changed

+142/−108 lines, 4 filesdep ~adjunctionsdep ~comonad-transformersdep ~keys

Dependency ranges changed: adjunctions, comonad-transformers, keys, representable-functors

Files

Control/Monad/Reader/Trie.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, UndecidableInstances #-}-{-# OPTIONS_GHC -fenable-rewrite-rules #-}+{-# LANGUAGE TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} ---------------------------------------------------------------------- -- |--- Module      :  Control.Monad.Representable.Trie+-- Module      :  Control.Monad.Reader.Trie -- Copyright   :  (c) Edward Kmett 2011---                (c) Conal Elliott 2008 -- License     :  BSD3 --  -- Maintainer  :  ekmett@gmail.com@@ -12,19 +10,10 @@ --  ---------------------------------------------------------------------- -module Control.Monad.Reader.Trie-  ( -  -- * Representations of polynomial functors-    HasTrie(..)-  -- * A Trie-based Reader monad transformer-  , ReaderTrieT(..)-  -- * Memoizing functions-  , mup, memo, memo2, memo3-  , inTrie, inTrie2, inTrie3-  -- * Workarounds for current GHC limitations-  , (:=)(..)-  , trie, untrie-  , coerceKey, uncoerceKey+module Control.Monad.Reader.Trie ( +  -- * A "Representable Trie"-based Reader monad transformer+    ReaderTrieT(..)+  , module Data.Functor.Representable.Trie   ) where  import Control.Applicative@@ -36,7 +25,7 @@ import Control.Monad.Writer.Class as Writer import Data.Distributive import Data.Functor.Bind-import Data.Functor.Identity+import Data.Functor.Representable.Trie import Data.Foldable import Data.Key import Data.Monoid@@ -45,88 +34,6 @@ import Data.Semigroup.Traversable import Prelude hiding (lookup) -data a := b where Refl :: a := a---- class (TraversableWithKey1 (Trie a), Representable (Trie a), Key (Trie a) ~ a) => HasTrie a where-class (TraversableWithKey1 (Trie a), Representable (Trie a)) => HasTrie a where-  type Trie a :: * -> *-  -- | Ideally we would have the constraint @Key (Trie a) ~ a@ as a class constraint. -  -- We are forced to approximate this using an explicit equality witness until GHC implements this feature.-  keyRefl :: a := Key (Trie a)--coerceKey :: HasTrie a => a -> Key (Trie a)-coerceKey = go keyRefl where-  go :: HasTrie a => (a := Key (Trie a)) -> a -> Key (Trie a)-  go Refl = id--uncoerceKey :: HasTrie a => Key (Trie a) -> a-uncoerceKey = go keyRefl where-  go :: HasTrie a => (a := Key (Trie a)) -> Key (Trie a) -> a-  go Refl = id--instance HasTrie () where-  type Trie () = Identity-  keyRefl = Refl---- 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 :: HasTrie t => Trie t a -> t -> a-untrie = go keyRefl where-  go :: HasTrie t => (t := Key (Trie t)) -> Trie t a -> t -> a-  go Refl = index--trie :: HasTrie t => (t -> a) -> Trie t a-trie = go keyRefl where-  go :: HasTrie t => (t := Key (Trie t)) -> (t -> a) -> Trie t a-  go Refl = tabulate--memo :: HasTrie t => (t -> a) -> t -> a-memo = untrie . trie---- | Lift a memoizer to work with one more argument.-mup :: HasTrie t => (b -> c) -> (t -> b) -> t -> c-mup mem f = memo (mem . f)---- | Memoize a binary function, on its first argument and then on its--- second.  Take care to exploit any partial evaluation.-memo2 :: (HasTrie s, HasTrie t) => (s -> t -> a) -> s -> t -> a-memo2 = mup memo---- | Memoize a ternary function on successive arguments.  Take care to--- exploit any partial evaluation.-memo3 :: (HasTrie r, HasTrie s, HasTrie t) => (r -> s -> t -> a) -> r -> s -> t -> a-memo3 = mup memo2---- | Apply a unary function inside of a tabulate-inTrie -  :: (HasTrie a, HasTrie c) -  => ((a -> b) -> c -> d)-  -> Trie a b -> Trie c d-inTrie = untrie ~> trie---- | Apply a binary function inside of a tabulate-inTrie2 -  :: (HasTrie a, HasTrie c, HasTrie e) -  => ((a -> b) -> (c -> d) -> e -> f)-  -> Trie a b -> Trie c d -> Trie e f-inTrie2 = untrie ~> inTrie---- | Apply a ternary function inside of a tabulate-inTrie3 -  :: (HasTrie a, HasTrie c, HasTrie e, HasTrie g) -  => ((a -> b) -> (c -> d) -> (e -> f) -> g -> h)-  -> Trie a b -> Trie c d -> Trie e f -> Trie g h-inTrie3 = untrie ~> inTrie2--instance (HasTrie a, HasTrie b) => HasTrie (a,b) where-  type Trie (a,b) = RepT (Trie a) (Trie b)-  keyRefl = go keyRefl keyRefl where-    go :: (a := Key (Trie a)) -> (b := Key (Trie b)) -> (a, b) := Key (Trie (a,b))-    go Refl Refl = Refl- type instance Key (ReaderTrieT a m) = (a, Key m)  newtype ReaderTrieT a m b = ReaderTrieT { runReaderTrieT :: Trie a (m b) } @@ -161,7 +68,7 @@ instance (HasTrie a, Keyed m) => Keyed (ReaderTrieT a m) where   mapWithKey f = ReaderTrieT . mapWithKey (\k -> mapWithKey (f . (,) (uncoerceKey k))) . runReaderTrieT -instance (HasTrie a, Index m) => Index (ReaderTrieT a m) where+instance (HasTrie a, Indexable m) => Indexable (ReaderTrieT a m) where   index = uncurry . fmap index . untrie . runReaderTrieT  instance (HasTrie a, Lookup (Trie a), Lookup m) => Lookup (ReaderTrieT a m) where@@ -208,3 +115,4 @@   tell = lift . tell   listen = ReaderTrieT . tabulate . fmap Writer.listen . index . runReaderTrieT   pass = ReaderTrieT . tabulate . fmap Writer.pass . index . runReaderTrieT+
+ Data/Functor/Representable/Trie.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, MultiParamTypeClasses, UndecidableInstances #-}+{-# OPTIONS_GHC -fenable-rewrite-rules #-}+----------------------------------------------------------------------+-- |+-- 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+  , mup, memo, memo2, memo3+  , inTrie, inTrie2, inTrie3+  -- * Workarounds for current GHC limitations+  , (:=)(..)+  , trie, untrie+  , coerceKey, uncoerceKey+  ) where++import Control.Monad.Representable+import Data.Functor.Identity+import Data.Functor.Product+import Data.Key+import Prelude hiding (lookup)++data a := b where Refl :: a := a++-- class (TraversableWithKey1 (Trie a), Representable (Trie a), Key (Trie a) ~ a) => HasTrie a where+class (TraversableWithKey1 (Trie a), Representable (Trie a)) => HasTrie a where+  type Trie a :: * -> *+  -- | Ideally we would have the constraint @Key (Trie a) ~ a@ as a class constraint. +  -- We are forced to approximate this using an explicit equality witness until GHC implements this feature.+  keyRefl :: a := Key (Trie a)++coerceKey :: HasTrie a => a -> Key (Trie a)+coerceKey = go keyRefl where+  go :: HasTrie a => (a := Key (Trie a)) -> a -> Key (Trie a)+  go Refl = id++uncoerceKey :: HasTrie a => Key (Trie a) -> a+uncoerceKey = go keyRefl where+  go :: HasTrie a => (a := Key (Trie a)) -> Key (Trie a) -> a+  go Refl = id++-- 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 :: HasTrie t => Trie t a -> t -> a+untrie = go keyRefl where+  go :: HasTrie t => (t := Key (Trie t)) -> Trie t a -> t -> a+  go Refl = index++trie :: HasTrie t => (t -> a) -> Trie t a+trie = go keyRefl where+  go :: HasTrie t => (t := Key (Trie t)) -> (t -> a) -> Trie t a+  go Refl = tabulate++{-# RULES+"trie/untrie" forall t. trie (untrie t) = t+ #-}++memo :: HasTrie t => (t -> a) -> t -> a+memo = untrie . trie++-- | Lift a memoizer to work with one more argument.+mup :: HasTrie t => (b -> c) -> (t -> b) -> t -> c+mup mem f = memo (mem . f)++-- | Memoize a binary function, on its first argument and then on its+-- second.  Take care to exploit any partial evaluation.+memo2 :: (HasTrie s, HasTrie t) => (s -> t -> a) -> s -> t -> a+memo2 = mup memo++-- | Memoize a ternary function on successive arguments.  Take care to+-- exploit any partial evaluation.+memo3 :: (HasTrie r, HasTrie s, HasTrie t) => (r -> s -> t -> a) -> r -> s -> t -> a+memo3 = mup memo2++-- | Apply a unary function inside of a tabulate+inTrie +  :: (HasTrie a, HasTrie c) +  => ((a -> b) -> c -> d)+  -> Trie a b -> Trie c d+inTrie = untrie ~> trie++-- | Apply a binary function inside of a tabulate+inTrie2 +  :: (HasTrie a, HasTrie c, HasTrie e) +  => ((a -> b) -> (c -> d) -> e -> f)+  -> Trie a b -> Trie c d -> Trie e f+inTrie2 = untrie ~> inTrie++-- | Apply a ternary function inside of a tabulate+inTrie3 +  :: (HasTrie a, HasTrie c, HasTrie e, HasTrie g) +  => ((a -> b) -> (c -> d) -> (e -> f) -> g -> h)+  -> Trie a b -> Trie c d -> Trie e f -> Trie g h+inTrie3 = untrie ~> inTrie2++-- * Instances++instance HasTrie () where+  type Trie () = Identity+  keyRefl = Refl++instance (HasTrie a, HasTrie b) => HasTrie (a, b) where+  type Trie (a, b) = RepT (Trie a) (Trie b)+  keyRefl = go keyRefl keyRefl where+    go :: (a := Key (Trie a)) -> (b := Key (Trie b)) -> (a, b) := Key (Trie (a,b))+    go Refl Refl = Refl++instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where+  type Trie (Either a b) = Product (Trie a) (Trie b)+  keyRefl = go keyRefl keyRefl where+    go :: (a := Key (Trie a)) -> (b := Key (Trie b)) -> Either a b := Key (Trie (Either a b))+    go Refl Refl = Refl
Data/Semigroupoid/Trie.hs view
@@ -50,7 +50,7 @@ runT :: (a :->: b) -> Trie a b runT (T f) = f -instance Index ((:->:)e) where+instance Indexable ((:->:)e) where   index (T f) = untrie f  instance HasTrie e => Distributive ((:->:)e) where@@ -100,7 +100,7 @@   compare = compare `on` toList  instance (Show a, Show b) => Show (a :->: b) where -  showsPrec d t = showsPrec d (toIndexedList t)+  showsPrec d t = showsPrec d (toKeyedList t)  instance Apply ((:->:) a) where   T f <.> T g = T (f <.> g)
representable-tries.cabal view
@@ -1,6 +1,6 @@ name:          representable-tries category:      Data Structures, Functors, Monads, Comonads-version:       0.2+version:       0.2.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -19,23 +19,24 @@  library   build-depends: -    adjunctions >= 0.8 && < 0.9,+    adjunctions >= 0.9 && < 0.10,     array >= 0.3.0.2 && < 0.4,     base >= 4 && < 4.4,     comonad >= 1.0 && < 1.1,-    comonad-transformers >= 1.5.0.3 && < 1.6,+    comonad-transformers >= 1.5.2 && < 1.6,     containers >= 0.4 && < 0.5,     contravariant >= 0.1.2 && < 0.2,     distributive >= 0.1.1 && < 0.2,-    keys >= 0.1.0.1 && < 0.2,+    keys >= 0.2.1 && < 0.3,     mtl >= 2.0.1.0 && < 2.1,-    representable-functors >= 0.2 && < 0.3,+    representable-functors >= 0.3 && < 0.4,     semigroups >= 0.3.4 && < 0.4,     semigroupoids >= 1.1.1 && < 1.2.0,     transformers >= 0.2.0 && < 0.3    exposed-modules:     Control.Monad.Reader.Trie+    Data.Functor.Representable.Trie     Data.Semigroupoid.Trie    ghc-options: -Wall