diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# assoc-listlike + +An association list conceptually signifies a mapping, but is represented as a list (of key-value pairs). + +This package defines an association list as a constraint synonym for a list-like collection of tuples, using the `ListLike` type class from the [`ListLike`](http://hackage.haskell.org/package/ListLike) package. + +```haskell +type AssocList l a b = ListLike l (a, b) +``` diff --git a/assoc-listlike.cabal b/assoc-listlike.cabal new file mode 100644 --- /dev/null +++ b/assoc-listlike.cabal @@ -0,0 +1,76 @@ +name: assoc-listlike +version: 0.1.0.0 +category: Data +synopsis: Association lists (list-like collections of tuples) + +description: + An association list conceptually signifies a mapping, + but is represented as a list (of key-value pairs). + . + This package defines an association list as a constraint + synonym for a list-like collection of tuples, using the + @ListLike@ type class from the @ListLike@ package. + . + > type AssocList l a b = ListLike l (a, b) + +homepage: https://github.com/typeclasses/assoc-list +bug-reports: https://github.com/typeclasses/assoc-list/issues + +author: Chris Martin +maintainer: Chris Martin, Julie Moronuki + +copyright: 2018 Typeclass Consulting, LLC +license: MIT +license-file: license.txt + +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/typeclasses/assoc-list + +library + default-language: Haskell2010 + hs-source-dirs: src + + build-depends: + base >=4.7 && <5 + , contravariant + , ListLike + + exposed-modules: + Data.AssocList.ListLike.Comparison + , Data.AssocList.ListLike.Concept + , Data.AssocList.ListLike.Eq + , Data.AssocList.ListLike.Equivalence + , Data.AssocList.ListLike.Ord + , Data.AssocList.ListLike.Predicate + +test-suite doctest + default-language: Haskell2010 + hs-source-dirs: test + type: exitcode-stdio-1.0 + main-is: doctest.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + + build-depends: + base >=4.7 && <5 + , doctest + +test-suite hedgehog + default-language: Haskell2010 + hs-source-dirs: test + type: exitcode-stdio-1.0 + main-is: hedgehog.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N + + build-depends: + assoc-listlike + , base >=4.7 && <5 + , contravariant + , doctest + , hedgehog diff --git a/license.txt b/license.txt new file mode 100644 --- /dev/null +++ b/license.txt @@ -0,0 +1,7 @@ +Copyright 2018 Typeclass Consulting, LLC + +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/src/Data/AssocList/ListLike/Comparison.hs b/src/Data/AssocList/ListLike/Comparison.hs new file mode 100644 --- /dev/null +++ b/src/Data/AssocList/ListLike/Comparison.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns #-} + +-- | Functions on association lists that make use of a 'Comparison' +-- on the keys. + +module Data.AssocList.ListLike.Comparison + ( + + -- * Related modules + -- $relatedModules + + -- * Sorting + sortKeys + + ) where + +import Data.AssocList.ListLike.Concept + +-- base +import Prelude () + +-- contravariant +import Data.Functor.Contravariant (Comparison (..), contramap) + +-- ListLike +import Data.ListLike (cons, uncons) +import qualified Data.ListLike as LL + +-- $setup +-- >>> import Data.Functor.Contravariant (defaultComparison) + +-- $relatedModules +-- A module that is a lot like this one: +-- +-- * "Data.AssocList.ListLike.Ord" - Functions on association lists +-- that make use of an 'Ord' constraint on the type of the keys + +-- | Sort an association list according to a particular 'Comparison' +-- of its keys. This is a stable sort, so when a key appears multiple +-- times in the input list, the ordering of its values in the +-- resulting list remains unchanged. +-- +-- >>> sortKeys defaultComparison [(2, 'b'), (3, 'c'), (2, 'a'), (4, 'd'), (2, 'e'), (1, 'f')] +-- [(1,'f'),(2,'b'),(2,'a'),(2,'e'),(3,'c'),(4,'d')] + +sortKeys :: forall l a b. AssocList l a b + => Comparison a -> l -> l +sortKeys cmp = + let + cmp' = contramap (\(a, b) -> a) cmp + in + LL.sortBy (getComparison cmp') diff --git a/src/Data/AssocList/ListLike/Concept.hs b/src/Data/AssocList/ListLike/Concept.hs new file mode 100644 --- /dev/null +++ b/src/Data/AssocList/ListLike/Concept.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE ConstraintKinds, FlexibleContexts #-} + +module Data.AssocList.ListLike.Concept + ( + + -- * Association list type + AssocList + + -- * Related modules + -- $relatedModules + + -- * Exception + , MissingAssocListKey (..) + + ) where + +-- base +import Control.Exception (Exception) +import Data.Typeable (Typeable) +import Prelude (Eq, Show) + +-- ListLike +import Data.ListLike (ListLike) + +-- $relatedModules +-- * "Data.AssocList.ListLike.Eq" - Functions that involve @Eq@ +-- constraints on the keys +-- * "Data.AssocList.ListLike.Equivalence" - Most of the same functions +-- as the @Eq@ module, but with an @Equivalence@ parameter instead of +-- an @Eq@ constraint +-- * "Data.AssocList.ListLike.Predicate" - Most of the same functions as +-- the @Eq@ module, but specifying keys using a @Predicate@ rather +-- than a particular key +-- * "Data.AssocList.ListLike.Ord" - Functions that involve @Ord@ +-- constraints on the keys +-- * "Data.AssocList.ListLike.Comparison" - The same functions as the +-- @Ord@ module, but with a @Comparison@ parameter instead of an @Ord@ +-- constraint. + +type AssocList l a b = ListLike l (a, b) + +-- | This exception shows up when one attempts to retrieve a value by key +-- from an association list using a partial function with a type signature +-- such as +-- +-- > (!) :: (LikeLike l (a, b), Eq a) => l -> a -> b +-- +-- but no result can be obtained because the requested key is not present +-- exists in the mapping. + +data MissingAssocListKey = MissingAssocListKey + deriving (Eq, Show, Typeable) + +instance Exception MissingAssocListKey diff --git a/src/Data/AssocList/ListLike/Eq.hs b/src/Data/AssocList/ListLike/Eq.hs new file mode 100644 --- /dev/null +++ b/src/Data/AssocList/ListLike/Eq.hs @@ -0,0 +1,382 @@ +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns #-} + +-- | Functions on association lists that make use of an 'Eq' constraint +-- on the type of the keys. + +module Data.AssocList.ListLike.Eq + ( + + -- * Related modules + -- $relatedModules + + -- * Lookup + lookupFirst + , lookupAll + + -- * Removal + , removeFirst + , removeAll + + -- * Mapping + -- $mapping + , mapFirst + , mapAll + + -- * Alteration + -- $alteration + , alterFirst + , alterAll + + -- * Grouping + , partition + , break + , breakPartition + + -- * Operators + , (!) + , (!?) + + ) where + +import Data.AssocList.ListLike.Concept + +-- base +import Control.Exception (throw) +import Prelude (Eq (..), Maybe (..), maybe, error, otherwise, (<$>)) + +-- ListLike +import Data.ListLike (cons, uncons) +import qualified Data.ListLike as LL + +-- $setup +-- >>> import Prelude (fmap, map, negate, take) + +-- $relatedModules +-- Some other modules that are a lot like this one: +-- +-- * "Data.AssocList.ListLike.Equivalence" - Functions on association +-- lists that involve 'Equivalence's on the keys +-- * "Data.AssocList.ListLike.Predicate" - Functions on association +-- lists that involve 'Predicate's on the keys + +-- | Obtain the first value associated with a particular key. +-- +-- >>> [('A',1), ('B',2), ('B',3), ('C',4)] ! 'B' +-- 2 +-- +-- This function is to be used only when the key must be known to +-- be present in the mapping. If @x@ is not mapped by any entry in +-- @AssocList@ @l@, then @l '!' x@ throws 'MissingAssocListKey'. +-- The exclamation mark is intended as a reminder of this danger. +-- +-- >>> [('A', 1), ('B', 2), ('B', 3), ('C', 4)] ! 'D' +-- *** Exception: MissingAssocListKey +-- +-- There is a related operator called '!?' which maps the +-- missing-key condition to 'Nothing' instead. + +(!) :: forall l a b. (AssocList l a b, Eq a) + => l -> a -> b +(uncons -> Nothing) ! key = throw MissingAssocListKey +(uncons -> Just ((x, y), xys)) ! key + | key == x = y + | otherwise = xys ! key + +-- | Obtain the first value associated with a particular key, if such +-- a mapping is present. +-- +-- >>> [('A',1), ('B',2), ('B',3), ('C',4)] !? 'B' +-- Just 2 +-- +-- The result is 'Nothing' if the key is not mapped by any entry in +-- the list. +-- +-- >>> [('A',1), ('B',2), ('B',3), ('C',4)] !? 'D' +-- Nothing +-- +-- This function is the same as 'lookupFirst' but for the order of +-- its arguments. + +(!?) :: forall l a b. (AssocList l a b, Eq a) + => l -> a -> Maybe b +l !? key = lookupFirst key l + +-- | Obtain the first value associated with a particular key, if such +-- a mapping is present. +-- +-- >>> lookupFirst 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- Just 2 +-- +-- The result is 'Nothing' if the key is not mapped by any entry in +-- the list. +-- +-- >>> lookupFirst 'D' [('A',1), ('B',2), ('B',3), ('C',4)] +-- Nothing +-- +-- This function is the same as '!?' but for the order of its +-- arguments. + +lookupFirst :: forall l a b. (AssocList l a b, Eq a) + => a -> l -> Maybe b +lookupFirst _key (uncons -> Nothing) = Nothing +lookupFirst key (uncons -> Just ((x, y), xys)) + | key == x = Just y + | otherwise = lookupFirst key xys + +-- | Obtain all values associated with a particular key, in the +-- order in which the mappings appear in the list. +-- +-- >>> lookupAll 'B' [('A',1), ('B',2), ('B',3), ('C',4), ('B',3)] +-- [2,3,3] + +lookupAll :: forall l a b. (AssocList l a b, Eq a) + => a -> l -> [b] +lookupAll _key (uncons -> Nothing) = [] +lookupAll key (uncons -> Just ((x, y), xys)) + | key == x = y : lookupAll key xys + | otherwise = lookupAll key xys + +-- | Produce a modified version of the association list in which the +-- first occurrence of a particular key has been removed. +-- +-- >>> removeFirst 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- [('A',1),('B',3),('C',4)] +-- +-- If the key is not present in the mapping, then the original list +-- is returned. +-- +-- >>> removeFirst 'C' [('A',1), ('B',2), ('B',3)] +-- [('A',1),('B',2),('B',3)] + +removeFirst :: forall l a b. (AssocList l a b, Eq a) + => a -> l -> l +removeFirst _key l@(uncons -> Nothing) = l +removeFirst key (uncons -> Just (xy@(x, y), xys)) + | key == x = xys + | otherwise = cons xy (removeFirst key xys) + +-- | Produce a modified version of the association list in which all +-- occurrences of a particular key have been removed. +-- +-- >>> removeAll 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- [('A',1),('C',4)] +-- +-- If the key is not present in the mapping, then the original list +-- is returned. +-- +-- >>> removeAll 'C' [('A',1), ('B',2), ('B',3)] +-- [('A',1),('B',2),('B',3)] + +removeAll :: forall l a b. (AssocList l a b, Eq a) + => a -> l -> l +removeAll _key l@(uncons -> Nothing) = l +removeAll key (uncons -> Just (xy@(x, y), xys)) + | key == x = removeAll key xys + | otherwise = cons xy (removeAll key xys) + +-- | Produces a tuple of two results: +-- +-- 1. All values associated with a particular key +-- 2. All of the other key-value pairs +-- +-- @'partition' x l = ('lookupAll' x l, 'removeAll' x l)@ +-- +-- >>> partition 'B' [('A',1), ('B',2), ('B',3), ('C',4), ('B',3)] +-- ([2,3,3],[('A',1),('C',4)]) + +partition :: forall l a b. (AssocList l a b, Eq a) + => a -> l -> ([b], l) +partition _key l@(uncons -> Nothing) = ([], l) +partition key (uncons -> Just (xy@(x, y), xys)) + | key == x = (y : yes , no) + | otherwise = ( yes , cons xy no) + where + (yes, no) = partition key xys + +-- | Produces a tuple of two results: +-- +-- 1. The longest prefix of the association list that does /not/ contain +-- a particular key +-- 2. The remainder of the list +-- +-- >>> break 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([('A',1)],[('B',2),('B',3),('C',4)]) +-- +-- If the first mapping in the list contains the given key, then the first +-- part of the resulting tuple is empty, and the second part of the result +-- is the entire list. +-- +-- >>> break 'A' [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([],[('A',1),('B',2),('B',3),('C',4)]) +-- +-- If the key is not present in the list, then the first part of the +-- resulting tuple is the entire list, and the second part of the result +-- is empty. +-- +-- >>> break 'D' [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([('A',1),('B',2),('B',3),('C',4)],[]) + +break :: forall l a b. (AssocList l a b, Eq a) + => a -> l -> (l, l) +break key = LL.break (\(x, y) -> key == x) + +-- | 'break' on a key, then 'partition' the remainder. +-- +-- @'breakPartition' key l@ separates @l@ into three parts: +-- +-- 1. The key-value pairs for which the key is /not/ @key@ that +-- occur in the list /before/ the first occurrence of @key@ +-- (@fst ('break' key l)@) +-- 2. All values associated with @key@ (@'lookupAll' key l@) +-- 3. The key-value pairs for which the key is /not/ @key@ that +-- occur in the list /after/ the first occurrence of @key@ +-- (@'removeAll' key (snd ('break' key l))@) +-- +-- >>> breakPartition 'B' [('A',1),('B',2),('C',3),('B',4)] +-- ([('A',1)],[2,4],[('C',3)]) +-- +-- If the key is not present in the list, then the first part of the +-- result is the entire list, and the other parts are empty. +-- +-- >>> breakPartition 'D' [('A',1),('B',2),('C',3),('B',4)] +-- ([('A',1),('B',2),('C',3),('B',4)],[],[]) + +breakPartition :: forall l a b. (AssocList l a b, Eq a) + => a -> l -> (l, [b], l) +breakPartition key l = + let + (before, l') = break key l + (xs, after) = partition key l' + in + (before, xs, after) + +-- $mapping +-- The "map" functions modify values while preserving the structure of +-- the assocative list. The resulting list has the same size and order +-- as the original. + +-- | At the position where a particular key first appears in the list, +-- apply a function to the corresponding value. +-- +-- >>> mapFirst 'B' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',6)] +-- +-- If the key does not appear in the list, then the original list is +-- returned without modification. +-- +-- >>> mapFirst 'D' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6)] + +mapFirst :: forall l a b. (AssocList l a b, Eq a) + => a -> (b -> b) -> l -> l +mapFirst key f l = + let + (before, l') = break key l + in + before `LL.append` + case (uncons l') of + Nothing -> l' + Just ((x, y), after) -> cons (x, f y) after + +-- | At each position where a particular key appears in the list, +-- apply a function to the corresponding value. +-- +-- >>> mapAll 'B' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',-6)] +-- +-- If the key does not appear in the list, then the original list is +-- returned without modification. +-- +-- >>> mapAll 'D' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6)] + +mapAll :: forall l a b. (AssocList l a b, Eq a) + => a -> (b -> b) -> l -> l +mapAll key f = + LL.map g + where + g xy@(x, y) + | key == x = (x, f y) + | otherwise = xy + +-- $alteration +-- The "alter" functions provide an all-in-one way to do insertion, +-- modification, and removal. + +-- | Insert, modify, or delete a single value corresponding to +-- the first place where a particular key appears in the list. +-- +-- __Modification__ - If the key first appears in the list with a +-- corresponding value of @x@, and @f x = 'Just' x'@, then that value +-- @x@ will be replaced with @x'@ in the resulting list. +-- +-- >>> alterFirst 'B' (fmap negate) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',6)] +-- +-- __Removal__ - If the key first appears in the list with a corresponding +-- value of @x@, and @f x = 'Nothing'@, then that mapping will be removed +-- in the resulting list. +-- +-- >>> alterFirst 'B' (\_ -> Nothing) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('C',2),('B',6)] +-- +-- __Insertion__ - If the key does not appear in the list and +-- @f 'Nothing' = 'Just' x@, then @x@ be appended to the /end/ of the list. +-- +-- >>> alterFirst 'D' (\_ -> Just 0) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6),('D',0)] + +alterFirst :: forall l a b. (AssocList l a b, Eq a) + => a -> (Maybe b -> Maybe b) -- ^ @f@ + -> l -> l +alterFirst key f l = + let (before, l') = break key l + in before `LL.append` + case LL.uncons l' of + Nothing -> maybe LL.empty LL.singleton ((,) key <$> f Nothing) + Just ((x, y), after) -> maybe LL.empty LL.singleton ((,) x <$> f (Just y)) + `LL.append` after + +-- | Modify the list of values that correspond to a particular key. +-- +-- __Mapping__ - For example, to negate all values of @'B'@: +-- +-- >>> alterAll 'B' (map negate) [('A', 1), ('B', 4), ('B', 5), ('C', 2)] +-- [('A',1),('B',-4),('B',-5),('C',2)] +-- +-- __Length alteration__ - For example, to limit the number of occurrences +-- of 'B' to at most two: +-- +-- >>> alterAll 'B' (take 2) [('A', 1), ('B', 4), ('B', 5), ('B', 6), ('C', 2)] +-- [('A',1),('B',4),('B',5),('C',2)] +-- +-- __Removal__ - If @f@ returns an empty list, then the key will be removed +-- from the list entirely. +-- +-- >>> alterAll 'B' (\_ -> []) [('A', 1), ('B', 4), ('B', 5), ('C', 2)] +-- [('A',1),('C',2)] +-- +-- __Reordering__ - The key may appear in multiple noncontiguous positions +-- in the input list, but all of the new mappings for the key in the output +-- will be in one contiguous sequence starting at the position where the +-- key /first/ appears in the input list. +-- +-- >>> alterAll 'B' (map negate) [('A', 1), ('B', 4), ('C', 2), ('B', 5), ('D', 3), ('B', 6)] +-- [('A',1),('B',-4),('B',-5),('B',-6),('C',2),('D',3)] +-- +-- __Insertion__ - If the key does not appear in the list, then any result +-- from @f@ will be appended to the /end/ of the list. +-- +-- >>> alterAll 'D' (\_ -> [7, 8]) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6),('D',7),('D',8)] + +alterAll :: forall l a b. (AssocList l a b, Eq a) + => a -> ([b] -> [b]) -- ^ @f@ + -> l -> l +alterAll key f l = + let (before, l') = break key l + in before `LL.append` + case (uncons l') of + Nothing -> LL.fromList ((,) key <$> f []) + _ -> let (ys, after) = partition key l' + in LL.fromList ((,) key <$> f ys) `LL.append` after diff --git a/src/Data/AssocList/ListLike/Equivalence.hs b/src/Data/AssocList/ListLike/Equivalence.hs new file mode 100644 --- /dev/null +++ b/src/Data/AssocList/ListLike/Equivalence.hs @@ -0,0 +1,339 @@ +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns #-} + +-- | Functions on association lists that involve 'Equivalence's on the keys. + +module Data.AssocList.ListLike.Equivalence + ( + + -- * Related modules + -- $relatedModules + + -- * Lookup + lookupFirst + , lookupAll + + -- * Removal + , removeFirst + , removeAll + + -- * Mapping + -- $mapping + , mapFirst + , mapAll + + -- * Alteration + -- $alteration + , alterFirst + , alterAll + + -- * Grouping + , partition + , break + , breakPartition + + ) where + +import Data.AssocList.ListLike.Concept + +-- base +import Control.Exception (throw) +import Prelude (Eq (..), Maybe (..), maybe, error, otherwise, (<$>)) + +-- contravariant +import Data.Functor.Contravariant (Equivalence (..)) + +-- ListLike +import Data.ListLike (cons, uncons) +import qualified Data.ListLike as LL + +-- $setup +-- >>> import Data.Functor.Contravariant (defaultEquivalence) +-- >>> import Prelude (fmap, map, negate, take) + +-- $relatedModules +-- Some other modules that are a lot like this one: +-- +-- * "Data.AssocList.ListLike.Eq" - Functions on assocation lists that +-- make use of an 'Eq' constraint on the type of the keys +-- * "Data.AssocList.ListLike.Predicate" - Functions on association +-- lists that involve 'Predicate's on the keys + +-- | Obtain the first value associated with a particular key, if such +-- a mapping is present. +-- +-- >>> lookupFirst defaultEquivalence 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- Just 2 +-- +-- The result is 'Nothing' if the key is not mapped by any entry in +-- the list. +-- +-- >>> lookupFirst defaultEquivalence 'D' [('A',1), ('B',2), ('B',3), ('C',4)] +-- Nothing +-- +-- This function is the same as '!?' but for the order of its +-- arguments. + +lookupFirst :: forall l a b. AssocList l a b + => Equivalence a -> a -> l -> Maybe b +lookupFirst _eq _key (uncons -> Nothing) = Nothing +lookupFirst eq key (uncons -> Just ((x, y), xys)) + | getEquivalence eq key x = Just y + | otherwise = lookupFirst eq key xys + +-- | Obtain all values associated with a particular key, in the +-- order in which the mappings appear in the list. +-- +-- >>> lookupAll defaultEquivalence 'B' [('A',1), ('B',2), ('B',3), ('C',4), ('B',3)] +-- [2,3,3] + +lookupAll :: forall l a b. AssocList l a b + => Equivalence a -> a -> l -> [b] +lookupAll _eq _key (uncons -> Nothing) = [] +lookupAll eq key (uncons -> Just ((x, y), xys)) + | getEquivalence eq key x = y : lookupAll eq key xys + | otherwise = lookupAll eq key xys + +-- | Produce a modified version of the association list in which the +-- first occurrence of a particular key has been removed. +-- +-- >>> removeFirst defaultEquivalence 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- [('A',1),('B',3),('C',4)] +-- +-- If the key is not present in the mapping, then the original list +-- is returned. +-- +-- >>> removeFirst defaultEquivalence 'C' [('A',1), ('B',2), ('B',3)] +-- [('A',1),('B',2),('B',3)] + +removeFirst :: forall l a b. AssocList l a b + => Equivalence a -> a -> l -> l +removeFirst _eq _key l@(uncons -> Nothing) = l +removeFirst eq key (uncons -> Just (xy@(x, y), xys)) + | getEquivalence eq key x = xys + | otherwise = cons xy (removeFirst eq key xys) + +-- | Produce a modified version of the association list in which all +-- occurrences of a particular key have been removed. +-- +-- >>> removeAll defaultEquivalence 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- [('A',1),('C',4)] +-- +-- If the key is not present in the mapping, then the original list +-- is returned. +-- +-- >>> removeAll defaultEquivalence 'C' [('A',1), ('B',2), ('B',3)] +-- [('A',1),('B',2),('B',3)] + +removeAll :: forall l a b. AssocList l a b + => Equivalence a -> a -> l -> l +removeAll _eq _key l@(uncons -> Nothing) = l +removeAll eq key (uncons -> Just (xy@(x, y), xys)) + | getEquivalence eq key x = removeAll eq key xys + | otherwise = cons xy (removeAll eq key xys) + +-- | Produces a tuple of two results: +-- +-- 1. All values associated with a particular key +-- 2. All of the other key-value pairs +-- +-- @'partition' eq x l = ('lookupAll' eq x l, 'removeAll' eq x l)@ +-- +-- >>> partition defaultEquivalence 'B' [('A',1), ('B',2), ('B',3), ('C',4), ('B',3)] +-- ([2,3,3],[('A',1),('C',4)]) + +partition :: forall l a b. AssocList l a b + => Equivalence a -> a -> l -> ([b], l) +partition _eq _key l@(uncons -> Nothing) = ([], l) +partition eq key (uncons -> Just (xy@(x, y), xys)) + | getEquivalence eq key x = (y : yes , no) + | otherwise = ( yes , cons xy no) + where + (yes, no) = partition eq key xys + +-- | Produces a tuple of two results: +-- +-- 1. The longest prefix of the association list that does /not/ contain +-- a particular key +-- 2. The remainder of the list +-- +-- >>> break defaultEquivalence 'B' [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([('A',1)],[('B',2),('B',3),('C',4)]) +-- +-- If the first mapping in the list contains the given key, then the first +-- part of the resulting tuple is empty, and the second part of the result +-- is the entire list. +-- +-- >>> break defaultEquivalence 'A' [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([],[('A',1),('B',2),('B',3),('C',4)]) +-- +-- If the key is not present in the list, then the first part of the +-- resulting tuple is the entire list, and the second part of the result +-- is empty. +-- +-- >>> break defaultEquivalence 'D' [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([('A',1),('B',2),('B',3),('C',4)],[]) + +break :: forall l a b. AssocList l a b + => Equivalence a -> a -> l -> (l, l) +break eq key = LL.break (\(x, y) -> getEquivalence eq key x) + +-- | 'break' on a key, then 'partition' the remainder. +-- +-- @'breakPartition' eq key l@ separates @l@ into three parts: +-- +-- 1. The key-value pairs for which the key is /not/ @key@ that +-- occur in the list /before/ the first occurrence of @key@ +-- (@fst ('break' eq key l)@) +-- 2. All values associated with @key@ (@'lookupAll' eq key l@) +-- 3. The key-value pairs for which the key is /not/ @key@ that +-- occur in the list /after/ the first occurrence of @key@ +-- (@'removeAll' eq key (snd ('break' eq key l))@) +-- +-- >>> breakPartition defaultEquivalence 'B' [('A',1),('B',2),('C',3),('B',4)] +-- ([('A',1)],[2,4],[('C',3)]) +-- +-- If the key is not present in the list, then the first part of the +-- result is the entire list, and the other parts are empty. +-- +-- >>> breakPartition defaultEquivalence 'D' [('A',1),('B',2),('C',3),('B',4)] +-- ([('A',1),('B',2),('C',3),('B',4)],[],[]) + +breakPartition :: forall l a b. AssocList l a b + => Equivalence a -> a -> l -> (l, [b], l) +breakPartition eq key l = + let + (before, l') = break eq key l + (xs, after) = partition eq key l' + in + (before, xs, after) + +-- $mapping +-- The "map" functions modify values while preserving the structure of +-- the assocative list. The resulting list has the same size and order +-- as the original. + +-- | At the position where a particular key first appears in the list, +-- apply a function to the corresponding value. +-- +-- >>> mapFirst defaultEquivalence 'B' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',6)] +-- +-- If the key does not appear in the list, then the original list is +-- returned without modification. +-- +-- >>> mapFirst defaultEquivalence 'D' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6)] + +mapFirst :: forall l a b. AssocList l a b + => Equivalence a -> a -> (b -> b) -> l -> l +mapFirst eq key f l = + let + (before, l') = break eq key l + in + before `LL.append` + case (uncons l') of + Nothing -> l' + Just ((x, y), after) -> cons (x, f y) after + +-- | At each position where a particular key appears in the list, +-- apply a function to the corresponding value. +-- +-- >>> mapAll defaultEquivalence 'B' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',-6)] +-- +-- If the key does not appear in the list, then the original list is +-- returned without modification. +-- +-- >>> mapAll defaultEquivalence 'D' negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6)] + +mapAll :: forall l a b. AssocList l a b + => Equivalence a -> a -> (b -> b) -> l -> l +mapAll eq key f = + LL.map g + where + g xy@(x, y) + | getEquivalence eq key x = (x, f y) + | otherwise = xy + +-- $alteration +-- The "alter" functions provide an all-in-one way to do insertion, +-- modification, and removal. + +-- | Insert, modify, or delete a single value corresponding to +-- the first place where a particular key appears in the list. +-- +-- __Modification__ - If the key first appears in the list with a +-- corresponding value of @x@, and @f x = 'Just' x'@, then that value +-- @x@ will be replaced with @x'@ in the resulting list. +-- +-- >>> alterFirst defaultEquivalence 'B' (fmap negate) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',6)] +-- +-- __Removal__ - If the key first appears in the list with a corresponding +-- value of @x@, and @f x = 'Nothing'@, then that mapping will be removed +-- in the resulting list. +-- +-- >>> alterFirst defaultEquivalence 'B' (\_ -> Nothing) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('C',2),('B',6)] +-- +-- __Insertion__ - If the key does not appear in the list and +-- @f 'Nothing' = 'Just' x@, then @x@ be appended to the /end/ of the list. +-- +-- >>> alterFirst defaultEquivalence 'D' (\_ -> Just 0) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6),('D',0)] + +alterFirst :: forall l a b. AssocList l a b + => Equivalence a -> a -> (Maybe b -> Maybe b) -- ^ @f@ + -> l -> l +alterFirst eq key f l = + let (before, l') = break eq key l + in before `LL.append` + case (uncons l') of + Nothing -> maybe LL.empty LL.singleton ((,) key <$> f Nothing) + Just ((x, y), after) -> maybe LL.empty LL.singleton ((,) x <$> f (Just y)) + `LL.append` after + +-- | Modify the list of values that correspond to a particular key. +-- +-- __Mapping__ - For example, to negate all values of @'B'@: +-- +-- >>> alterAll defaultEquivalence 'B' (map negate) [('A', 1), ('B', 4), ('B', 5), ('C', 2)] +-- [('A',1),('B',-4),('B',-5),('C',2)] +-- +-- __Length alteration__ - For example, to limit the number of occurrences +-- of 'B' to at most two: +-- +-- >>> alterAll defaultEquivalence 'B' (take 2) [('A', 1), ('B', 4), ('B', 5), ('B', 6), ('C', 2)] +-- [('A',1),('B',4),('B',5),('C',2)] +-- +-- __Removal__ - If @f@ returns an empty list, then the key will be removed +-- from the list entirely. +-- +-- >>> alterAll defaultEquivalence 'B' (\_ -> []) [('A', 1), ('B', 4), ('B', 5), ('C', 2)] +-- [('A',1),('C',2)] +-- +-- __Reordering__ - The key may appear in multiple noncontiguous positions +-- in the input list, but all of the new mappings for the key in the output +-- will be in one contiguous sequence starting at the position where the +-- key /first/ appears in the input list. +-- +-- >>> alterAll defaultEquivalence 'B' (map negate) [('A', 1), ('B', 4), ('C', 2), ('B', 5), ('D', 3), ('B', 6)] +-- [('A',1),('B',-4),('B',-5),('B',-6),('C',2),('D',3)] +-- +-- __Insertion__ - If the key does not appear in the list, then any result +-- from @f@ will be appended to the /end/ of the list. +-- +-- >>> alterAll defaultEquivalence 'D' (\_ -> [7, 8]) [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6),('D',7),('D',8)] + +alterAll :: forall l a b. AssocList l a b + => Equivalence a -> a -> ([b] -> [b]) -- ^ @f@ + -> l -> l +alterAll eq key f l = + let (before, l') = break eq key l + in before `LL.append` + case (uncons l') of + Nothing -> LL.fromList ((,) key <$> f []) + _ -> let (ys, after) = partition eq key l' + in LL.fromList ((,) key <$> f ys) `LL.append` after diff --git a/src/Data/AssocList/ListLike/Ord.hs b/src/Data/AssocList/ListLike/Ord.hs new file mode 100644 --- /dev/null +++ b/src/Data/AssocList/ListLike/Ord.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns #-} + +-- | Functions on association lists that make use of an 'Ord' constraint +-- on the type of the keys. + +module Data.AssocList.ListLike.Ord + ( + + -- * Related modules + -- $relatedModules + + -- * Sorting + sortKeys + + ) where + +import Data.AssocList.ListLike.Concept + +-- base +import Data.Ord (comparing) +import Prelude (Ord (..)) + +-- ListLike +import Data.ListLike (cons, uncons) +import qualified Data.ListLike as LL + +-- $relatedModules +-- A module that is a lot like this one: +-- +-- * "Data.AssocList.ListLike.Comparison" - Functions on association +-- lists that make use of a 'Comparison' on the keys + +-- | Sort an association list according by its keys. This is a stable +-- sort, so when a key appears multiple times in the input list, the +-- ordering of its values in the resulting list remains unchanged. +-- +-- >>> sortKeys [(2, 'b'), (3, 'c'), (2, 'a'), (4, 'd'), (2, 'e'), (1, 'f')] +-- [(1,'f'),(2,'b'),(2,'a'),(2,'e'),(3,'c'),(4,'d')] + +sortKeys :: forall l a b. (AssocList l a b, Ord a) + => l -> l +sortKeys = LL.sortBy (comparing (\(a, b) -> a)) diff --git a/src/Data/AssocList/ListLike/Predicate.hs b/src/Data/AssocList/ListLike/Predicate.hs new file mode 100644 --- /dev/null +++ b/src/Data/AssocList/ListLike/Predicate.hs @@ -0,0 +1,249 @@ +{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, ViewPatterns #-} + +-- | Functions on association lists that involve 'Predicate's on the keys. + +module Data.AssocList.ListLike.Predicate + ( + + -- * Related modules + -- $relatedModules + + -- * Lookup + lookupFirst + , lookupAll + + -- * Removal + , removeFirst + , removeAll + + -- * Mapping + -- $mapping + , mapFirst + , mapAll + + -- * Grouping + , partition + , break + , breakPartition + + ) where + +import Data.AssocList.ListLike.Concept + +-- base +import Control.Exception (throw) +import Prelude (Eq (..), Maybe (..), maybe, error, otherwise, (<$>)) + +-- ListLike +import Data.ListLike (cons, uncons) +import qualified Data.ListLike as LL + +-- contravariant +import Data.Functor.Contravariant (Predicate (..)) + +-- $setup +-- >>> import Prelude ((==), negate) + +-- $relatedModules +-- Some other modules that are a lot like this one: +-- +-- * "Data.AssocList.ListLike.Eq" - Functions on association lists that +-- make use of an 'Eq' constraint on the type of the keys +-- * "Data.AssocList.ListLike.Equivalence" - Functions on association +-- lists that involve 'Equivalence's on the keys + +-- | Obtain the first value associated with a key that satisfies a +-- predicate, if such a mapping is present. +-- +-- >>> lookupFirst (Predicate (== 'B')) [('A',1), ('B',2), ('B',3), ('C',4)] +-- Just 2 +-- +-- The result is 'Nothing' if no key in the list satisfies the predicate. +-- +-- >>> lookupFirst (Predicate (== 'D')) [('A',1), ('B',2), ('B',3), ('C',4)] +-- Nothing + +lookupFirst :: forall l a b. AssocList l a b + => Predicate a -> l -> Maybe b +lookupFirst _key (uncons -> Nothing) = Nothing +lookupFirst key (uncons -> Just ((x, y), xys)) + | getPredicate key x = Just y + | otherwise = lookupFirst key xys + +-- | Obtain all values associated with keys that satisfy the predicate, +-- in the order in which the mappings appear in the list. +-- +-- >>> lookupAll (Predicate (== 'B')) [('A',1), ('B',2), ('B',3), ('C',4), ('B',3)] +-- [2,3,3] + +lookupAll :: forall l a b. AssocList l a b + => Predicate a -> l -> [b] +lookupAll _key (uncons -> Nothing) = [] +lookupAll key (uncons -> Just ((x, y), xys)) + | getPredicate key x = y : lookupAll key xys + | otherwise = lookupAll key xys + +-- | Produce a modified version of the association list in which the +-- first occurrence of a key that satisfied the predicate has been removed. +-- +-- >>> removeFirst (Predicate (== 'B')) [('A',1), ('B',2), ('B',3), ('C',4)] +-- [('A',1),('B',3),('C',4)] +-- +-- If no key in the list satisfies the predicate, then the original list +-- is returned. +-- +-- >>> removeFirst (Predicate (== 'C')) [('A',1), ('B',2), ('B',3)] +-- [('A',1),('B',2),('B',3)] + +removeFirst :: forall l a b. AssocList l a b + => Predicate a -> l -> l +removeFirst _key l@(uncons -> Nothing) = l +removeFirst key (uncons -> Just (xy@(x, y), xys)) + | getPredicate key x = xys + | otherwise = cons xy (removeFirst key xys) + +-- | Produce a modified version of the association list in which all +-- occurrences of keys that satisfy the predicate have been removed. +-- +-- >>> removeAll (Predicate (== 'B')) [('A',1), ('B',2), ('B',3), ('C',4)] +-- [('A',1),('C',4)] +-- +-- If the key is not present in the mapping, then the original list +-- is returned. +-- +-- >>> removeAll (Predicate (== 'C')) [('A',1), ('B',2), ('B',3)] +-- [('A',1),('B',2),('B',3)] + +removeAll :: forall l a b. AssocList l a b + => Predicate a -> l -> l +removeAll _key l@(uncons -> Nothing) = l +removeAll key (uncons -> Just (xy@(x, y), xys)) + | getPredicate key x = removeAll key xys + | otherwise = cons xy (removeAll key xys) + +-- | Produces a tuple of two results: +-- +-- 1. All values associated with keys that satify the predicate +-- 2. All of the other key-value pairs +-- +-- @'partition' x l = ('lookupAll' x l, 'removeAll' x l)@ +-- +-- >>> partition (Predicate (== 'B')) [('A',1), ('B',2), ('B',3), ('C',4), ('B',3)] +-- ([2,3,3],[('A',1),('C',4)]) + +partition :: forall l a b. AssocList l a b + => Predicate a -> l -> ([b], l) +partition _key l@(uncons -> Nothing) = ([], l) +partition key (uncons -> Just (xy@(x, y), xys)) + | getPredicate key x = (y : yes , no) + | otherwise = ( yes , cons xy no) + where + (yes, no) = partition key xys + +-- | Produces a tuple of two results: +-- +-- 1. The longest prefix of the association list that does /not/ contain +-- a key satisfying the predict +-- 2. The remainder of the list +-- +-- >>> break (Predicate (== 'B')) [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([('A',1)],[('B',2),('B',3),('C',4)]) +-- +-- If the key of the first mapping in the list satisfies the predicate, +-- then the first part of the resulting tuple is empty, and the second +-- part of the result is the entire list. +-- +-- >>> break (Predicate (== 'A')) [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([],[('A',1),('B',2),('B',3),('C',4)]) +-- +-- If no key in the list satisfies the predicate, then the first part of +-- the resulting tuple is the entire list, and the second part of the +-- result is empty. +-- +-- >>> break (Predicate (== 'D')) [('A',1), ('B',2), ('B',3), ('C',4)] +-- ([('A',1),('B',2),('B',3),('C',4)],[]) + +break :: forall l a b. AssocList l a b + => Predicate a -> l -> (l, l) +break key = LL.break (\(x, y) -> getPredicate key x) + +-- | 'break' on a predicate, then 'partition' the remainder. +-- +-- @'breakPartition' p l@ separates @l@ into three parts: +-- +-- 1. The key-value pairs for which the predicate is /not/ satisfied that +-- occur in the list /before/ the first occurrence of a key that satisfies +-- the predicate (@fst ('break' p l)@) +-- 2. All values associated with keys that satisfy the predicate +-- (@'lookupAll' p l@) +-- 3. The key-value pairs for which the predicate is /not/ satisfied that +-- occur in the list /after/ the first occurrence of a key that satisfies +-- the predicate (@'removeAll' p (snd ('break' p l))@) +-- +-- >>> breakPartition (Predicate (== 'B')) [('A',1),('B',2),('C',3),('B',4)] +-- ([('A',1)],[2,4],[('C',3)]) +-- +-- If the predicate is not satisfied by any key in the list, then the +-- first part of the result is the entire list, and the other parts are +-- empty. +-- +-- >>> breakPartition (Predicate (== 'D')) [('A',1),('B',2),('C',3),('B',4)] +-- ([('A',1),('B',2),('C',3),('B',4)],[],[]) + +breakPartition :: forall l a b. AssocList l a b + => Predicate a -> l -> (l, [b], l) +breakPartition key l = + let + (before, l') = break key l + (xs, after) = partition key l' + in + (before, xs, after) + +-- $mapping +-- The "map" functions modify values while preserving the structure of +-- the assocative list. The resulting list has the same size and order +-- as the original. + +-- | At the position where a key satisfying the predicate first appears +-- in the list, apply a function to the corresponding value. +-- +-- >>> mapFirst (Predicate (== 'B')) negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',6)] +-- +-- If no key in the list satisfies the predicate, then the original list is +-- returned without modification. +-- +-- >>> mapFirst (Predicate (== 'D')) negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6)] + +mapFirst :: forall l a b. AssocList l a b + => Predicate a -> (b -> b) -> l -> l +mapFirst key f l = + let + (before, l') = break key l + in + before `LL.append` + case (uncons l') of + Nothing -> l' + Just ((x, y), after) -> cons (x, f y) after + +-- | At each position in the list where the key satisfies the predicate, +-- apply a function to the corresponding value. +-- +-- >>> mapAll (Predicate (== 'B')) negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',-4),('C',2),('B',-6)] +-- +-- If no key in the list satisfies the predicate, then the original list is +-- returned without modification. +-- +-- >>> mapAll (Predicate (== 'D')) negate [('A', 1), ('B', 4), ('C', 2), ('B', 6)] +-- [('A',1),('B',4),('C',2),('B',6)] + +mapAll :: forall l a b. AssocList l a b + => Predicate a -> (b -> b) -> l -> l +mapAll key f = + LL.map g + where + g xy@(x, y) + | getPredicate key x = (x, f y) + | otherwise = xy diff --git a/test/doctest.hs b/test/doctest.hs new file mode 100644 --- /dev/null +++ b/test/doctest.hs @@ -0,0 +1,12 @@ +import Test.DocTest + +main :: IO () +main = + doctest + [ "-isrc" + , "src/Data/AssocList/ListLike/Comparison.hs" + , "src/Data/AssocList/ListLike/Eq.hs" + , "src/Data/AssocList/ListLike/Equivalence.hs" + , "src/Data/AssocList/ListLike/Ord.hs" + , "src/Data/AssocList/ListLike/Predicate.hs" + ] diff --git a/test/hedgehog.hs b/test/hedgehog.hs new file mode 100644 --- /dev/null +++ b/test/hedgehog.hs @@ -0,0 +1,556 @@ +{-# LANGUAGE TemplateHaskell #-} + +import Data.AssocList.ListLike.Concept +import qualified Data.AssocList.ListLike.Comparison +import qualified Data.AssocList.ListLike.Eq +import qualified Data.AssocList.ListLike.Equivalence +import qualified Data.AssocList.ListLike.Ord +import qualified Data.AssocList.ListLike.Predicate + +-- base +import GHC.Stack (HasCallStack) +import Control.Exception (try, Exception) +import Control.Monad (unless) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Data.Foldable (for_) +import qualified System.Exit as Exit +import qualified System.IO as IO + +-- contravariant +import qualified Data.Functor.Contravariant +import Data.Functor.Contravariant + (Comparison (..), Equivalence (..), Predicate (..)) + +-- hedgehog +import Hedgehog (Property, forAll, property, + withTests, (===), MonadTest) +import qualified Hedgehog +import qualified Hedgehog.Gen as Gen + +main :: IO () +main = do + for_ [IO.stdout, IO.stderr] $ \h -> do + IO.hSetEncoding h IO.utf8 + IO.hSetBuffering h IO.LineBuffering + success <- Hedgehog.checkParallel $$(Hedgehog.discover) + unless success Exit.exitFailure + +throws + :: ( MonadIO m, MonadTest m + , Eq a, Show a + , Eq e, Exception e + , HasCallStack + ) => a -> e -> m () +throws a e = + do + result <- liftIO (try (return $! a)) + result === Left e + +a, b, c, d, e, f :: Char +a = 'a'; b = 'b'; c = 'c'; d = 'd'; e = 'e'; f = 'f' + + +-------------------------------------------------------------------------------- +-- Data.AssocList.ListLike.Comparison +-------------------------------------------------------------------------------- + +prop_list_comparison_sortKeys :: Property +prop_list_comparison_sortKeys = withTests 1 $ property $ do + + let + sortKeys = Data.AssocList.ListLike.Comparison.sortKeys + def = Data.Functor.Contravariant.defaultComparison + + sortKeys def [(2, b), (3, c), (2, a), (7, d), (2, e), (1, f)] + === [(1, f), (2, b), (2, a), (2, e), (3, c), (7, d)] + + +-------------------------------------------------------------------------------- +-- Data.AssocList.ListLike.Eq +-------------------------------------------------------------------------------- + +prop_list_eq_bang :: Property +prop_list_eq_bang = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + (!) = (Data.AssocList.ListLike.Eq.!) + + l ! 1 === a + l ! 2 === b + l ! 3 === c + throws (l ! 4) MissingAssocListKey + +prop_list_eq_bang_maybe :: Property +prop_list_eq_bang_maybe = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + (!?) = (Data.AssocList.ListLike.Eq.!?) + + l !? 1 === Just a + l !? 2 === Just b + l !? 3 === Just c + l !? 4 === Nothing + +prop_list_eq_lookupFirst :: Property +prop_list_eq_lookupFirst = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + lookupFirst = Data.AssocList.ListLike.Eq.lookupFirst + + lookupFirst 1 l === Just a + lookupFirst 2 l === Just b + lookupFirst 3 l === Just c + lookupFirst 4 l === Nothing + +prop_list_eq_lookupAll :: Property +prop_list_eq_lookupAll = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + lookupAll = Data.AssocList.ListLike.Eq.lookupAll + + lookupAll 1 l === [a] + lookupAll 2 l === [b, d] + lookupAll 3 l === [c] + lookupAll 4 l === [] + +prop_list_eq_removeFirst :: Property +prop_list_eq_removeFirst = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + removeFirst = Data.AssocList.ListLike.Eq.removeFirst + + removeFirst 1 l === [(2, b), (2, d), (3, c)] + removeFirst 2 l === [(1, a), (2, d), (3, c)] + removeFirst 3 l === [(1, a), (2, b), (2, d)] + removeFirst 4 l === [(1, a), (2, b), (2, d), (3, c)] + +prop_list_eq_removeAll :: Property +prop_list_eq_removeAll = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + removeAll = Data.AssocList.ListLike.Eq.removeAll + + removeAll 1 l === [(2, b), (2, d), (3, c)] + removeAll 2 l === [(1, a), (3, c)] + removeAll 3 l === [(1, a), (2, b), (2, d)] + removeAll 4 l === [(1, a), (2, b), (2, d), (3, c)] + +prop_list_eq_partition :: Property +prop_list_eq_partition = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + partition = Data.AssocList.ListLike.Eq.partition + (*) = (,) + + partition 1 l === [a] * [(2, b), (2, d), (3, c)] + partition 2 l === [b, d] * [(1, a), (3, c)] + partition 3 l === [c] * [(1, a), (2, b), (2, d)] + partition 4 l === [] * [(1, a), (2, b), (2, d), (3, c)] + +prop_list_eq_break :: Property +prop_list_eq_break = withTests 1 $ property $ do + + let + l = [(1, a), (4, b), (3, c), (4, d)] + break = Data.AssocList.ListLike.Eq.break + (*) = (,) + + break 1 l === [] * [(1, a), (4, b), (3, c), (4, d)] + break 2 l === [ (1, a), (4, b), (3, c), (4, d)] * [] + break 3 l === [ (1, a), (4, b)] * [(3, c), (4, d)] + break 4 l === [ (1, a)] * [(4, b), (3, c), (4, d)] + +prop_list_eq_breakPartition :: Property +prop_list_eq_breakPartition = withTests 1 $ property $ do + + let + l = [(1, a), (4, b), (3, c), (4, d)] + breakPartition = Data.AssocList.ListLike.Eq.breakPartition + + breakPartition 1 l === ([], [a], [(4, b), (3, c), (4, d)]) + breakPartition 2 l === (l, [], []) + breakPartition 3 l === ([(1, a), (4, b)], [c], [(4, d)]) + breakPartition 4 l === ([(1, a)], [b, d], [(3, c)]) + +prop_list_eq_mapFirst :: Property +prop_list_eq_mapFirst = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + mapFirst = Data.AssocList.ListLike.Eq.mapFirst + + mapFirst a negate l === [(a, -1), (b, 4), (c, 2), (b, 6)] + mapFirst b negate l === [(a, 1), (b, -4), (c, 2), (b, 6)] + mapFirst c negate l === [(a, 1), (b, 4), (c, -2), (b, 6)] + mapFirst d negate l === [(a, 1), (b, 4), (c, 2), (b, 6)] + +prop_list_eq_mapAll :: Property +prop_list_eq_mapAll = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + mapAll = Data.AssocList.ListLike.Eq.mapAll + + mapAll a negate l === [(a, -1), (b, 4), (c, 2), (b, 6)] + mapAll b negate l === [(a, 1), (b, -4), (c, 2), (b, -6)] + mapAll c negate l === [(a, 1), (b, 4), (c, -2), (b, 6)] + mapAll d negate l === [(a, 1), (b, 4), (c, 2), (b, 6)] + +prop_list_eq_alterFirst :: Property +prop_list_eq_alterFirst = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + alterFirst = Data.AssocList.ListLike.Eq.alterFirst + + alterFirst a (fmap negate) l === [(a, -1), (b, 4), (c, 2), (b, 6)] + alterFirst b (fmap negate) l === [(a, 1), (b, -4), (c, 2), (b, 6)] + alterFirst c (fmap negate) l === [(a, 1), (b, 4), (c, -2), (b, 6)] + alterFirst d (fmap negate) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterFirst a (const Nothing) l === [ (b, 4), (c, 2), (b, 6)] + alterFirst b (const Nothing) l === [(a, 1), (c, 2), (b, 6)] + alterFirst c (const Nothing) l === [(a, 1), (b, 4), (b, 6)] + alterFirst d (const Nothing) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterFirst a (const (Just 0)) l === [(a, 0), (b, 4), (c, 2), (b, 6)] + alterFirst b (const (Just 0)) l === [(a, 1), (b, 0), (c, 2), (b, 6)] + alterFirst c (const (Just 0)) l === [(a, 1), (b, 4), (c, 0), (b, 6)] + alterFirst d (const (Just 0)) l === [(a, 1), (b, 4), (c, 2), (b, 6), (d, 0)] + +prop_list_eq_alterAll :: Property +prop_list_eq_alterAll = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + alterAll = Data.AssocList.ListLike.Eq.alterAll + + alterAll a (fmap negate) l === [(a, -1), (b, 4), (c, 2), (b, 6)] + alterAll b (fmap negate) l === [(a, 1), (b, -4), (b, -6), (c, 2)] + alterAll c (fmap negate) l === [(a, 1), (b, 4), (c, -2), (b, 6)] + alterAll d (fmap negate) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterAll a (const []) l === [ (b, 4), (c, 2), (b, 6)] + alterAll b (const []) l === [(a, 1), (c, 2) ] + alterAll c (const []) l === [(a, 1), (b, 4), (b, 6)] + alterAll d (const []) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterAll a (const [8,9]) l === [(a, 8), (a, 9), (b, 4), (c, 2), (b, 6)] + alterAll b (const [8,9]) l === [(a, 1), (b, 8), (b, 9), (c, 2)] + alterAll c (const [8,9]) l === [(a, 1), (b, 4), (c, 8), (c, 9), (b, 6)] + alterAll d (const [8,9]) l === [(a, 1), (b, 4), (c, 2), (b, 6), (d, 8), (d, 9)] + + +-------------------------------------------------------------------------------- +-- Data.AssocList.ListLike.Equivalence +-------------------------------------------------------------------------------- + +prop_list_equivalence_lookupFirst :: Property +prop_list_equivalence_lookupFirst = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + lookupFirst = Data.AssocList.ListLike.Equivalence.lookupFirst + def = Data.Functor.Contravariant.defaultEquivalence + + lookupFirst def 1 l === Just a + lookupFirst def 2 l === Just b + lookupFirst def 3 l === Just c + lookupFirst def 4 l === Nothing + +prop_list_equivalence_lookupAll :: Property +prop_list_equivalence_lookupAll = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + lookupAll = Data.AssocList.ListLike.Equivalence.lookupAll + def = Data.Functor.Contravariant.defaultEquivalence + + lookupAll def 1 l === [a] + lookupAll def 2 l === [b, d] + lookupAll def 3 l === [c] + lookupAll def 4 l === [] + +prop_list_equivalence_removeFirst :: Property +prop_list_equivalence_removeFirst = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + removeFirst = Data.AssocList.ListLike.Equivalence.removeFirst + def = Data.Functor.Contravariant.defaultEquivalence + + removeFirst def 1 l === [(2, b), (2, d), (3, c)] + removeFirst def 2 l === [(1, a), (2, d), (3, c)] + removeFirst def 3 l === [(1, a), (2, b), (2, d)] + removeFirst def 4 l === [(1, a), (2, b), (2, d), (3, c)] + +prop_list_equivalence_removeAll :: Property +prop_list_equivalence_removeAll = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + removeAll = Data.AssocList.ListLike.Equivalence.removeAll + def = Data.Functor.Contravariant.defaultEquivalence + + removeAll def 1 l === [(2, b), (2, d), (3, c)] + removeAll def 2 l === [(1, a), (3, c)] + removeAll def 3 l === [(1, a), (2, b), (2, d)] + removeAll def 4 l === [(1, a), (2, b), (2, d), (3, c)] + +prop_list_equivalence_partition :: Property +prop_list_equivalence_partition = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + partition = Data.AssocList.ListLike.Equivalence.partition + def = Data.Functor.Contravariant.defaultEquivalence + (*) = (,) + + partition def 1 l === [a] * [(2, b), (2, d), (3, c)] + partition def 2 l === [b, d] * [(1, a), (3, c)] + partition def 3 l === [c] * [(1, a), (2, b), (2, d)] + partition def 4 l === [] * [(1, a), (2, b), (2, d), (3, c)] + +prop_list_equivalence_break :: Property +prop_list_equivalence_break = withTests 1 $ property $ do + + let + l = [(1, a), (4, b), (3, c), (4, d)] + break = Data.AssocList.ListLike.Equivalence.break + def = Data.Functor.Contravariant.defaultEquivalence + (*) = (,) + + break def 1 l === [] * [(1, a), (4, b), (3, c), (4, d)] + break def 2 l === [ (1, a), (4, b), (3, c), (4, d)] * [] + break def 3 l === [ (1, a), (4, b)] * [(3, c), (4, d)] + break def 4 l === [ (1, a)] * [(4, b), (3, c), (4, d)] + +prop_list_equivalence_breakPartition :: Property +prop_list_equivalence_breakPartition = withTests 1 $ property $ do + + let + l = [(1, a), (4, b), (3, c), (4, d)] + breakPartition = Data.AssocList.ListLike.Equivalence.breakPartition + def = Data.Functor.Contravariant.defaultEquivalence + + breakPartition def 1 l === ([], [a], [(4, b), (3, c), (4, d)]) + breakPartition def 2 l === (l, [], []) + breakPartition def 3 l === ([(1, a), (4, b)], [c], [(4, d)]) + breakPartition def 4 l === ([(1, a)], [b, d], [(3, c)]) + +prop_list_equivalence_mapFirst :: Property +prop_list_equivalence_mapFirst = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + mapFirst = Data.AssocList.ListLike.Equivalence.mapFirst + def = Data.Functor.Contravariant.defaultEquivalence + + mapFirst def a negate l === [(a, -1), (b, 4), (c, 2), (b, 6)] + mapFirst def b negate l === [(a, 1), (b, -4), (c, 2), (b, 6)] + mapFirst def c negate l === [(a, 1), (b, 4), (c, -2), (b, 6)] + mapFirst def d negate l === [(a, 1), (b, 4), (c, 2), (b, 6)] + +prop_list_equivalence_mapAll :: Property +prop_list_equivalence_mapAll = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + mapAll = Data.AssocList.ListLike.Equivalence.mapAll + def = Data.Functor.Contravariant.defaultEquivalence + + mapAll def a negate l === [(a, -1), (b, 4), (c, 2), (b, 6)] + mapAll def b negate l === [(a, 1), (b, -4), (c, 2), (b, -6)] + mapAll def c negate l === [(a, 1), (b, 4), (c, -2), (b, 6)] + mapAll def d negate l === [(a, 1), (b, 4), (c, 2), (b, 6)] + +prop_list_equivalence_alterFirst :: Property +prop_list_equivalence_alterFirst = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + alterFirst = Data.AssocList.ListLike.Equivalence.alterFirst + def = Data.Functor.Contravariant.defaultEquivalence + + alterFirst def a (fmap negate) l === [(a, -1), (b, 4), (c, 2), (b, 6)] + alterFirst def b (fmap negate) l === [(a, 1), (b, -4), (c, 2), (b, 6)] + alterFirst def c (fmap negate) l === [(a, 1), (b, 4), (c, -2), (b, 6)] + alterFirst def d (fmap negate) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterFirst def a (const Nothing) l === [ (b, 4), (c, 2), (b, 6)] + alterFirst def b (const Nothing) l === [(a, 1), (c, 2), (b, 6)] + alterFirst def c (const Nothing) l === [(a, 1), (b, 4), (b, 6)] + alterFirst def d (const Nothing) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterFirst def a (const (Just 0)) l === [(a, 0), (b, 4), (c, 2), (b, 6)] + alterFirst def b (const (Just 0)) l === [(a, 1), (b, 0), (c, 2), (b, 6)] + alterFirst def c (const (Just 0)) l === [(a, 1), (b, 4), (c, 0), (b, 6)] + alterFirst def d (const (Just 0)) l === [(a, 1), (b, 4), (c, 2), (b, 6), (d, 0)] + +prop_list_equivalence_alterAll :: Property +prop_list_equivalence_alterAll = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + alterAll = Data.AssocList.ListLike.Equivalence.alterAll + def = Data.Functor.Contravariant.defaultEquivalence + + alterAll def a (fmap negate) l === [(a, -1), (b, 4), (c, 2), (b, 6)] + alterAll def b (fmap negate) l === [(a, 1), (b, -4), (b, -6), (c, 2)] + alterAll def c (fmap negate) l === [(a, 1), (b, 4), (c, -2), (b, 6)] + alterAll def d (fmap negate) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterAll def a (const []) l === [ (b, 4), (c, 2), (b, 6)] + alterAll def b (const []) l === [(a, 1), (c, 2) ] + alterAll def c (const []) l === [(a, 1), (b, 4), (b, 6)] + alterAll def d (const []) l === [(a, 1), (b, 4), (c, 2), (b, 6)] + + alterAll def a (const [8,9]) l === [(a, 8), (a, 9), (b, 4), (c, 2), (b, 6)] + alterAll def b (const [8,9]) l === [(a, 1), (b, 8), (b, 9), (c, 2)] + alterAll def c (const [8,9]) l === [(a, 1), (b, 4), (c, 8), (c, 9), (b, 6)] + alterAll def d (const [8,9]) l === [(a, 1), (b, 4), (c, 2), (b, 6), (d, 8), (d, 9)] + + +-------------------------------------------------------------------------------- +-- Data.AssocList.ListLike.Ord +-------------------------------------------------------------------------------- + +prop_list_ord_sortKeys :: Property +prop_list_ord_sortKeys = withTests 1 $ property $ do + + let + sortKeys = Data.AssocList.ListLike.Ord.sortKeys + + sortKeys [(2, b), (3, c), (2, a), (7, d), (2, e), (1, f)] + === [(1, f), (2, b), (2, a), (2, e), (3, c), (7, d)] + + +-------------------------------------------------------------------------------- +-- Data.AssocList.ListLike.Predicate +-------------------------------------------------------------------------------- + +prop_list_predicate_lookupFirst :: Property +prop_list_predicate_lookupFirst = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + lookupFirst = Data.AssocList.ListLike.Predicate.lookupFirst + eq x = Predicate (== x) + + lookupFirst (eq 1) l === Just a + lookupFirst (eq 2) l === Just b + lookupFirst (eq 3) l === Just c + lookupFirst (eq 4) l === Nothing + +prop_list_predicate_lookupAll :: Property +prop_list_predicate_lookupAll = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + lookupAll = Data.AssocList.ListLike.Predicate.lookupAll + eq x = Predicate (== x) + + lookupAll (eq 1) l === [a] + lookupAll (eq 2) l === [b, d] + lookupAll (eq 3) l === [c] + lookupAll (eq 4) l === [] + +prop_list_predicate_removeFirst :: Property +prop_list_predicate_removeFirst = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + removeFirst = Data.AssocList.ListLike.Predicate.removeFirst + eq x = Predicate (== x) + + removeFirst (eq 1) l === [(2, b), (2, d), (3, c)] + removeFirst (eq 2) l === [(1, a), (2, d), (3, c)] + removeFirst (eq 3) l === [(1, a), (2, b), (2, d)] + removeFirst (eq 4) l === [(1, a), (2, b), (2, d), (3, c)] + +prop_list_predicate_removeAll :: Property +prop_list_predicate_removeAll = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + removeAll = Data.AssocList.ListLike.Predicate.removeAll + eq x = Predicate (== x) + + removeAll (eq 1) l === [(2, b), (2, d), (3, c)] + removeAll (eq 2) l === [(1, a), (3, c)] + removeAll (eq 3) l === [(1, a), (2, b), (2, d)] + removeAll (eq 4) l === [(1, a), (2, b), (2, d), (3, c)] + +prop_list_predicate_partition :: Property +prop_list_predicate_partition = withTests 1 $ property $ do + + let + l = [(1, a), (2, b), (2, d), (3, c)] + partition = Data.AssocList.ListLike.Predicate.partition + eq x = Predicate (== x) + (*) = (,) + + partition (eq 1) l === [a] * [(2, b), (2, d), (3, c)] + partition (eq 2) l === [b, d] * [(1, a), (3, c)] + partition (eq 3) l === [c] * [(1, a), (2, b), (2, d)] + partition (eq 4) l === [] * [(1, a), (2, b), (2, d), (3, c)] + +prop_list_predicate_break :: Property +prop_list_predicate_break = withTests 1 $ property $ do + + let + l = [(1, a), (4, b), (3, c), (4, d)] + break = Data.AssocList.ListLike.Predicate.break + eq x = Predicate (== x) + (*) = (,) + + break (eq 1) l === [] * [(1, a), (4, b), (3, c), (4, d)] + break (eq 2) l === [ (1, a), (4, b), (3, c), (4, d)] * [] + break (eq 3) l === [ (1, a), (4, b)] * [(3, c), (4, d)] + break (eq 4) l === [ (1, a)] * [(4, b), (3, c), (4, d)] + +prop_list_predicate_breakPartition :: Property +prop_list_predicate_breakPartition = withTests 1 $ property $ do + + let + l = [(1, a), (4, b), (3, c), (4, d)] + breakPartition = Data.AssocList.ListLike.Predicate.breakPartition + eq x = Predicate (== x) + + breakPartition (eq 1) l === ([], [a], [(4, b), (3, c), (4, d)]) + breakPartition (eq 2) l === (l, [], []) + breakPartition (eq 3) l === ([(1, a), (4, b)], [c], [(4, d)]) + breakPartition (eq 4) l === ([(1, a)], [b, d], [(3, c)]) + +prop_list_predicate_mapFirst :: Property +prop_list_predicate_mapFirst = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + mapFirst = Data.AssocList.ListLike.Predicate.mapFirst + eq x = Predicate (== x) + + mapFirst (eq a) negate l === [(a, -1), (b, 4), (c, 2), (b, 6)] + mapFirst (eq b) negate l === [(a, 1), (b, -4), (c, 2), (b, 6)] + mapFirst (eq c) negate l === [(a, 1), (b, 4), (c, -2), (b, 6)] + mapFirst (eq d) negate l === [(a, 1), (b, 4), (c, 2), (b, 6)] + +prop_list_predicate_mapAll :: Property +prop_list_predicate_mapAll = withTests 1 $ property $ do + + let + l = [(a, 1), (b, 4), (c, 2), (b, 6)] + mapAll = Data.AssocList.ListLike.Predicate.mapAll + eq x = Predicate (== x) + + mapAll (eq a) negate l === [(a, -1), (b, 4), (c, 2), (b, 6)] + mapAll (eq b) negate l === [(a, 1), (b, -4), (c, 2), (b, -6)] + mapAll (eq c) negate l === [(a, 1), (b, 4), (c, -2), (b, 6)] + mapAll (eq d) negate l === [(a, 1), (b, 4), (c, 2), (b, 6)]