packages feed

functor-combo 0.0.8 → 0.1.0

raw patch · 3 files changed

+97/−19 lines, 3 filesdep +base-orphansdep ~base

Dependencies added: base-orphans

Dependency ranges changed: base

Files

functor-combo.cabal view
@@ -1,5 +1,5 @@ Name:                functor-combo-Version:             0.0.8+Version:             0.1.0 Cabal-Version:       >= 1.2 Synopsis:            Functor combinators with tries & zippers Category:            Data
src/FunctorCombo/Functor.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TypeOperators, EmptyDataDecls, StandaloneDeriving, DeriveFunctor #-} {-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} ---------------------------------------------------------------------- -- | -- Module      :  FunctorCombo.Functor@@ -15,13 +16,17 @@ module FunctorCombo.Functor   (     Const(..),Void,voidF,Unit,unit,Id(..),unId,inId,inId2,(:+:)(..),eitherF-  , (:*:)(..),(:.)(..),unO,inO,inO2,(~>)+  , (:*:)(..),fstF,sndF,(:.)(..),unO,inO,inO2,(~>)   , Lift(..), (:*:!)(..), (:+:!)(..), eitherF'   , pairF, unPairF, inProd, inProd2   ) where  -import Control.Applicative (Applicative(..),Const(..))+import Data.Monoid(Monoid(..))+import Data.Foldable (Foldable(..))+import Data.Traversable (Traversable(..))+import Control.Applicative (Applicative(..),Const(..),liftA2,(<$>))+import Control.Monad (join)  import Control.Compose (Id(..),unId,inId,inId2,(:.)(..),unO,inO,inO2,(~>)) @@ -56,6 +61,14 @@ -- | Product on unary type constructors data (f :*: g) a = f a :*: g a deriving (Show,Functor) +-- | Like 'fst'+fstF :: (f :*: g) a -> f a+fstF (fa :*: _) = fa++-- | Like 'snd'+sndF :: (f :*: g) a -> g a+sndF (_ :*: ga) = ga+ -- | Sum on unary type constructors data (f :+: g) a = InL (f a) | InR (g a) deriving (Show,Functor) @@ -69,7 +82,7 @@   {---------------------------------------------------------------------    Functor and Applicative instances for generic constructors+    Instances --------------------------------------------------------------------}  instance Functor Void where@@ -88,6 +101,14 @@ -- TODO: replace explicit definition with deriving, when the compiler fix -- has been around for a while. +instance Foldable (Const b) where+  -- fold (Const _) = mempty+  fold = const mempty++instance Traversable (Const b) where+  -- sequenceA (Const b) = pure (Const b)+  traverse _ (Const b) = pure (Const b)+ -- instance Functor Id where --   fmap h (Id a) = Id (h a) @@ -112,6 +133,23 @@  -- TODO: Verify that the deriving instances are equivalent to the explicit versions. +instance (Foldable f, Foldable g) => Foldable (f :+: g) where+  -- fold (InL fa) = fold fa+  -- fold (InR ga) = fold ga+  fold = eitherF fold fold+  -- foldMap p (InL fa) = foldMap p fa+  -- foldMap p (InR ga) = foldMap p ga+  foldMap p = eitherF (foldMap p) (foldMap p)++instance (Traversable f, Traversable g) => Traversable (f :+: g) where+  -- sequenceA (InL fa) = InL <$> sequenceA fa+  -- sequenceA (InR ga) = InR <$> sequenceA ga+  sequenceA = eitherF (fmap InL . sequenceA) (fmap InR . sequenceA)+  -- traverse p (InL fa) = InL <$> traverse p fa+  -- traverse p (InR ga) = InR <$> traverse p ga+  traverse p = eitherF (fmap InL . traverse p) (fmap InR . traverse p)++ -- What about Applicative instances?  I think Void could implement (<*>) -- but not pure.  Hm.  Id and (:*:) are easy, while (:+:) is problematic. @@ -126,6 +164,30 @@ instance (Applicative f, Applicative g) => Applicative (f :*: g) where   pure a = pure a :*: pure a   (f :*: g) <*> (a :*: b) = (f <*> a) :*: (g <*> b)++instance (Functor f, Functor g, Monad f, Monad g) =>+         Monad (f :*: g) where+  return a = return a :*: return a+  m >>= k = joinP (k <$> m)++joinP :: (Functor f, Functor g, Monad f, Monad g) =>+         (f :*: g) ((f :*: g) a) -> (f :*: g) a+joinP m = join (fstF <$> fstF m) :*: join (sndF <$> sndF m)++-- joinP (ffga :*: gfga) = join (fstF <$> ffga) :*: join (sndF <$> gfga)++++instance (Foldable f, Foldable g) => Foldable (f :*: g) where+  -- fold (fa :*: ga) = fold fa `mappend` fold ga+  -- fold q = fold (fstF q) `mappend` fold (sndF q)+  -- fold = (fold . fstF) `mappend` (fold . sndF) -- function monoid+  foldMap p (fa :*: ga) = foldMap p fa `mappend` foldMap p ga+++instance (Traversable f, Traversable g) => Traversable (f :*: g) where+  -- sequenceA (fha :*: gha) = liftA2 (:*:) (sequenceA fha) (sequenceA gha)+  traverse p (fha :*: gha) = liftA2 (:*:) (traverse p fha) (traverse p gha)  -- instance (Applicative f, Applicative g) => Applicative (f :+: g) where --   -- pure = ?? -- could use either 'InL . pure' or 'InR . pure'
src/FunctorCombo/StrictMemo.hs view
@@ -23,6 +23,7 @@  import Control.Arrow (first) import Control.Applicative ((<$>))+import Data.Foldable (Foldable,toList)  import Data.Tree @@ -69,8 +70,8 @@     trie   :: (k  ->  v) -> (k :->: v)     -- | Convert k trie to k function, i.e., access k field of the trie     untrie :: (k :->: v) -> (k  ->  v)-    -- | List the trie elements.  Order of keys (@:: k@) is always the same.-    enumerate :: (k :->: v) -> [(k,v)]+--     -- | List the trie elements.  Order of keys (@:: k@) is always the same.+--     enumerate :: (k :->: v) -> [(k,v)]  -- -- | Domain elements of a trie -- domain :: HasTrie a => [a]@@ -78,8 +79,19 @@ --  where --    oops = error "Data.MemoTrie.domain: range element evaluated." +-- Identity trie. To do: make idTrie the method, and define trie via idTrie.+idTrie :: HasTrie k => k :->: k+idTrie = trie id +-- | List the trie elements.  Order of keys (@:: k@) is always the same.+enumerate :: (Foldable (Trie k), HasTrie k) => (k :->: v) -> [(k,v)]+enumerate = zip (toList idTrie) . toList +-- TODO: Improve this implementation, using an interface from Edward+-- Kmett. Something about collections with keys, so that I can efficiently+-- implement `(k :->: v) -> (k :->: (k,v))`.++ {--------------------------------------------------------------------     Memo functions --------------------------------------------------------------------}@@ -111,16 +123,16 @@   type Trie ()  = Id   trie   f      = Id (f ())   untrie (Id v) = const v-  enumerate (Id a) = [((),a)]+--   enumerate (Id a) = [((),a)]  instance (HasTrie a, HasTrie b) => HasTrie (Either a b) where   type Trie (Either a b) = Trie a :*: Trie b   trie   f           = trie (f . Left) :*: trie (f . Right)   untrie (ta :*: tb) = untrie ta `either` untrie tb-  enumerate (ta :*: tb) = enum' Left ta `weave` enum' Right tb+--   enumerate (ta :*: tb) = enum' Left ta `weave` enum' Right tb -enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]-enum' f = (fmap.first) f . enumerate+-- enum' :: (HasTrie a) => (a -> a') -> (a :->: b) -> [(a', b)]+-- enum' f = (fmap.first) f . enumerate  weave :: [a] -> [a] -> [a] [] `weave` as = as@@ -133,8 +145,8 @@   trie   f = O (trie (trie . curry f))   -- untrie (O tt) = uncurry (untrie . untrie tt)   untrie (O tt) = uncurry (untrie (fmap untrie tt))-  enumerate (O tt) =-    [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ]+--   enumerate (O tt) =+--     [ ((a,b),x) | (a,t) <- enumerate tt , (b,x) <- enumerate t ]   @@ -143,9 +155,11 @@   type Trie (Type) = Trie (IsoType); \   trie f = trie (f . (fromIso)); \   untrie t = untrie t . (toIso); \-  enumerate = (result.fmap.first) (fromIso) enumerate; \ } +--  enumerate = (result.fmap.first) (fromIso) enumerate;++ HasTrieIsomorph( (), Bool, Either () ()                , bool (Right ()) (Left ())                , either (\ () -> False) (\ () -> True))@@ -260,12 +274,12 @@   type Trie (Type) = TrieType; \   trie f = TrieCon (trie (f . wrap)); \   untrie (TrieCon t) = untrie t . unwrap; \-  enumerate (TrieCon t) = (result.fmap.first) wrap enumerate t; \ }; \ HasTrieIsomorph( HasTrie (PF (Type) (Type) :->: v) \                , TrieType v, PF (Type) (Type) :->: v \                , \ (TrieCon w) -> w, TrieCon ) +--  enumerate (TrieCon t) = (result.fmap.first) wrap enumerate t;    -- For instance,@@ -296,18 +310,20 @@   -enumerateEnum :: (Enum k, Num k, HasTrie k) => (k :->: v) -> [(k,v)]-enumerateEnum t = [(k, f k) | k <- [0 ..] `weave` [-1, -2 ..]]- where-   f = untrie t+-- enumerateEnum :: (Enum k, Num k, HasTrie k) => (k :->: v) -> [(k,v)]+-- enumerateEnum t = [(k, f k) | k <- [0 ..] `weave` [-1, -2 ..]]+--  where+--    f = untrie t  #define HasTrieIntegral(Type) \ instance HasTrie Type where { \   type Trie Type = IT.IntTrie; \   trie   = (<$> IT.identity); \   untrie = IT.apply; \-  enumerate = enumerateEnum; \ }++--  enumerate = enumerateEnum;+  HasTrieIntegral(Int) HasTrieIntegral(Integer)