-- |
-- Utilities for HashMap.
module OpcXmlDaClient.Base.HashMap where

import qualified Data.HashMap.Strict as HashMap
import OpcXmlDaClient.Base.Prelude

-- |
-- Build a hash map from keys to autoincremented ids using a projection function from int.
--
-- The ids are generated by incrementing a counter starting from 0.
autoincrementedFoldable :: (Foldable f, Hashable k, Eq k) => f k -> (Int -> v) -> HashMap.HashMap k v
autoincrementedFoldable :: f k -> (Int -> v) -> HashMap k v
autoincrementedFoldable f k
foldable Int -> v
projValue =
  (k
 -> (HashMap k v -> Int -> HashMap k v)
 -> HashMap k v
 -> Int
 -> HashMap k v)
-> (HashMap k v -> Int -> HashMap k v)
-> f k
-> HashMap k v
-> Int
-> HashMap k v
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    ( \k
k HashMap k v -> Int -> HashMap k v
next !HashMap k v
map !Int
counter ->
        (Maybe v -> (Int, Maybe v))
-> k -> HashMap k v -> (Int, HashMap k v)
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HashMap.alterF
          ( (Int, Maybe v)
-> (v -> (Int, Maybe v)) -> Maybe v -> (Int, Maybe v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
              (Int -> Int
forall a. Enum a => a -> a
succ Int
counter, v -> Maybe v
forall a. a -> Maybe a
Just (Int -> v
projValue Int
counter))
              (\v
value -> (Int
counter, v -> Maybe v
forall a. a -> Maybe a
Just v
value))
          )
          k
k
          HashMap k v
map
          (Int, HashMap k v)
-> ((Int, HashMap k v) -> HashMap k v) -> HashMap k v
forall a b. a -> (a -> b) -> b
& \(Int
newCounter, HashMap k v
newMap) -> HashMap k v -> Int -> HashMap k v
next HashMap k v
newMap Int
newCounter
    )
    (\HashMap k v
map Int
_ -> HashMap k v
map)
    f k
foldable
    HashMap k v
forall k v. HashMap k v
HashMap.empty
    Int
0