map-syntax-0.2.0.1/0000755000000000000000000000000012752136146012146 5ustar0000000000000000map-syntax-0.2.0.1/.ghci0000644000000000000000000000005712752136146013063 0ustar0000000000000000:set -XOverloadedStrings :set -Wall :set -isrc map-syntax-0.2.0.1/LICENSE0000644000000000000000000000267312752136146013163 0ustar0000000000000000Copyright (c) 2014, Doug Beardsley All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 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. Neither the name of the authors nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 COPYRIGHT HOLDER OR CONTRIBUTORS 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. map-syntax-0.2.0.1/map-syntax.cabal0000644000000000000000000000365712752136146015246 0ustar0000000000000000name: map-syntax version: 0.2.0.1 synopsis: Syntax sugar for defining maps description: Haskell's canonical list of tuples syntax for defining maps is not very convenient and also has ambiguous semantics. This package leverages do notation to create a lighter syntax that makes semantics explicit and also allows the option of fail-fast handling of duplicate keys. license: BSD3 license-file: LICENSE author: Doug Beardsley maintainer: mightybyte@gmail.com build-type: Simple cabal-version: >= 1.10 category: Data Structures extra-source-files: .ghci, LICENSE, README.md, runTestsAndCoverage.sh Library hs-source-dirs: src default-language: Haskell2010 exposed-modules: Data.Map.Syntax build-depends: base >= 4 && < 5, containers >= 0.3 && < 0.6, mtl >= 2.0 && < 2.3 if impl(ghc >= 6.12.0) ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields source-repository head type: git location: https://github.com/mightybyte/map-syntax.git Test-suite testsuite hs-source-dirs: src test type: exitcode-stdio-1.0 main-is: TestSuite.hs other-modules: Data.Map.Syntax , Data.Map.Syntax.Util , Data.Map.Syntax.Tests default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs build-depends: base >= 4 && < 5, containers >= 0.3 && < 0.6, deepseq >= 1.3 && < 2, HUnit >= 1.2 && < 2, mtl >= 2.0 && < 2.3, QuickCheck >= 2.3.0.2 && < 3, hspec >= 2.2.3 && < 2.3, transformers >= 0.3 && < 0.6 map-syntax-0.2.0.1/README.md0000644000000000000000000000042612752136146013427 0ustar0000000000000000Haskell's canonical list of tuples syntax for defining maps is not very convenient and also has ambiguous semantics. This package leverages do notation to create a lighter syntax that makes semantics explicit and also allows the option of fail-fast handling of duplicate keys. map-syntax-0.2.0.1/runTestsAndCoverage.sh0000755000000000000000000000137012752136146016434 0ustar0000000000000000#!/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 </dev/null 2>&1 rm -f testsuite.tix cat < foo :: MapSyntax Text > foo = do > "firstName" ## "John" > "lastName" ## "Smith" -} module Data.Map.Syntax ( -- * Core API MapSyntaxM , MapSyntax , runMap , (##) , (#!) , (#?) , mapK , mapV , runMapSyntax , runMapSyntax' -- * Lower level functions , DupStrat(..) , ItemRep(..) , addStrat ) where ------------------------------------------------------------------------------ import Control.Monad.State import qualified Data.Map as M #if !MIN_VERSION_base(4,8,0) import Control.Applicative import Data.Monoid #endif ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- | Strategy to use for duplicates data DupStrat = Replace | Ignore | Error {- Note: We don't use this seemingly more general formulation: type DupStrat k v = k -> v -> v -> Either k v ...because it is contravariant in k and v and makes it impossible to implement mapK and mapV. -} ------------------------------------------------------------------------------ -- | Representation of an indivdual item in a map data ItemRep k v = ItemRep { irStrat :: DupStrat , irKey :: k , irVal :: v } ------------------------------------------------------------------------------ type MapRep k v = [ItemRep k v] -> [ItemRep k v] ------------------------------------------------------------------------------ -- | A monad providing convenient syntax for defining maps. newtype MapSyntaxM k v a = MapSyntaxM { unMapSyntax :: State (MapRep k v) a } deriving (Functor, Applicative, Monad) ------------------------------------------------------------------------------ instance Monoid (MapSyntax k v) where mempty = return $! () mappend = (>>) ------------------------------------------------------------------------------ -- | Convenient type alias that will probably be used most of the time. type MapSyntax k v = MapSyntaxM k v () ------------------------------------------------------------------------------ -- | Low level add function for adding a specific DupStrat, key, and value. addStrat :: DupStrat -> k -> v -> MapSyntax k v addStrat strat k v = addStrat' [ItemRep strat k v] ------------------------------------------------------------------------------ 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 (##) = addStrat Replace infixr 0 ## ------------------------------------------------------------------------------ -- | Tries to add an entry, but if the key already exists, then 'runMap' will -- 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 (#!) = addStrat Error infixr 0 #! ------------------------------------------------------------------------------ -- | Inserts into the map only if the key does not already exist. If the key -- does exist, it silently continues without overwriting or generating an -- error indication. (#?) :: k -> v -> MapSyntax k v (#?) = addStrat Ignore infixr 0 #? ------------------------------------------------------------------------------ -- | Runs the MapSyntaxM monad to generate a map. runMap :: Ord k => MapSyntaxM k v a -> Either [k] (M.Map k v) runMap = runMapSyntax M.lookup M.insert ------------------------------------------------------------------------------ -- | Runs the MapSyntaxM monad to generate a map. runMapSyntax :: (Monoid map) => (k -> map -> Maybe v) -- ^ Function that gets a key's value -> (k -> v -> map -> map) -- ^ Function to force-insert a key-value pair into the map -> MapSyntaxM k v a -> Either [k] map runMapSyntax = runMapSyntax' (\_ _ _ -> Nothing) ------------------------------------------------------------------------------ -- | Runs the MapSyntaxM monad to generate a map. This function gives you the -- full power of insertWith when duplicate keys are encountered. -- -- Example: -- -- > runMapSyntax' (\k new_val old_val -> Just $ old_val ++ new_val) runMapSyntax' :: (Monoid map) => (k -> v -> v -> Maybe v) -- ^ Function to handle duplicate key insertion, similar to the first -- argument to insertWith. If this function returns Nothing, then this is -- interpreted as an error. If it is a Just, then the resulting value -- will be inserted into the map. -> (k -> map -> Maybe v) -- ^ Function that gets a key's value -> (k -> v -> map -> map) -- ^ Function to force-insert a key-value pair into the map -> MapSyntaxM k v a -> Either [k] map runMapSyntax' dupFunc lookupEntry forceIns ms = case res of ([],m) -> Right m (es,_) -> Left es where 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 Nothing -> (es, forceIns irKey irVal m) replace (es,m) ir v1 = case irStrat ir of Replace -> (es, forceIns (irKey ir) (irVal ir) m) Ignore -> (es, m) Error -> maybe (es ++ [irKey ir], m) (\v -> (es, forceIns (irKey ir) v m)) $ dupFunc (irKey ir) (irVal ir) v1 ------------------------------------------------------------------------------ execMapSyntax :: MapSyntaxM k v a -> MapRep k v 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 = addStrat' items where 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 = addStrat' items where items = map (\ir -> ir { irVal = f (irVal ir ) }) $ execMapSyntax ms [] map-syntax-0.2.0.1/test/0000755000000000000000000000000012752136146013125 5ustar0000000000000000map-syntax-0.2.0.1/test/TestSuite.hs0000644000000000000000000000067212752136146015417 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Main where ------------------------------------------------------------------------------ import Test.Hspec import Data.Map.Syntax.Tests ------------------------------------------------------------------------------ main :: IO () main = hspec $ do describe "simple insertions" insTests describe "monoid laws" monoidLaws describe "nested block insertions" nestingTests map-syntax-0.2.0.1/test/Data/0000755000000000000000000000000012752136146013776 5ustar0000000000000000map-syntax-0.2.0.1/test/Data/Map/0000755000000000000000000000000012752136146014513 5ustar0000000000000000map-syntax-0.2.0.1/test/Data/Map/Syntax/0000755000000000000000000000000012752136146016001 5ustar0000000000000000map-syntax-0.2.0.1/test/Data/Map/Syntax/Tests.hs0000644000000000000000000002012212752136146017434 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} module Data.Map.Syntax.Tests where ------------------------------------------------------------------------------ import qualified Data.List as L import Data.Function (on) import qualified Data.Map as M import Data.Monoid (mempty, mappend) import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit (assertEqual) import Data.Map.Syntax import Data.Map.Syntax.Util (mkMapABC, mkMapDEF,mkMapAEF, ArbMapSyntax(..)) ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- |Simple tests for not-nested maps insTests :: Spec insTests = do it "Insert overwrite" overDup it "Insert over fail" failDup it "Reject duplicate" skipDup it "Trying dupFunc" dupFunc prop "Insert overwrite from list" prop_syntaxMatchesNubOver prop "Insert conditional from list" prop_syntaxMatchesNubCond prop "Insert error on dup from list" prop_syntaxMatchesNubErr monoidLaws :: Spec monoidLaws = do prop "Left identity" prop_leftId prop "Right identity" prop_rightId prop "Associativity" prop_assoc ------------------------------------------------------------------------------ -- |Simple tests of ##, #!, #? overDup :: IO () overDup = assertEqual "Failed to overwrite duplicate entry" (Right $ M.fromList [("firstName","Egon") :: (String,String)]) (runMap $ mkDupMap (##)) failDup :: IO () failDup = assertEqual "Failed to error on duplicate entry" (Left [("firstName" :: String)]) (runMap $ mkDupMap (#!)) skipDup :: IO () skipDup = assertEqual "Failed to reject duplicate entry" (Right $ M.fromList [("firstName","Peter")]) (runMap $ mkDupMap (#?)) dupFunc :: IO () dupFunc = assertEqual "Failed use dupFunc" (Right $ M.fromList [("firstName","firstNamePeterEgon") :: (String,String)]) (runMapSyntax' f M.lookup M.insert $ mkDupMap (#!)) where f k v v1 = Just (k `mappend` v1 `mappend` v) mkDupMap :: (String -> String -> MapSyntax String String) -> MapSyntax String String mkDupMap strat = do "firstName" `strat` "Peter" "firstName" `strat` "Egon" ------------------------------------------------------------------------------ prop_syntaxMatchesNubOver :: [(String,Int)] -> Bool prop_syntaxMatchesNubOver pairs = Right revNubMap == (runMap mSyntax) where mSyntax = mapM_ (\(k,v) -> (k ## v)) pairs revNubMap = M.fromList . L.nubBy ((==) `on` fst) . L.reverse $ pairs -- Nub keeps the first of each unique entry, so reverse list to -- simulate keeping the last prop_syntaxMatchesNubCond :: [(String,Int)] -> Bool prop_syntaxMatchesNubCond pairs = Right nubMap == (runMap mSyntax) where mSyntax = mapM_ (\(k,v) -> (k #? v)) pairs nubMap = M.fromList . L.nubBy ((==) `on` fst) $ pairs prop_syntaxMatchesNubErr :: [(String,Int)] -> Bool prop_syntaxMatchesNubErr pairs = let mMap = runMap $ mapM_ (\(k,v) -> (k #! v)) pairs in if pairs == L.nubBy ((==) `on` fst) pairs then mMap == (Right . M.fromList $ pairs) else case mMap of Right _ -> False -- We expected (Left dupKeys) Left _ -> True -- Wasn't sure about semantics here -- runMap ... ("a" #! 1) >> ("a" #! 2) >> ("a" #! 3) -- should be (Left ["a"]), or (Left ["a","a"])? ------------------------------------------------------------------------------ -- |Tests for #! when do blocks are nested nestingTests :: Spec nestingTests = do it "Nested error dups" nestedErr it "Nested error dups mapK" nestedErrMapK it "Nester error dups mapV" nestedErrMapV it "Nested overwrite dups" nestedOver it "Nested overwrite dups mapK" nestedOverMapK it "Nested overwrite dups mapV" nestedOverMapV it "Nested ignore dups mixed" nestedIgnoreMix it "Nested complex pass" nestedComplex it "Nested complex error" nestedComplexErr nestedErr :: IO () nestedErr = assertEqual "Failed to error on duplicates across do blocks" (Left ['E','F']) (runMap $ do {mkMapDEF (#!); mkMapAEF (#!)}) nestedErrMapK :: IO () nestedErrMapK = assertEqual "Failed to error on mapK'ed dups across blocks" (Left ['B']) (runMap $ do mapK succ $ mkMapABC (#!) mapK succ $ mkMapAEF (#!) ) nestedErrMapV :: IO () nestedErrMapV = assertEqual "Failed to error on mapV'ed dups across blocks" (Left ['A']) (runMap $ do mapV succ $ mkMapABC (#!) mapV succ $ mkMapAEF (#!) ) nestedOver :: IO () nestedOver = assertEqual "Failed to overwrite dup entries across blocks" (Right $ M.fromList [('A',100),('B',2),('C',3),('E',200),('F',300)]) (runMap $ do mkMapABC (##) mkMapAEF (##) ) nestedOverMapK :: IO () nestedOverMapK = assertEqual "Failed to mapK in nested blocks" (Right $ M.fromList [('A',100),('E',200),('F',300),('C',10),('D',20),('B',2)]) (runMap $ do mkMapABC (##) mapK pred $ mkMapDEF (##) mkMapAEF (##) ) nestedOverMapV :: IO () nestedOverMapV = assertEqual "Failed to mapV in nested blocks" (Right $ M.fromList [('A',99),('B',2),('C',3),('E',199),('F',299)]) (runMap $ do mkMapABC (##) mapV pred $ mkMapAEF (##) ) nestedIgnoreMix :: IO () nestedIgnoreMix = assertEqual "Failed to mapK/mapV in 'Ignore' do blocks" (Right $ M.fromList [('B',0),('C',1),('D',2),('E',31),('@',101)]) (runMap $ do mapV pred . mapK succ $ mkMapABC (#?) mapV succ . mapK pred $ mkMapDEF (#?) mapK pred . mapV succ $ mkMapAEF (#?) ) nestedComplex :: IO () nestedComplex = assertEqual "Failed a mix of dup strategies in nested block" (Right $ M.fromList [('@',1),('A',2),('B',1000),('C',1000),('D',10),('E',20),('F',30),('G',300),('H',199),('I',299)]) (runMap $ do mapK succ . mapK succ $ mkMapABC (##) mapK succ . mapK succ . mapK succ . mapV pred $ mkMapAEF (#?) mapK succ ((mapV (const 1000) $ mkMapABC (##)) >> mkMapAEF (#?)) mkMapDEF (##) mapK pred $ mkMapABC (#?) ) nestedComplexErr :: IO () nestedComplexErr = assertEqual "Failed to detect dup in complex nested block" (Left ['B']) (runMap $ do mapK succ . mapK succ $ mkMapABC (##) mapK succ . mapK succ . mapK succ . mapV pred $ mkMapAEF (#?) mapK succ ((mapV (const 1000) $ mkMapABC (##)) >> mkMapAEF (#?)) mapK pred $ mkMapABC (#!) mkMapDEF (##) mapK pred $ mkMapABC (#?) ) ------------------------------------------------------------------------------ -- |Monoid Laws prop_leftId :: ArbMapSyntax String Int -> Bool prop_leftId a = runMap (mempty `mappend` m) == runMap m where m = unArbSyntax a prop_rightId :: ArbMapSyntax String Int -> Bool 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 `mappend` b) `mappend` c) == runMap (a `mappend` (b `mappend` c)) where a = unArbSyntax a' b = unArbSyntax b' c = unArbSyntax c' map-syntax-0.2.0.1/test/Data/Map/Syntax/Util.hs0000644000000000000000000000436212752136146017257 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleInstances #-} module Data.Map.Syntax.Util where ------------------------------------------------------------------------------ import qualified Data.Map as M import qualified Data.Set as Set import Test.QuickCheck (Arbitrary (arbitrary)) import Test.QuickCheck.Gen (listOf, elements) ------------------------------------------------------------------------------ import Data.Map.Syntax ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- |All elements that appear more than once in a list (once each) dups :: (Eq a,Ord a) => [a] -> Set.Set a dups xs = let countMap = M.fromListWith (+) (zip xs $ repeat (1::Int)) in Set.fromList . map fst . M.toList $ M.filter (>1) countMap newtype ArbMapSyntax a b = ArbMapSyntax { unArbSyntax :: MapSyntax a b } ------------------------------------------------------------------------------ instance (Arbitrary a, Arbitrary b) => Arbitrary (ArbMapSyntax a b) where arbitrary = do ks <- arbitrary vs <- arbitrary strats <- listOf $ elements [Replace,Ignore,Error] return . ArbMapSyntax $ mapM_ (\(s, k, v) -> addStrat s k v) (zip3 strats ks vs) ------------------------------------------------------------------------------ -- |An (invalid) show instance - to have something for QuickCheck to print instance (Show a, Ord a, Show b) => Show (ArbMapSyntax a b) where show m = " state " ++ show (runMap . unArbSyntax $ m) ------------------------------------------------------------------------------ -- | Some sample MapSyntax's with various degrees of overlap mkMapABC :: (Char -> Int -> MapSyntax Char Int) -> MapSyntax Char Int mkMapABC strat = do 'A' `strat` 1 'B' `strat` 2 'C' `strat` 3 mkMapDEF :: (Char -> Int -> MapSyntax Char Int) -> MapSyntax Char Int mkMapDEF strat = do 'D' `strat` 10 'E' `strat` 20 'F' `strat` 30 mkMapAEF :: (Char -> Int -> MapSyntax Char Int) -> MapSyntax Char Int mkMapAEF strat = do 'A' `strat` 100 'E' `strat` 200 'F' `strat` 300