total-map (empty) → 0.0.0

raw patch · 4 files changed

+166/−0 lines, 4 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• COPYING +25/−0
• Setup.lhs +3/−0
• src/Data/TotalMap.hs +109/−0
• total-map.cabal +29/−0

@@ -0,0 +1,25 @@+Copyright (c) 2010 Conal Elliott+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. The names of the authors may not be used to endorse or promote products+   derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,109 @@+{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, TypeOperators #-}+{-# OPTIONS_GHC -Wall #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.TotalMap+-- Copyright   :  (c) Conal Elliott 2012+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Finitely represented /total/ maps. Represented by as a partial map and+-- a default value. Has Applicative and Monad instances (unlike "Data.Map").+----------------------------------------------------------------------++module Data.TotalMap (TMap,(!),tabulate,trim) where++import Data.Monoid (Monoid(..))+import Control.Applicative (Applicative(..),(<$>))+import Data.Maybe (fromMaybe)++import Data.Map (Map)+import qualified Data.Map as M++import Data.Set (Set)+import qualified Data.Set as S++-- | Total map+data TMap k v = TMap v (Map k v) deriving Functor++-- | Sample a total map. Semantic function.+(!) :: Ord k => TMap k v -> k -> v+TMap dflt m ! k = fromMaybe dflt (M.lookup k m)++-- | Construct a total map, given a default value, a set of keys, and a+-- function to sample over that set. You might want to 'trim' the result.+tabulate :: Eq k => v -> Set k -> (k -> v) -> TMap k v+tabulate dflt keys f = TMap dflt (f <$> idMap keys)++-- | Optimize a 'TMap', weeding out any explicit default values.+-- A semantic no-op, i.e., @(!) . trim == (!)@.+trim :: (Ord k, Eq v) => TMap k v -> TMap k v+trim (TMap dflt m) = TMap dflt (M.filter (/= dflt) m)++{-+-- Variation that weeds out values equal to the default. Requires Eq.+tabulate' :: (Ord k, Eq v) => v -> Set k -> (k -> v) -> TMap k v+tabulate' = (fmap.fmap.fmap) trim tabulate+-}++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)++-- Note: I'd like to 'trim' the tabulate result in <*>, but doing so would+-- require the Eq constraint on values, which breaks Applicative.++instance Ord k => Monad (TMap k) where+  return  = pure+  m >>= f = joinT (f <$> m)++joinT :: Ord k => TMap k (TMap k v) -> TMap k v+joinT (TMap (TMap dd dm) mtm) = +  TMap dd (M.mapWithKey (flip (!)) mtm `M.union` dm)++{-+joinT' :: (Ord k,Eq v) => TMap k (TMap k v) -> TMap k v+joinT' = trim . joinT+-}++{-+joinT (tt@(TMap (TMap (dd,dm),mtm))) = +  tabulate dd +           undefined+           -- (join ((!) ((!) <$> tt)))+           ((!) tt >>= (!))+-}++{-++-- tt :: TMap k (TMap k v)+-- fmap (!) tt :: TMap k (k -> v)+-- (!) (fmap (!) tt) :: k -> (k -> v)++tt :: TMap k (TMap k v)+dd :: v+dm :: Map k v+mtm :: Map k (TMap k v)++mapWithKey (flip (!)) mtm :: Map k v+mapWithKey (flip (!)) mtm `union` dm :: Map k v++TMap (dd,M.mapWithKey (flip (!)) mtm `M.union` dm) :: TMap k v++spec:++-}++{--------------------------------------------------------------------+    Misc+--------------------------------------------------------------------}++idMap :: Eq k => Set k -> Map k k+idMap = M.fromAscList . map (\ k -> (k,k)) . S.toAscList++-- or ... map (join (,)) ...

@@ -0,0 +1,29 @@+Name:                total-map+Version:             0.0.0+Cabal-Version:       >= 1.6+Synopsis:            Finitely represented /total/ maps+Category:            +Description:+  Finitely represented /total/ maps. Represented by as a partial map and a default value.+  Has Applicative and Monad instances (unlike Data.Map).+Author:              Conal Elliott+Maintainer:          conal@conal.net+Copyright:           (c) 2012 by Conal Elliott+License:             BSD3+License-File:        COPYING+Stability:           experimental+build-type:          Simple++-- Wait until Cabal 1.6 is more wide-spread and then add the following+-- in place of the Package-Url field and bump Cabal-Version to >= 1.6.++Source-Repository head+    type:         git+    location:     http://github.com/conal/total-map++Library+  hs-Source-Dirs:      src+  Extensions:+  Build-Depends:       base<5, containers+  Exposed-Modules:     +                       Data.TotalMap