{-# LANGUAGE DeriveAnyClass #-}

module IntLike.Equiv
  ( IntLikeEquiv
  , fwdView
  , bwdView
  , empty
  , insert
  , partialInsert
  , member
  , lookupClass
  ) where

import Control.DeepSeq (NFData)
import Data.Coerce (Coercible)
import Data.Either (fromRight)
import GHC.Generics (Generic)
import IntLike.Map (IntLikeMap)
import qualified IntLike.Map as ILM
import IntLike.MultiMap (IntLikeMultiMap)
import qualified IntLike.MultiMap as ILMM

data IntLikeEquiv k v = IntLikeEquiv
  { forall k v. IntLikeEquiv k v -> IntLikeMultiMap k v
fwdView :: !(IntLikeMultiMap k v)
  , forall k v. IntLikeEquiv k v -> IntLikeMap v k
bwdView :: !(IntLikeMap v k)
  } deriving stock (IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. Eq k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
/= :: IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
$c/= :: forall k v. Eq k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
== :: IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
$c== :: forall k v. Eq k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
Eq, Int -> IntLikeEquiv k v -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. Show k => Int -> IntLikeEquiv k v -> ShowS
forall k v. Show k => [IntLikeEquiv k v] -> ShowS
forall k v. Show k => IntLikeEquiv k v -> String
showList :: [IntLikeEquiv k v] -> ShowS
$cshowList :: forall k v. Show k => [IntLikeEquiv k v] -> ShowS
show :: IntLikeEquiv k v -> String
$cshow :: forall k v. Show k => IntLikeEquiv k v -> String
showsPrec :: Int -> IntLikeEquiv k v -> ShowS
$cshowsPrec :: forall k v. Show k => Int -> IntLikeEquiv k v -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k v x. Rep (IntLikeEquiv k v) x -> IntLikeEquiv k v
forall k v x. IntLikeEquiv k v -> Rep (IntLikeEquiv k v) x
$cto :: forall k v x. Rep (IntLikeEquiv k v) x -> IntLikeEquiv k v
$cfrom :: forall k v x. IntLikeEquiv k v -> Rep (IntLikeEquiv k v) x
Generic)
    deriving anyclass (forall a. (a -> ()) -> NFData a
forall k v. NFData k => IntLikeEquiv k v -> ()
rnf :: IntLikeEquiv k v -> ()
$crnf :: forall k v. NFData k => IntLikeEquiv k v -> ()
NFData)

empty :: IntLikeEquiv k v
empty :: forall k v. IntLikeEquiv k v
empty = forall k v.
IntLikeMultiMap k v -> IntLikeMap v k -> IntLikeEquiv k v
IntLikeEquiv forall k v. IntLikeMultiMap k v
ILMM.empty forall x a. IntLikeMap x a
ILM.empty
{-# INLINE empty #-}

insert :: (Coercible k Int, Coercible v Int) => k -> v -> IntLikeEquiv k v -> Either k (IntLikeEquiv k v)
insert :: forall k v.
(Coercible k Int, Coercible v Int) =>
k -> v -> IntLikeEquiv k v -> Either k (IntLikeEquiv k v)
insert k
k v
v (IntLikeEquiv IntLikeMultiMap k v
fwd IntLikeMap v k
bwd) =
  case forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup v
v IntLikeMap v k
bwd of
    Maybe k
Nothing -> forall a b. b -> Either a b
Right (forall k v.
IntLikeMultiMap k v -> IntLikeMap v k -> IntLikeEquiv k v
IntLikeEquiv (forall k v.
(Coercible k Int, Coercible v Int) =>
k -> v -> IntLikeMultiMap k v -> IntLikeMultiMap k v
ILMM.insert k
k v
v IntLikeMultiMap k v
fwd) (forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert v
v k
k IntLikeMap v k
bwd))
    Just k
k' -> forall a b. a -> Either a b
Left k
k'

partialInsert :: (Coercible k Int, Coercible v Int) => k -> v -> IntLikeEquiv k v -> IntLikeEquiv k v
partialInsert :: forall k v.
(Coercible k Int, Coercible v Int) =>
k -> v -> IntLikeEquiv k v -> IntLikeEquiv k v
partialInsert k
k v
v = forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => String -> a
error String
"duplicate insert into equiv") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Coercible k Int, Coercible v Int) =>
k -> v -> IntLikeEquiv k v -> Either k (IntLikeEquiv k v)
insert k
k v
v

member :: (Eq k, Coercible v Int) => k -> v -> IntLikeEquiv k v -> Bool
member :: forall k v.
(Eq k, Coercible v Int) =>
k -> v -> IntLikeEquiv k v -> Bool
member k
k v
v IntLikeEquiv k v
m = forall a. a -> Maybe a
Just k
k forall a. Eq a => a -> a -> Bool
== forall v k. Coercible v Int => v -> IntLikeEquiv k v -> Maybe k
lookupClass v
v IntLikeEquiv k v
m

lookupClass :: (Coercible v Int) => v -> IntLikeEquiv k v -> Maybe k
lookupClass :: forall v k. Coercible v Int => v -> IntLikeEquiv k v -> Maybe k
lookupClass v
v = forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup v
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. IntLikeEquiv k v -> IntLikeMap v k
bwdView