total-map 0.0.4 → 0.0.5

raw patch · 2 files changed

+30/−5 lines, 2 files

Files

• src/Data/TotalMap.hs +29/−4
• total-map.cabal +1/−1

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, TypeOperators #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- |@@ -13,9 +12,9 @@ -- a default value. Has Applicative and Monad instances (unlike "Data.Map"). ---------------------------------------------------------------------- -module Data.TotalMap (TMap,(!),tabulate,trim) where+module Data.TotalMap (TMap,fromPartial,(!),tabulate,trim,intersectionPartialWith) where -import Data.Monoid (Monoid(..))+import Data.Monoid (Monoid(..),(<>)) import Control.Applicative (Applicative(..),liftA2,(<$>)) import Data.Maybe (fromMaybe) @@ -27,10 +26,14 @@ -- import Control.Comonad  -- TODO  -- | Total map-data TMap k v = TMap v (Map k v) deriving Functor+data TMap k v = TMap v (Map k v)  -- The representation is a default value and a finite map for the rest. +-- | Create a total map from a default value and a partial map.+fromPartial :: a -> Map k a -> TMap k a+fromPartial = TMap+ -- | Sample a total map. Semantic function. (!) :: Ord k => TMap k v -> k -> v TMap dflt m ! k = fromMaybe dflt (M.lookup k m)@@ -51,6 +54,15 @@ tabulate' = (fmap.fmap.fmap) trim tabulate -} +-- | Intersect a total map with a partial one using an element combinator.+intersectionPartialWith ::+   (Ord k) =>+   (a -> b -> c) -> TMap k a -> Map k b -> Map k c+intersectionPartialWith f (TMap ad am) bm =+   M.intersectionWith f am bm+   `M.union`+   fmap (f ad) bm+ {--------------------------------------------------------------------     Instances --------------------------------------------------------------------}@@ -62,12 +74,25 @@   mempty  = pure mempty   mappend = liftA2 mappend +instance Functor (TMap k) where+  fmap f (TMap d m) = TMap (f d) (fmap f m)+ instance Ord k => Applicative (TMap k) where   pure v = TMap v mempty   fs@(TMap df mf) <*> xs@(TMap dx mx) =      tabulate (df dx)              (M.keysSet mf `mappend` M.keysSet mx)              ((!) fs <*> (!) xs)++-- | Alternative implementation of (<*>) using complex Map operations. Might be+-- more efficient. Can be used for testing against the canonical implementation+-- above.+_app :: Ord k => TMap k (a -> b) -> TMap k a -> TMap k b+_app (TMap fd fm) (TMap ad am) =+   TMap (fd ad) $+      fmap ($ad) (M.difference fm am) <>+      fmap (fd$) (M.difference am fm) <>+      M.intersectionWith ($) fm am  -- Note: I'd like to 'trim' the tabulate result in <*>, but doing so would -- require the Eq constraint on values, which breaks Applicative.

@@ -1,5 +1,5 @@ Name:                total-map-Version:             0.0.4+Version:             0.0.5 Cabal-Version:       >= 1.6 Synopsis:            Finitely represented /total/ maps Category:            Data