map-syntax-0.3/0000755000000000000000000000000013260764230011646 5ustar0000000000000000map-syntax-0.3/Setup.hs0000644000000000000000000000005613260764230013303 0ustar0000000000000000import Distribution.Simple main = defaultMain map-syntax-0.3/LICENSE0000644000000000000000000000267313260764230012663 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.3/map-syntax.cabal0000644000000000000000000000442413260764230014737 0ustar0000000000000000name: map-syntax version: 0.3 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 Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1, GHC == 8.2.1, GHC == 8.4.1 extra-source-files: .ghci, LICENSE, README.md, runCoverage.sh Library hs-source-dirs: src default-language: Haskell2010 exposed-modules: Data.Map.Syntax build-depends: base >= 4.3 && < 4.12, containers >= 0.3 && < 0.6, mtl >= 2.0 && < 2.3 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances else build-depends: semigroups == 0.18.* 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 -- See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#base-4.9.0.0 if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances else build-depends: semigroups == 0.18.* build-depends: base, containers, deepseq >= 1.3 && < 2, HUnit >= 1.2 && < 2, mtl, QuickCheck >= 2.3.0.2 && < 3, hspec >= 2.2.3 && < 2.6, transformers >= 0.3 && < 0.6 map-syntax-0.3/README.md0000644000000000000000000000042613260764230013127 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.3/.ghci0000644000000000000000000000005713260764230012563 0ustar0000000000000000:set -XOverloadedStrings :set -Wall :set -isrc map-syntax-0.3/runCoverage.sh0000755000000000000000000000075113260764230014470 0ustar0000000000000000#!/bin/sh set -e PKGVERSION=$(cabal info . | awk '{print $2;exit}') echo $PKGVERSION ROOT=dist-newstyle/build/$PKGVERSION DIR=$ROOT/hpc/vanilla HPCDIR=$DIR/mix/testsuite DESTDIR=hpc EXCLUDES='Main Data.Map.Syntax.Tests Data.Map.Syntax.Util' EXCL="" for m in $EXCLUDES; do EXCL="$EXCL --exclude=$m" done rm -Rf $DESTDIR mkdir -p $DESTDIR hpc markup $EXCL --hpcdir=$HPCDIR --destdir=$DESTDIR testsuite # >/dev/null 2>&1 cat < 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.3/test/Data/Map/Syntax/Util.hs0000644000000000000000000000436213260764230016757 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 map-syntax-0.3/src/0000755000000000000000000000000013260764230012435 5ustar0000000000000000map-syntax-0.3/src/Data/0000755000000000000000000000000013260764230013306 5ustar0000000000000000map-syntax-0.3/src/Data/Map/0000755000000000000000000000000013260764230014023 5ustar0000000000000000map-syntax-0.3/src/Data/Map/Syntax.hs0000644000000000000000000001613113260764230015647 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeSynonymInstances #-} {-| An API implementing a convenient syntax for defining maps. This module was born from the observation that a list of tuples is semantically ambiguous about how duplicate keys should be handled. Additionally, the syntax is inherently rather cumbersome and difficult to work with. This API takes advantage of do notation to provide a very light syntax for defining maps while at the same time eliminating the semantic ambiguity of alists. Here's an example: > foo :: MapSyntax Text 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 #endif #if !MIN_VERSION_base(4,11,0) import Data.Semigroup #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 Semigroup (MapSyntax k v) where (<>) = (>>) instance Monoid (MapSyntax k v) where mempty = pure $! () #if !MIN_VERSION_base(4,11,0) mappend = (<>) #endif ------------------------------------------------------------------------------ -- | 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 []