module Table(T, empty, size, lookup, maybe_lookup, bind, same_keys, map, fold, fold2,
  merge, to_list, of_list) where

import Prelude hiding (lookup, map, zip)
import qualified Prelude(lookup, map, zip)

newtype T a b = Table [(a, b)]

instance (Eq a, Eq b, Show a) => Eq(T a b) where
  t1 == t2 = same_keys t1 t2 &&
             fold (\k v eq -> eq && v == lookup t2 k) True t1

empty :: T a b
empty = Table []

size :: T a b -> Int
size (Table lst) = length lst

lookup :: (Eq a, Show a) => T a b -> a -> b
lookup (Table [])            sym = error ("Table.lookup: unknown key " ++ show sym)
lookup (Table ((k,v) : kvs)) sym = if k == sym then v else lookup (Table kvs) sym

maybe_lookup :: Eq a => T a b -> a -> Maybe b
maybe_lookup (Table [])            sym = Nothing
maybe_lookup (Table ((k,v) : kvs)) sym = if k == sym then Just v else maybe_lookup (Table kvs) sym

bind :: T a b -> a -> b -> T a b
bind (Table table) sym val = Table ((sym, val) : table)

same_keys :: Eq a => T a b -> T a c -> Bool
same_keys t1 t2 =
  let present t (k,_) = case maybe_lookup t k of
                          Nothing -> False
                          _       -> True
  in
  all (present t1) (to_list t2) && all (present t2) (to_list t1)

map :: (a -> b -> c) -> T a b -> T a c
map f (Table t) = (Table (Prelude.map (\(k,v) -> (k, f k v)) t))

fold :: (a -> b -> c -> c) -> c -> T a b -> c
fold f acc (Table t) = foldl (\acc (k,v) -> f k v acc) acc t

zip :: (Eq a, Show a) => T a b -> T a c -> T a (b,c)
zip t1 t2 =
  if same_keys t1 t2 then
    map (\k v1 -> (v1, lookup t2 k)) t1
  else
    error "Table.zip: tables have different shapes"

fold2 :: (Eq a, Show a) => (a -> b -> c -> d -> d) -> d -> T a b -> T a c -> d
fold2 f acc t1 t2 =
  fold (\k (v1,v2) acc -> f k v1 v2 acc) acc (zip t1 t2)

merge :: T a b -> T a b -> T a b
merge (Table t1) (Table t2) = Table (t2 ++ t1)

to_list :: T a b -> [(a,b)]
to_list (Table t) = t

of_list :: [(a,b)] -> T a b
of_list t = Table t