{-|
  Pure immutable hash whose lookup is O(1) on the average,
  but O(N) in the worst case.
-}

module Data.StaticHash (
    StaticHash
  , fromList, fromList', lookup
  ) where

import Data.Array
import Data.Function
import Data.Hashable
import Data.List (groupBy,sortBy)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Numbers.Primes
import Data.Ord
import Prelude hiding (lookup)

----------------------------------------------------------------

{-|
  Data type for immutable hashes.
-}

newtype StaticHash k v = StaticHash (Array Int (Some k v)) deriving Int -> StaticHash k v -> ShowS
[StaticHash k v] -> ShowS
StaticHash k v -> String
(Int -> StaticHash k v -> ShowS)
-> (StaticHash k v -> String)
-> ([StaticHash k v] -> ShowS)
-> Show (StaticHash k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> StaticHash k v -> ShowS
forall k v. (Show k, Show v) => [StaticHash k v] -> ShowS
forall k v. (Show k, Show v) => StaticHash k v -> String
showList :: [StaticHash k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [StaticHash k v] -> ShowS
show :: StaticHash k v -> String
$cshow :: forall k v. (Show k, Show v) => StaticHash k v -> String
showsPrec :: Int -> StaticHash k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> StaticHash k v -> ShowS
Show

data Some k v = None | One k v | More (Map k v) deriving Int -> Some k v -> ShowS
[Some k v] -> ShowS
Some k v -> String
(Int -> Some k v -> ShowS)
-> (Some k v -> String) -> ([Some k v] -> ShowS) -> Show (Some k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> Some k v -> ShowS
forall k v. (Show k, Show v) => [Some k v] -> ShowS
forall k v. (Show k, Show v) => Some k v -> String
showList :: [Some k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [Some k v] -> ShowS
show :: Some k v -> String
$cshow :: forall k v. (Show k, Show v) => Some k v -> String
showsPrec :: Int -> Some k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> Some k v -> ShowS
Show

type Hash = Int

----------------------------------------------------------------

{-|
  Creating 'StaticHash' from a list. A prime around the length of
  the list x 2 is chosen for the size of array. This may prevent
  collisions.
-}

fromList :: (Eq k, Ord k, Hashable k) => [(k,v)] -> StaticHash k v
fromList :: [(k, v)] -> StaticHash k v
fromList [(k, v)]
xs = Int -> [(k, v)] -> StaticHash k v
forall k v.
(Eq k, Ord k, Hashable k) =>
Int -> [(k, v)] -> StaticHash k v
fromList' ([(k, v)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(k, v)]
xs) [(k, v)]
xs

{-|
  Creating 'StaticHash' from a list and its size.
-}

fromList' :: (Eq k, Ord k, Hashable k) => Int -> [(k,v)] -> StaticHash k v
fromList' :: Int -> [(k, v)] -> StaticHash k v
fromList' Int
len [(k, v)]
xs = Array Int (Some k v) -> StaticHash k v
forall k v. Array Int (Some k v) -> StaticHash k v
StaticHash (Array Int (Some k v) -> StaticHash k v)
-> Array Int (Some k v) -> StaticHash k v
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [(Int, Some k v)] -> Array Int (Some k v)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([(Int, Some k v)] -> Array Int (Some k v))
-> [(Int, Some k v)] -> Array Int (Some k v)
forall a b. (a -> b) -> a -> b
$ [(k, v)] -> [(Int, Some k v)]
forall v. [(k, v)] -> [(Int, Some k v)]
toIxKV [(k, v)]
xs
  where
    threshold :: Int
threshold = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 -- hoping collision free
    p :: Int
p = Int -> Int
findPrime Int
threshold
    hashfunc :: k -> Int
hashfunc = (k -> Int -> Int
forall k. Hashable k => k -> Int -> Int
`hashBy` Int
p)
    toIxKV :: [(k, v)] -> [(Int, Some k v)]
toIxKV = Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
forall k v. Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
fil Int
0 Int
p ([(Int, Some k v)] -> [(Int, Some k v)])
-> ([(k, v)] -> [(Int, Some k v)]) -> [(k, v)] -> [(Int, Some k v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Int, (k, v))]] -> [(Int, Some k v)]
forall k v. Ord k => [[(Int, (k, v))]] -> [(Int, Some k v)]
unify ([[(Int, (k, v))]] -> [(Int, Some k v)])
-> ([(k, v)] -> [[(Int, (k, v))]]) -> [(k, v)] -> [(Int, Some k v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Int) -> [(k, v)] -> [[(Int, (k, v))]]
forall k v.
(Eq k, Ord k, Hashable k) =>
(k -> Int) -> [(k, v)] -> [[(Int, (k, v))]]
hashGroup k -> Int
hashfunc

findPrime :: Int -> Int
findPrime :: Int -> Int
findPrime Int
threshold = [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
threshold) [Int]
forall int. Integral int => [int]
primes

hashGroup :: (Eq k, Ord k, Hashable k) => (k -> Hash) -> [(k,v)] -> [[(Hash,(k,v))]]
hashGroup :: (k -> Int) -> [(k, v)] -> [[(Int, (k, v))]]
hashGroup k -> Int
hashfunc [(k, v)]
xs = [[(Int, (k, v))]]
gs
  where
    hs :: [(Int, (k, v))]
hs = ((k, v) -> (Int, (k, v))) -> [(k, v)] -> [(Int, (k, v))]
forall a b. (a -> b) -> [a] -> [b]
map (\kv :: (k, v)
kv@(k
k,v
_) -> (k -> Int
hashfunc k
k, (k, v)
kv)) [(k, v)]
xs
    gs :: [[(Int, (k, v))]]
gs = ((Int, (k, v)) -> (Int, (k, v)) -> Bool)
-> [(Int, (k, v))] -> [[(Int, (k, v))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int, (k, v)) -> Int) -> (Int, (k, v)) -> (Int, (k, v)) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, (k, v)) -> Int
forall a b. (a, b) -> a
fst) ([(Int, (k, v))] -> [[(Int, (k, v))]])
-> [(Int, (k, v))] -> [[(Int, (k, v))]]
forall a b. (a -> b) -> a -> b
$ ((Int, (k, v)) -> (Int, (k, v)) -> Ordering)
-> [(Int, (k, v))] -> [(Int, (k, v))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (k, v)) -> Int)
-> (Int, (k, v)) -> (Int, (k, v)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (k, v)) -> Int
forall a b. (a, b) -> a
fst) [(Int, (k, v))]
hs

unify :: Ord k => [[(Hash, (k, v))]] -> [(Hash, Some k v)]
unify :: [[(Int, (k, v))]] -> [(Int, Some k v)]
unify = ([(Int, (k, v))] -> (Int, Some k v))
-> [[(Int, (k, v))]] -> [(Int, Some k v)]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, (k, v))] -> (Int, Some k v)
forall k v. Ord k => [(Int, (k, v))] -> (Int, Some k v)
hashKeyVal

hashKeyVal :: Ord k => [(Hash,(k,v))] -> (Hash,Some k v)
hashKeyVal :: [(Int, (k, v))] -> (Int, Some k v)
hashKeyVal [(Int, (k, v))]
xs = (Int
h, [(k, v)] -> Some k v
forall k v. Ord k => [(k, v)] -> Some k v
toSome [(k, v)]
kvs)
  where
    (Int
h:[Int]
_,[(k, v)]
kvs) = [(Int, (k, v))] -> ([Int], [(k, v)])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Int, (k, v))]
xs

toSome :: Ord k => [(k,v)] -> Some k v
toSome :: [(k, v)] -> Some k v
toSome []      = Some k v
forall k v. Some k v
None
toSome [(k
k,v
v)] = k -> v -> Some k v
forall k v. k -> v -> Some k v
One k
k v
v
toSome [(k, v)]
kvs     = Map k v -> Some k v
forall k v. Map k v -> Some k v
More ([(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(k, v)]
kvs)

fil :: Int -> Int -> [(Hash, Some k v)] -> [(Hash, Some k v)]
fil :: Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
fil Int
i Int
lim []
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lim   = (Int
i,Some k v
forall k v. Some k v
None) (Int, Some k v) -> [(Int, Some k v)] -> [(Int, Some k v)]
forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
forall k v. Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
fil (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
lim []
  | Bool
otherwise = []
fil Int
i Int
lim kvs :: [(Int, Some k v)]
kvs@((Int
k,Some k v
v):[(Int, Some k v)]
rest)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k     = (Int
i,Some k v
forall k v. Some k v
None) (Int, Some k v) -> [(Int, Some k v)] -> [(Int, Some k v)]
forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
forall k v. Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
fil (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
lim [(Int, Some k v)]
kvs
  | Bool
otherwise = (Int
k,Some k v
v)    (Int, Some k v) -> [(Int, Some k v)] -> [(Int, Some k v)]
forall a. a -> [a] -> [a]
: Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
forall k v. Int -> Int -> [(Int, Some k v)] -> [(Int, Some k v)]
fil (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
lim [(Int, Some k v)]
rest

----------------------------------------------------------------

{-|
  Looking up 'StaticHash'.
-}
lookup :: (Eq k, Ord k, Hashable k) => k -> StaticHash k v -> Maybe v
lookup :: k -> StaticHash k v -> Maybe v
lookup k
key (StaticHash Array Int (Some k v)
hs) = case Array Int (Some k v)
hs Array Int (Some k v) -> Int -> Some k v
forall i e. Ix i => Array i e -> i -> e
! Int
i of
    Some k v
None    -> Maybe v
forall a. Maybe a
Nothing
    One k
k v
v
      | k
key k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k  -> v -> Maybe v
forall a. a -> Maybe a
Just v
v
      | Bool
otherwise -> Maybe v
forall a. Maybe a
Nothing
    More Map k v
m  -> k -> Map k v -> Maybe v
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
key Map k v
m
  where
    (Int
_,Int
p') = Array Int (Some k v) -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int (Some k v)
hs
    p :: Int
p = Int
p' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    i :: Int
i = k
key k -> Int -> Int
forall k. Hashable k => k -> Int -> Int
`hashBy` Int
p

----------------------------------------------------------------

hashBy :: Hashable k => k -> Int -> Int
hashBy :: k -> Int -> Int
hashBy k
k Int
p = k -> Int
forall a. Hashable a => a -> Int
hash k
k Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
p