module Test.MockCat.AssociationList (AssociationList, empty, insert, lookup, member, (!?), update) where import Prelude hiding (lookup) import Data.Maybe (isJust) type AssociationList k a = [(k, a)] empty :: AssociationList k a empty :: forall k a. AssociationList k a empty = [] insert :: Eq k => k -> a -> AssociationList k a -> AssociationList k a insert :: forall k a. Eq k => k -> a -> AssociationList k a -> AssociationList k a insert k key a value [] = [(k key, a value)] insert k key a value ((k k, a v) : [(k, a)] xs) | k key k -> k -> Bool forall a. Eq a => a -> a -> Bool == k k = (k key, a value) (k, a) -> [(k, a)] -> [(k, a)] forall a. a -> [a] -> [a] : [(k, a)] xs | Bool otherwise = (k k, a v) (k, a) -> [(k, a)] -> [(k, a)] forall a. a -> [a] -> [a] : k -> a -> [(k, a)] -> [(k, a)] forall k a. Eq k => k -> a -> AssociationList k a -> AssociationList k a insert k key a value [(k, a)] xs lookup :: Eq k => k -> AssociationList k a -> Maybe a lookup :: forall k a. Eq k => k -> AssociationList k a -> Maybe a lookup k _ [] = Maybe a forall a. Maybe a Nothing lookup k key ((k k, a a) : [(k, a)] xs) | k key k -> k -> Bool forall a. Eq a => a -> a -> Bool == k k = a -> Maybe a forall a. a -> Maybe a Just a a | Bool otherwise = k -> [(k, a)] -> Maybe a forall k a. Eq k => k -> AssociationList k a -> Maybe a lookup k key [(k, a)] xs member :: Eq k => k -> AssociationList k a -> Bool member :: forall k a. Eq k => k -> AssociationList k a -> Bool member k k AssociationList k a list = Maybe a -> Bool forall a. Maybe a -> Bool isJust (k -> AssociationList k a -> Maybe a forall k a. Eq k => k -> AssociationList k a -> Maybe a lookup k k AssociationList k a list) (!?) :: Eq k => AssociationList k a -> k -> Maybe a !? :: forall k a. Eq k => AssociationList k a -> k -> Maybe a (!?) = (k -> AssociationList k a -> Maybe a) -> AssociationList k a -> k -> Maybe a forall a b c. (a -> b -> c) -> b -> a -> c flip k -> AssociationList k a -> Maybe a forall k a. Eq k => k -> AssociationList k a -> Maybe a lookup update :: Eq k => (a -> a) -> k -> AssociationList k a -> AssociationList k a update :: forall k a. Eq k => (a -> a) -> k -> AssociationList k a -> AssociationList k a update a -> a f k key AssociationList k a list = case AssociationList k a list AssociationList k a -> k -> Maybe a forall k a. Eq k => AssociationList k a -> k -> Maybe a !? k key of Just a value -> k -> a -> AssociationList k a -> AssociationList k a forall k a. Eq k => k -> a -> AssociationList k a -> AssociationList k a insert k key (a -> a f a value) AssociationList k a list Maybe a Nothing -> AssociationList k a list