module XmlParser.TupleHashMap
  ( TupleHashMap,
    KeyConstraints,
    empty,
    insertSemigroup,
    alterF,
    toList,
  )
where

import qualified Data.HashMap.Strict as HashMap
import XmlParser.Prelude hiding (empty, fromList, toList)

newtype TupleHashMap k1 k2 v = TupleHashMap (HashMap k1 (HashMap k2 v))

-- |
-- Serves to reduce noise in signatures.
type KeyConstraints k1 k2 = (Eq k1, Hashable k1, Eq k2, Hashable k2)

empty :: TupleHashMap k1 k2 v
empty :: TupleHashMap k1 k2 v
empty =
  HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v
forall k1 k2 v. HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v
TupleHashMap HashMap k1 (HashMap k2 v)
forall k v. HashMap k v
HashMap.empty

insertSemigroup :: (Semigroup v, KeyConstraints k1 k2) => k1 -> k2 -> v -> TupleHashMap k1 k2 v -> TupleHashMap k1 k2 v
insertSemigroup :: k1 -> k2 -> v -> TupleHashMap k1 k2 v -> TupleHashMap k1 k2 v
insertSemigroup k1
k1 k2
k2 v
v (TupleHashMap HashMap k1 (HashMap k2 v)
map1) =
  (Maybe (HashMap k2 v) -> Maybe (HashMap k2 v))
-> k1 -> HashMap k1 (HashMap k2 v) -> HashMap k1 (HashMap k2 v)
forall k v.
(Eq k, Hashable k) =>
(Maybe v -> Maybe v) -> k -> HashMap k v -> HashMap k v
HashMap.alter
    ( Maybe (HashMap k2 v)
-> (HashMap k2 v -> Maybe (HashMap k2 v))
-> Maybe (HashMap k2 v)
-> Maybe (HashMap k2 v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (HashMap k2 v -> Maybe (HashMap k2 v)
forall a. a -> Maybe a
Just (k2 -> v -> HashMap k2 v
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton k2
k2 v
v))
        (HashMap k2 v -> Maybe (HashMap k2 v)
forall a. a -> Maybe a
Just (HashMap k2 v -> Maybe (HashMap k2 v))
-> (HashMap k2 v -> HashMap k2 v)
-> HashMap k2 v
-> Maybe (HashMap k2 v)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (v -> v -> v) -> k2 -> v -> HashMap k2 v -> HashMap k2 v
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith v -> v -> v
forall a. Semigroup a => a -> a -> a
(<>) k2
k2 v
v)
    )
    k1
k1
    HashMap k1 (HashMap k2 v)
map1
    HashMap k1 (HashMap k2 v)
-> (HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v)
-> TupleHashMap k1 k2 v
forall a b. a -> (a -> b) -> b
& HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v
forall k1 k2 v. HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v
TupleHashMap

alterF :: (Functor f, KeyConstraints k1 k2) => (Maybe v -> f (Maybe v)) -> k1 -> k2 -> TupleHashMap k1 k2 v -> f (TupleHashMap k1 k2 v)
alterF :: (Maybe v -> f (Maybe v))
-> k1 -> k2 -> TupleHashMap k1 k2 v -> f (TupleHashMap k1 k2 v)
alterF Maybe v -> f (Maybe v)
fn k1
k1 k2
k2 (TupleHashMap HashMap k1 (HashMap k2 v)
map1) =
  (Maybe (HashMap k2 v) -> f (Maybe (HashMap k2 v)))
-> k1 -> HashMap k1 (HashMap k2 v) -> f (HashMap k1 (HashMap k2 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
    ( \case
        Just HashMap k2 v
map2 ->
          (Maybe v -> f (Maybe v)) -> k2 -> HashMap k2 v -> f (HashMap k2 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 Maybe v -> f (Maybe v)
fn k2
k2 HashMap k2 v
map2
            f (HashMap k2 v)
-> (f (HashMap k2 v) -> f (Maybe (HashMap k2 v)))
-> f (Maybe (HashMap k2 v))
forall a b. a -> (a -> b) -> b
& (HashMap k2 v -> Maybe (HashMap k2 v))
-> f (HashMap k2 v) -> f (Maybe (HashMap k2 v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\HashMap k2 v
map2 -> if HashMap k2 v -> Bool
forall k v. HashMap k v -> Bool
HashMap.null HashMap k2 v
map2 then Maybe (HashMap k2 v)
forall a. Maybe a
Nothing else HashMap k2 v -> Maybe (HashMap k2 v)
forall a. a -> Maybe a
Just HashMap k2 v
map2)
        Maybe (HashMap k2 v)
Nothing ->
          Maybe v -> f (Maybe v)
fn Maybe v
forall a. Maybe a
Nothing
            f (Maybe v)
-> (f (Maybe v) -> f (Maybe (HashMap k2 v)))
-> f (Maybe (HashMap k2 v))
forall a b. a -> (a -> b) -> b
& ((Maybe v -> Maybe (HashMap k2 v))
-> f (Maybe v) -> f (Maybe (HashMap k2 v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe v -> Maybe (HashMap k2 v))
 -> f (Maybe v) -> f (Maybe (HashMap k2 v)))
-> ((v -> HashMap k2 v) -> Maybe v -> Maybe (HashMap k2 v))
-> (v -> HashMap k2 v)
-> f (Maybe v)
-> f (Maybe (HashMap k2 v))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (v -> HashMap k2 v) -> Maybe v -> Maybe (HashMap k2 v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (k2 -> v -> HashMap k2 v
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton k2
k2)
    )
    k1
k1
    HashMap k1 (HashMap k2 v)
map1
    f (HashMap k1 (HashMap k2 v))
-> (f (HashMap k1 (HashMap k2 v)) -> f (TupleHashMap k1 k2 v))
-> f (TupleHashMap k1 k2 v)
forall a b. a -> (a -> b) -> b
& (HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v)
-> f (HashMap k1 (HashMap k2 v)) -> f (TupleHashMap k1 k2 v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v
forall k1 k2 v. HashMap k1 (HashMap k2 v) -> TupleHashMap k1 k2 v
TupleHashMap

toList :: TupleHashMap k1 k2 b -> [(k1, k2, b)]
toList :: TupleHashMap k1 k2 b -> [(k1, k2, b)]
toList (TupleHashMap HashMap k1 (HashMap k2 b)
map1) =
  do
    (k1
k1, HashMap k2 b
map2) <- HashMap k1 (HashMap k2 b) -> [(k1, HashMap k2 b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k1 (HashMap k2 b)
map1
    (k2
k2, b
v) <- HashMap k2 b -> [(k2, b)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap k2 b
map2
    (k1, k2, b) -> [(k1, k2, b)]
forall (m :: * -> *) a. Monad m => a -> m a
return (k1
k1, k2
k2, b
v)