{-# 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
(IntLikeEquiv k v -> IntLikeEquiv k v -> Bool)
-> (IntLikeEquiv k v -> IntLikeEquiv k v -> Bool)
-> Eq (IntLikeEquiv k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. Eq k => 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
/= :: IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
Eq, Eq (IntLikeEquiv k v)
Eq (IntLikeEquiv k v) =>
(IntLikeEquiv k v -> IntLikeEquiv k v -> Ordering)
-> (IntLikeEquiv k v -> IntLikeEquiv k v -> Bool)
-> (IntLikeEquiv k v -> IntLikeEquiv k v -> Bool)
-> (IntLikeEquiv k v -> IntLikeEquiv k v -> Bool)
-> (IntLikeEquiv k v -> IntLikeEquiv k v -> Bool)
-> (IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v)
-> (IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v)
-> Ord (IntLikeEquiv k v)
IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
IntLikeEquiv k v -> IntLikeEquiv k v -> Ordering
IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k v. Ord k => Eq (IntLikeEquiv k v)
forall k v. Ord k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
forall k v.
Ord k =>
IntLikeEquiv k v -> IntLikeEquiv k v -> Ordering
forall k v.
Ord k =>
IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v
$ccompare :: forall k v.
Ord k =>
IntLikeEquiv k v -> IntLikeEquiv k v -> Ordering
compare :: IntLikeEquiv k v -> IntLikeEquiv k v -> Ordering
$c< :: forall k v. Ord k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
< :: IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
$c<= :: forall k v. Ord k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
<= :: IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
$c> :: forall k v. Ord k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
> :: IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
$c>= :: forall k v. Ord k => IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
>= :: IntLikeEquiv k v -> IntLikeEquiv k v -> Bool
$cmax :: forall k v.
Ord k =>
IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v
max :: IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v
$cmin :: forall k v.
Ord k =>
IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v
min :: IntLikeEquiv k v -> IntLikeEquiv k v -> IntLikeEquiv k v
Ord, Int -> IntLikeEquiv k v -> ShowS
[IntLikeEquiv k v] -> ShowS
IntLikeEquiv k v -> String
(Int -> IntLikeEquiv k v -> ShowS)
-> (IntLikeEquiv k v -> String)
-> ([IntLikeEquiv k v] -> ShowS)
-> Show (IntLikeEquiv k v)
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
$cshowsPrec :: forall k v. Show k => Int -> IntLikeEquiv k v -> ShowS
showsPrec :: Int -> IntLikeEquiv k v -> ShowS
$cshow :: forall k v. Show k => IntLikeEquiv k v -> String
show :: IntLikeEquiv k v -> String
$cshowList :: forall k v. Show k => [IntLikeEquiv k v] -> ShowS
showList :: [IntLikeEquiv k v] -> ShowS
Show, (forall x. IntLikeEquiv k v -> Rep (IntLikeEquiv k v) x)
-> (forall x. Rep (IntLikeEquiv k v) x -> IntLikeEquiv k v)
-> Generic (IntLikeEquiv k v)
forall x. Rep (IntLikeEquiv k v) x -> IntLikeEquiv k v
forall x. IntLikeEquiv k v -> Rep (IntLikeEquiv k v) x
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
$cfrom :: forall k v x. IntLikeEquiv k v -> Rep (IntLikeEquiv k v) x
from :: forall x. IntLikeEquiv k v -> Rep (IntLikeEquiv k v) x
$cto :: forall k v x. Rep (IntLikeEquiv k v) x -> IntLikeEquiv k v
to :: forall x. Rep (IntLikeEquiv k v) x -> IntLikeEquiv k v
Generic)
  deriving anyclass (IntLikeEquiv k v -> ()
(IntLikeEquiv k v -> ()) -> NFData (IntLikeEquiv k v)
forall a. (a -> ()) -> NFData a
forall k v. NFData k => IntLikeEquiv k v -> ()
$crnf :: forall k v. NFData k => IntLikeEquiv k v -> ()
rnf :: IntLikeEquiv k v -> ()
NFData)

empty :: IntLikeEquiv k v
empty :: forall k v. IntLikeEquiv k v
empty = IntLikeMultiMap k v -> IntLikeMap v k -> IntLikeEquiv k v
forall k v.
IntLikeMultiMap k v -> IntLikeMap v k -> IntLikeEquiv k v
IntLikeEquiv IntLikeMultiMap k v
forall k v. IntLikeMultiMap k v
ILMM.empty IntLikeMap v k
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 v -> IntLikeMap v k -> Maybe k
forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup v
v IntLikeMap v k
bwd of
    Maybe k
Nothing -> IntLikeEquiv k v -> Either k (IntLikeEquiv k v)
forall a b. b -> Either a b
Right (IntLikeMultiMap k v -> IntLikeMap v k -> IntLikeEquiv k v
forall k v.
IntLikeMultiMap k v -> IntLikeMap v k -> IntLikeEquiv k v
IntLikeEquiv (k -> v -> IntLikeMultiMap k v -> IntLikeMultiMap k v
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) (v -> k -> IntLikeMap v k -> IntLikeMap v k
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' -> k -> Either k (IntLikeEquiv k v)
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 = IntLikeEquiv k v -> Either k (IntLikeEquiv k v) -> IntLikeEquiv k v
forall b a. b -> Either a b -> b
fromRight (String -> IntLikeEquiv k v
forall a. HasCallStack => String -> a
error String
"duplicate insert into equiv") (Either k (IntLikeEquiv k v) -> IntLikeEquiv k v)
-> (IntLikeEquiv k v -> Either k (IntLikeEquiv k v))
-> IntLikeEquiv k v
-> IntLikeEquiv k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> v -> IntLikeEquiv k v -> Either k (IntLikeEquiv k v)
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 = k -> Maybe k
forall a. a -> Maybe a
Just k
k Maybe k -> Maybe k -> Bool
forall a. Eq a => a -> a -> Bool
== v -> IntLikeEquiv k v -> Maybe k
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 = v -> IntLikeMap v k -> Maybe k
forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup v
v (IntLikeMap v k -> Maybe k)
-> (IntLikeEquiv k v -> IntLikeMap v k)
-> IntLikeEquiv k v
-> Maybe k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntLikeEquiv k v -> IntLikeMap v k
forall k v. IntLikeEquiv k v -> IntLikeMap v k
bwdView