map-syntax 0.1 → 0.2
raw patch · 5 files changed
+79/−23 lines, 5 files
Files
- map-syntax.cabal +3/−2
- runTestsAndCoverage.sh +53/−0
- src/Data/Map/Syntax.hs +15/−15
- test/Data/Map/Syntax/Tests.hs +7/−5
- test/Data/Map/Syntax/Util.hs +1/−1
map-syntax.cabal view
@@ -1,5 +1,5 @@ name: map-syntax-version: 0.1+version: 0.2 synopsis: Syntax sugar for defining maps description: Haskell's canonical list of tuples syntax for defining maps is not very@@ -17,7 +17,8 @@ extra-source-files: .ghci, LICENSE,- README.md+ README.md,+ runTestsAndCoverage.sh Library
+ runTestsAndCoverage.sh view
@@ -0,0 +1,53 @@+#!/bin/sh++set -e++if [ -z "$DEBUG" ]; then+ export DEBUG="testsuite"+fi++SUITE=./dist/build/testsuite/testsuite++export LC_ALL=C+export LANG=C++rm -f testsuite.tix++if [ ! -f $SUITE ]; then+cat <<EOF+Testsuite executable not found, please run:+cabal configure --enable-tests --enable-library-coverage+then+cabal build+EOF+ exit;+fi++./dist/build/testsuite/testsuite -j4 -a1000 $*++DIR=dist/hpc++MIXDIR=$DIR/mix/testsuite+OUTDIR=$DIR/html++rm -Rf $OUTDIR+mkdir -p $OUTDIR++EXCLUDES='Main+Data.Map.Syntax.Tests+Data.Map.Syntax.Util'++EXCL=""++for m in $EXCLUDES; do+ EXCL="$EXCL --exclude=$m"+done++hpc markup $EXCL --hpcdir=$MIXDIR --destdir=$OUTDIR testsuite # >/dev/null 2>&1++rm -f testsuite.tix++cat <<EOF++Test coverage report written to $DIR.+EOF
src/Data/Map/Syntax.hs view
@@ -41,7 +41,7 @@ -- * Lower level functions , DupStrat(..) , ItemRep(..)- , add+ , addStrat ) where @@ -78,7 +78,7 @@ -------------------------------------------------------------------------------type MapRep k v = [ItemRep k v]+type MapRep k v = [ItemRep k v] -> [ItemRep k v] ------------------------------------------------------------------------------@@ -100,20 +100,20 @@ ------------------------------------------------------------------------------ -- | Low level add function for adding a specific DupStrat, key, and value.-add :: DupStrat -> k -> v -> MapSyntax k v-add strat k v = add' [ItemRep strat k v]+addStrat :: DupStrat -> k -> v -> MapSyntax k v+addStrat strat k v = addStrat' [ItemRep strat k v] -------------------------------------------------------------------------------add' :: [ItemRep k v] -> MapSyntax k v-add' irs = MapSyntaxM $ modify (++ irs)+addStrat' :: [ItemRep k v] -> MapSyntax k v+addStrat' irs = MapSyntaxM $ modify (\ir -> ir . (irs ++)) ------------------------------------------------------------------------------ -- | Forces an entry to be added. If the key already exists, its value is -- overwritten. (##) :: k -> v -> MapSyntax k v-(##) = add Replace+(##) = addStrat Replace infixr 0 ## @@ -122,7 +122,7 @@ -- return a Left with the list of offending keys. This may be useful if name -- collisions are bad and you want to know when they occur. (#!) :: k -> v -> MapSyntax k v-(#!) = add Error+(#!) = addStrat Error infixr 0 #! @@ -131,7 +131,7 @@ -- does exist, it silently continues without overwriting or generating an -- error indication. (#?) :: k -> v -> MapSyntax k v-(#?) = add Ignore+(#?) = addStrat Ignore infixr 0 #? @@ -179,7 +179,7 @@ ([],m) -> Right m (es,_) -> Left es where- res = foldl f (mempty, mempty) $ execState (unMapSyntax ms) mempty+ res = foldl f (mempty, mempty) $ execState (unMapSyntax ms) id [] f accum@(es,m) ir@ItemRep{..} = case lookupEntry irKey m of Just v1 -> replace accum ir v1@@ -196,20 +196,20 @@ ------------------------------------------------------------------------------ execMapSyntax :: MapSyntaxM k v a -> MapRep k v-execMapSyntax ms = execState (unMapSyntax ms) mempty+execMapSyntax ms = execState (unMapSyntax ms) id ------------------------------------------------------------------------------ -- | Maps a function over all the keys. mapK :: (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v-mapK f ms = add' items+mapK f ms = addStrat' items where- items = map (\ir -> ir { irKey = f (irKey ir) }) $ execMapSyntax ms+ items = map (\ir -> ir { irKey = f (irKey ir) }) $ execMapSyntax ms [] ------------------------------------------------------------------------------ -- | Maps a function over all the values. mapV :: (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2-mapV f ms = add' items+mapV f ms = addStrat' items where- items = map (\ir -> ir { irVal = f (irVal ir) }) $ execMapSyntax ms+ items = map (\ir -> ir { irVal = f (irVal ir ) }) $ execMapSyntax ms []
test/Data/Map/Syntax/Tests.hs view
@@ -7,7 +7,7 @@ import qualified Data.List as L import Data.Function (on) import qualified Data.Map as M-import Data.Monoid (mempty,(<>))+import Data.Monoid (mempty, mappend) import Test.Framework (Test) import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty)@@ -62,7 +62,7 @@ :: (String,String)]) (runMapSyntax' f M.lookup M.insert $ mkDupMap (#!)) where- f k v v1 = Just (k <> v1 <> v)+ f k v v1 = Just (k `mappend` v1 `mappend` v) mkDupMap :: (String -> String -> MapSyntax String String) -> MapSyntax String String@@ -203,18 +203,20 @@ ------------------------------------------------------------------------------ -- |Monoid Laws prop_leftId :: ArbMapSyntax String Int -> Bool-prop_leftId a = runMap (mempty <> m) == runMap m+prop_leftId a = runMap (mempty `mappend` m) == runMap m where m = unArbSyntax a prop_rightId :: ArbMapSyntax String Int -> Bool-prop_rightId a = runMap (m <> mempty) == runMap m+prop_rightId a = runMap (m `mappend` mempty) == runMap m where m = unArbSyntax a prop_assoc :: ArbMapSyntax String Int -> ArbMapSyntax String Int -> ArbMapSyntax String Int -> Bool-prop_assoc a' b' c' = runMap ((a <> b) <> c) == runMap (a <> (b <> c))+prop_assoc a' b' c' =+ runMap ((a `mappend` b) `mappend` c) ==+ runMap (a `mappend` (b `mappend` c)) where a = unArbSyntax a' b = unArbSyntax b' c = unArbSyntax c'
test/Data/Map/Syntax/Util.hs view
@@ -29,7 +29,7 @@ vs <- arbitrary strats <- listOf $ elements [Replace,Ignore,Error] return . ArbMapSyntax $- mapM_ (\(s, k, v) -> add s k v) (zip3 strats ks vs)+ mapM_ (\(s, k, v) -> addStrat s k v) (zip3 strats ks vs) ------------------------------------------------------------------------------