packages feed

representable-tries 0.2.2 → 0.2.3

raw patch · 4 files changed

+228/−1 lines, 4 files

Files

Data/Functor/Representable/Trie.hs view
@@ -27,6 +27,8 @@ import Data.Eq.Type import Data.Functor.Identity import Data.Functor.Product+import Data.Functor.Representable.Trie.Bool+import Data.Functor.Representable.Trie.List import Data.Key import Prelude hiding (lookup) @@ -110,6 +112,10 @@   type Trie () = Identity   keyRefl = Refl +instance HasTrie Bool where+  type Trie Bool = BoolTrie+  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@@ -121,3 +127,9 @@   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++instance HasTrie a => HasTrie [a] where+  type Trie [a] = ListTrie (Trie a)+  keyRefl = go keyRefl where+    go :: (a := Key (Trie a)) -> [a] := Key (Trie [a])+    go Refl = Refl
+ Data/Functor/Representable/Trie/Bool.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE TypeFamilies #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Representable.Trie.Bool+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- +----------------------------------------------------------------------++module Data.Functor.Representable.Trie.Bool ( BoolTrie (..) ) where++import Control.Applicative+import Data.Distributive+import Data.Functor.Representable+import Data.Functor.Bind+import Data.Foldable+import Data.Monoid+import Data.Traversable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Key+import Prelude hiding (lookup)++-- (Bool, -) -| BoolTrie+data BoolTrie a = BoolTrie a a deriving (Eq,Ord,Show,Read)++false :: BoolTrie a -> a+false (BoolTrie a _) = a++true :: BoolTrie a -> a+true (BoolTrie _ b) = b++type instance Key BoolTrie = Bool++instance Functor BoolTrie where+  fmap f (BoolTrie a b) = BoolTrie (f a) (f b)+  b <$ _ = pure b++instance Apply BoolTrie where+  BoolTrie a b <.> BoolTrie c d = BoolTrie (a c) (b d)+  a <. _ = a+  _ .> b = b++instance Applicative BoolTrie where+  pure a = BoolTrie a a+  (<*>) = (<.>) +  a <* _ = a+  _ *> b = b++instance Bind BoolTrie where+  BoolTrie a b >>- f = BoolTrie (false (f a)) (true (f b))++instance Monad BoolTrie where+  return = pure+  BoolTrie a b >>= f = BoolTrie (false (f a)) (true (f b))+  _ >> a = a++instance Keyed BoolTrie where+  mapWithKey f (BoolTrie a b) = BoolTrie (f False a) (f True b)++instance Foldable BoolTrie where+  foldMap f (BoolTrie a b) = f a `mappend` f b++instance Foldable1 BoolTrie where+  foldMap1 f (BoolTrie a b) = f a <> f b++instance Traversable BoolTrie where+  traverse f (BoolTrie a b) = BoolTrie <$> f a <*> f b++instance Traversable1 BoolTrie where+  traverse1 f (BoolTrie a b) = BoolTrie <$> f a <.> f b++instance FoldableWithKey BoolTrie where+  foldMapWithKey f (BoolTrie a b) = f False a `mappend` f True b++instance FoldableWithKey1 BoolTrie where+  foldMapWithKey1 f (BoolTrie a b) = f False a <> f True b++instance TraversableWithKey BoolTrie where+  traverseWithKey f (BoolTrie a b) = BoolTrie <$> f False a <*> f True b++instance TraversableWithKey1 BoolTrie where+  traverseWithKey1 f (BoolTrie a b) = BoolTrie <$> f False a <.> f True b++instance Distributive BoolTrie where+  distribute = distributeRep++instance Indexable BoolTrie where+  index (BoolTrie a _) False = a+  index (BoolTrie _ b) True  = b++instance Adjustable BoolTrie where+  adjust f False (BoolTrie a b) = BoolTrie (f a) b+  adjust f True (BoolTrie a b) = BoolTrie a (f b)++instance Lookup BoolTrie where+  lookup = lookupDefault++instance Representable BoolTrie where+  tabulate f = BoolTrie (f False) (f True)
+ Data/Functor/Representable/Trie/List.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE TypeFamilies #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Representable.Trie.Bool+-- Copyright   :  (c) Edward Kmett 2011+-- License     :  BSD3+-- +-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- +----------------------------------------------------------------------++module Data.Functor.Representable.Trie.List ( +    ListTrie (..) +  , nil+  , cons+  ) where++import Control.Applicative+import Data.Distributive+import Data.Functor.Representable+import Data.Functor.Bind+import Data.Foldable+import Data.Monoid+import Data.Traversable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Key+import Prelude hiding (lookup)++-- 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)++type instance Key (ListTrie f) = [Key f]++nil :: ListTrie f a -> a+nil (ListTrie x _) = x++cons :: Indexable f => Key f -> ListTrie f a -> ListTrie f a +cons a (ListTrie _ xs) = index xs a ++instance Functor f => Functor (ListTrie f) where+  fmap f (ListTrie a as) = ListTrie (f a) (fmap (fmap f) as)+-- b <$ _ = pure b++instance Apply f => Apply (ListTrie f) where+  ListTrie a as <.> ListTrie b bs = ListTrie (a b) ((<.>) <$> as <.> bs)+  a <. _ = a+  _ .> b = b++instance Applicative f => Applicative (ListTrie f) where+  pure a = as where as = ListTrie a (pure as)+  ListTrie a as <*> ListTrie b bs = ListTrie (a b) ((<*>) <$> as <*> bs)+  a <* _ = a+  _ *> b = b++instance Representable f => Bind (ListTrie f) where+  (>>-) = bindRep++instance Representable f => Monad (ListTrie f) where+  return = pure+  (>>=) = bindRep+  _ >> a = a++instance Keyed f => Keyed (ListTrie f) where+  mapWithKey f (ListTrie a as) = ListTrie (f [] a) (mapWithKey (\x -> mapWithKey (f . (x:))) as)++instance Foldable f => Foldable (ListTrie f) where+  foldMap f (ListTrie a as) = f a `mappend` foldMap (foldMap f) as++instance Foldable1 f => Foldable1 (ListTrie f) where+  foldMap1 f (ListTrie a as) = f a <> foldMap1 (foldMap1 f) as++instance Traversable f => Traversable (ListTrie f) where+  traverse f (ListTrie a as) = ListTrie <$> f a <*> traverse (traverse f) as++instance Traversable1 f => Traversable1 (ListTrie f) where+  traverse1 f (ListTrie a as) = ListTrie <$> f a <.> traverse1 (traverse1 f) as++instance FoldableWithKey f => FoldableWithKey (ListTrie f) where+  foldMapWithKey f (ListTrie a as) = f [] a `mappend` foldMapWithKey (\x -> foldMapWithKey (f . (x:))) as++instance FoldableWithKey1 f => FoldableWithKey1 (ListTrie f) where+  foldMapWithKey1 f (ListTrie a as) = f [] a <> foldMapWithKey1 (\x -> foldMapWithKey1 (f . (x:))) as++instance TraversableWithKey f => TraversableWithKey (ListTrie f) where+  traverseWithKey f (ListTrie a as) = ListTrie <$> f [] a <*> traverseWithKey (\x -> traverseWithKey (f . (x:))) as++instance TraversableWithKey1 f => TraversableWithKey1 (ListTrie f) where+  traverseWithKey1 f (ListTrie a as) = ListTrie <$> f [] a <.> traverseWithKey1 (\x -> traverseWithKey1 (f . (x:))) as++instance Representable f => Distributive (ListTrie f) where+  distribute = distributeRep++instance Indexable f => Indexable (ListTrie f) where+  index (ListTrie x _) [] = x +  index (ListTrie _ xs) (a:as) = index (index xs a) as++instance Adjustable f => Adjustable (ListTrie f) where+  adjust f [] (ListTrie x xs) = ListTrie (f x) xs+  adjust f (a:as) (ListTrie x xs) = ListTrie x (adjust (adjust f as) a xs)++instance Lookup f => Lookup (ListTrie f) where+  lookup [] (ListTrie x _) = Just x+  lookup (a:as) (ListTrie _ xs) = lookup a xs >>= lookup as++instance Representable f => Representable (ListTrie f) where+  tabulate f = ListTrie (f []) (tabulate (\x -> tabulate (f . (x:))))
representable-tries.cabal view
@@ -1,6 +1,6 @@ name:          representable-tries category:      Data Structures, Functors, Monads, Comonads-version:       0.2.2+version:       0.2.3 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -38,6 +38,8 @@   exposed-modules:     Control.Monad.Reader.Trie     Data.Functor.Representable.Trie+    Data.Functor.Representable.Trie.Bool+    Data.Functor.Representable.Trie.List     Data.Semigroupoid.Trie    ghc-options: -Wall