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

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