{- |
Module      : Data.AList
Description : An association list data type.
Copyright   : © Mike Meyer, 2015
License     : BSD3
Maintainer  : mwm@mired.org
Stability   : experimental

A module to encapsulate associative lists.

-}

module Data.AList
    (
     -- * Data
     AList,
     -- * Convert
     fromList,
     toList,
     toMap,
     fromMap,
     -- * Query
     isEmpty,
     lookupAll,
     lookupFirst,
     lookupBy,
     member,
     values,
     keys,
     -- * Modify
     insert,
     append,
     deleteAll,
     deleteFirst,
     deleteBy) where
     

import Prelude hiding (deleteBy)

import qualified Data.Map as M
import Data.List (delete)
import Data.Monoid ((<>), mappend, mempty, Monoid)
import Safe (headMay)


-- | An 'AList' is a list of of /(key, value)/ pairs. Such pairs
-- are referred to as an /item/ in the following.
data AList key value = AList [(key, value)] deriving (Show)

instance Monoid (AList k v) where
    mempty = AList []
    mappend (AList a) (AList b) = AList $ a ++ b

-- | 'isEmpty' returns 'True' if the 'AList' is empty.
isEmpty :: AList k v -> Bool
isEmpty (AList al) = null al

-- | 'lookupAll' returns a 'List' of all items with the given key.
lookupAll :: Eq k => k -> AList k v -> [v]
lookupAll k (AList al) = map snd $ filter ((== k) . fst) al

-- | 'lookupFirst' finds the first value with a matching key, if there is one.
lookupFirst :: Eq k => k -> AList k v -> Maybe v
lookupFirst k (AList l) = lookup k l

-- | 'lookupBy' returns an 'AList' of all items with keys matched by the function.
lookupBy :: (k -> Bool) -> AList k v -> AList k v
lookupBy f (AList l) = AList $ filter (f . fst) l

-- | 'member' returns true if the given key is used in the 'AList'.
member :: Eq k => k -> AList k v -> Bool
member k = elem k . keys 

-- | 'values' returns a 'List' of the values in the 'AList'.
values :: AList k v -> [v]
values (AList al) = map snd al

-- | 'keys' returns a 'List' of the keys in the 'AList'.
keys :: AList k v -> [k]
keys (AList al) = map fst al

-- | 'insert' a key, value pair at the head of the 'AList'.
insert :: k -> v -> AList k v -> AList k v
insert k v (AList l) = AList $ (k, v):l

-- | 'append' a key, value pair to the end of the 'AList'.
append :: k -> v -> AList k v -> AList k v
append k v (AList l) = AList $ l ++ [(k, v)]

-- | 'deleteAll' all values associated with a key.
deleteAll :: Eq k => k -> AList k v -> AList k v
deleteAll k = deleteBy (== k)

-- | 'deleteFirst' deletes the first value with a given key.
deleteFirst :: Eq k  => k -> AList k v -> AList k v
deleteFirst _ (AList []) = AList []
deleteFirst t (AList ((k, v):is))
    | t == k    = AList is
    | otherwise = insert k v . deleteFirst t $  AList is

-- | 'deleteBy' deletes all values with keys matched by the function.
deleteBy :: (k -> Bool) -> AList k v -> AList k v
deleteBy f = lookupBy (not . f)

-- | 'fromList' creates an 'AList' from a 'List' of items.
fromList :: [(k, v)] -> AList k v
fromList = AList

-- | 'toList' returns a 'List' of the items in an 'AList'.
toList :: AList k v -> [(k, v)]
toList (AList l) = l

-- | 'toMap' converts to a 'Map'. Behavior with multiple keys is undefined.
toMap :: Ord k => AList k v -> M.Map k v
toMap (AList l) = M.fromList l

-- | 'fromMap' creates an 'AList' from a 'Map', though I'm not sure why
-- you'd want to do that.
fromMap :: Ord k => M.Map k v -> AList k v
fromMap = AList . M.toList