Assoc.hs

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Functions on general association (key/value) lists.
module Core.Data.List.Assoc
  ( AssocPair (..)
  , SemAssocPair (..)
  , assocKeys
  , glookup
  , glookupForce
  , assocMember
  , assocUnion
  , assocUnionBy
  , assocInsert
  , assocInsertBy
  , aappend
  ) where

import Data.Semigroup
import Data.List

-- | A generalized key/value pair - can contain more than just the key
-- and value.
class (Eq (Key a)) => AssocPair a where
  type Key a :: *
  type Value a :: *

  -- | The key in the pair.
  getKey :: a -> Key a

  -- | The value in the pair.
  getValue :: a -> Value a

-- | A generalized key/value pair, where 2 pairs with the same key can
-- be appended.
class (AssocPair a) => SemAssocPair a where
  -- | Assumes both values have the same key. Combines them, combining
  -- values with the given function.
  aappend1 :: (Value a -> Value a -> Value a) -> a -> a -> a

-- | All the keys in the association list.
assocKeys :: (AssocPair a) => [a] -> [Key a]
assocKeys = map getKey

-- | Looks up a value in an association list.
glookup :: (AssocPair a) => Key a -> [a] -> Maybe (Value a)
glookup key = fmap getValue . find (hasKey key)

-- | Looks up a value in an association list.
-- Raises an error if the value can't be found.
glookupForce :: (AssocPair a) => Key a -> [a] -> Value a
glookupForce key xs
  = case glookup key xs of
         Nothing -> error "Key not in association list"
         Just val -> val

-- | Is the key in the association list?
assocMember :: (AssocPair a) => Key a -> [a] -> Bool
assocMember = any . hasKey

hasKey :: (AssocPair a) => Key a -> a -> Bool
hasKey key pair = key == getKey pair

-- | Contains all keys from both lists. If 2 values share a key, they're appended.
-- Assumes no pairs share a key in either of the lists before they're combined.
assocUnion :: (SemAssocPair a, Semigroup (Value a)) => [a] -> [a] -> [a]
assocUnion = assocUnionBy (<>)

-- | Contains all keys from both lists. If 2 values share a key, they're appended.
-- Assumes no pairs share a key in either of the lists before they're combined.
assocUnionBy :: (SemAssocPair a)
             => (Value a -> Value a -> Value a)
             -> [a]
             -> [a]
             -> [a]
assocUnionBy = foldr . assocInsertBy

-- | Adds the pair to the list. If the original list already contains
-- its key, the value is appended to the original corresponding value.
assocInsert :: (SemAssocPair a, Monoid (Value a)) => a -> [a] -> [a]
assocInsert = assocInsertBy mappend

-- | Adds the pair to the list. If the original list already contains
-- its key, the value is appended to the original corresponding value.
assocInsertBy :: (SemAssocPair a)
              => (Value a -> Value a -> Value a)
              -> a
              -> [a]
              -> [a]
assocInsertBy _ new [] = [new]
assocInsertBy vapp new (x : xs)
  | getKey new == getKey x = (aappend1 vapp new x) : xs
  | otherwise = x : (assocInsertBy vapp new xs)

-- | Assumes both values have the same key. Combines them.
aappend :: (SemAssocPair a, Monoid (Value a)) => a -> a -> a
aappend = aappend1 mappend