-- | A lightweight Dictionary implementation based on Data.Map, part of the "Useful" module.
--
-- So I kinda like dictionaries, but the functions and syntax by default are hardly as elegant as something like python.
-- This isn't a complete solution and nor is it optimal but it's pretty lightweight and pretty and stuff. You get it.
-- It's based off Data.Map so uses a binary tree and therefore the keys have to have some ordering defined over them.
module Useful.Dictionary where

import qualified Data.Map


-- * Dictionary creation

-- | Alias of Data.Map.fromList, takes a list of key value tuples and creates a dictionary out of them.
--
-- > dict [("hello",1),("there",2)]
-- > fromList [("hello",1),("there",2)]
-- > dict []
-- > fromList []
dict :: (Ord k) => [(k, a)] -> Data.Map.Map k a
dict l = Data.Map.fromList l

-- | Returns a List of key-value pairs
dictToList :: Data.Map.Map k a -> [(k, a)]
dictToList d = Data.Map.toList d


-- * Dictionary operations

-- | Returns Maybe v from key k
(#!) :: (Ord k) => k -> Data.Map.Map k a -> Maybe a
(#!) d k = Data.Map.lookup d k

-- | Returns v from key k or error.
(#!!) :: (Ord k) => Data.Map.Map k a -> k -> a
(#!!) d k = (Data.Map.!) d k

-- | adds key-value pair to a dictionary. If key is already in dict will update value.
(#+) :: (Ord k) => Data.Map.Map k a -> (k,a) -> Data.Map.Map k a
(#+) d (k,v) = Data.Map.insert k v d

-- | checks for a key in a dictionary.
(#?) :: (Ord k) => Data.Map.Map k a -> k -> Bool
(#?) d k = Data.Map.member k d

-- | checks if a value is in a dictionary
(#*?) :: (Eq a, Ord k) => Data.Map.Map k a -> a -> Bool
(#*?) d v = (Data.Map.keys (Data.Map.filter (==v) d)) /= []

-- | Deletes a key-pair from a dictionary given a key
(#-) :: (Ord k) => Data.Map.Map k a -> k -> Data.Map.Map k a
(#-) d k = Data.Map.delete k d

-- | Deletes ALL key-pairs from a dictionary given they match a value
(#*-) :: (Eq a, Ord k) => Data.Map.Map k a -> a -> Data.Map.Map k a
(#*-) d v = Data.Map.filter (/=v) d

-- | Intersects two dictionaries
(#\\) :: (Ord k) => Data.Map.Map k a -> Data.Map.Map k b -> Data.Map.Map k a
(#\\) d1 d2 = (Data.Map.\\) d1 d2

-- | Unions two dictionaries
(#++) :: (Ord k) => Data.Map.Map k a -> Data.Map.Map k a -> Data.Map.Map k a
(#++) d1 d2 = Data.Map.union d1 d2

-- | Tests if d1 is a sub-dictionary of d2
(#??) :: (Ord k, Eq a) => Data.Map.Map k a -> Data.Map.Map k a -> Bool
(#??) d1 d2 = Data.Map.isSubmapOf d1 d2

-- | Returns a the first occurance of a key from a value. Otherwise error.
(#?!) :: (Eq a, Ord k) => Data.Map.Map k a -> a -> k
(#?!) d v
	|(Data.Map.filter (==v) d) == Data.Map.empty = error "value is not in dictionary"
	|otherwise = head (Data.Map.keys (Data.Map.filter (==v) d))

-- | Returns the size of a dictionary
dictSize :: Data.Map.Map k a -> Int
dictSize d = Data.Map.size d

-- | Data.Maps a function to all values in a dictionary
mapD :: (a -> b) -> Data.Map.Map k a -> Data.Map.Map k b
mapD func d = Data.Map.map func d

-- | Data.Maps a function to all keys in a dictionary
mapDkeys :: (Ord k2) => (k1 -> k2) -> Data.Map.Map k1 a -> Data.Map.Map k2 a
mapDkeys func d = Data.Map.mapKeys func d

-- | filter on a dincationy, you get the idea
filterD :: (Ord k) => (a -> Bool) -> Data.Map.Map k a -> Data.Map.Map k a
filterD func d = Data.Map.filter func d

-- | filter for keys
filterDkeys :: (Ord k) => (k -> a -> Bool) -> Data.Map.Map k a -> Data.Map.Map k a
filterDkeys func d = Data.Map.filterWithKey func d