--------------------------------------------------------------------------------
-- | This module implements Indexed KV Graphs,
--   a representation of the KVGraph with a fast
--   succ, pred lookup
--------------------------------------------------------------------------------

{-# LANGUAGE OverloadedStrings #-}

module Language.Fixpoint.Graph.Indexed (
  -- * (Abstract) Indexed Graphs
    IKVGraph (..)

  -- * Constructor
  , edgesIkvg

  -- * Destructor
  , ikvgEdges

  -- * Modify
  , addLinks
  , delNodes

  -- * Lookup
  , getSuccs
  , getPreds
  ) where

import           Language.Fixpoint.Graph.Types
import qualified Data.HashSet              as S
import qualified Data.HashMap.Strict       as M
import qualified Data.List as L
import           Data.Hashable (Hashable)

--------------------------------------------------------------------------------
-- | `IKVGraph` is representation of the KVGraph with a fast succ, pred lookup
--------------------------------------------------------------------------------

data IKVGraph = IKVGraph
  { IKVGraph -> HashMap CVertex (HashSet CVertex)
igSucc :: !(M.HashMap CVertex (S.HashSet CVertex))  -- ^ out-edges of a `CVertex`
  , IKVGraph -> HashMap CVertex (HashSet CVertex)
igPred :: !(M.HashMap CVertex (S.HashSet CVertex))  -- ^ in-edges  of a `CVertex`
  } deriving (Int -> IKVGraph -> ShowS
[IKVGraph] -> ShowS
IKVGraph -> String
(Int -> IKVGraph -> ShowS)
-> (IKVGraph -> String) -> ([IKVGraph] -> ShowS) -> Show IKVGraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IKVGraph] -> ShowS
$cshowList :: [IKVGraph] -> ShowS
show :: IKVGraph -> String
$cshow :: IKVGraph -> String
showsPrec :: Int -> IKVGraph -> ShowS
$cshowsPrec :: Int -> IKVGraph -> ShowS
Show)


addLinks :: IKVGraph -> [CEdge] -> IKVGraph
addLinks :: IKVGraph -> [CEdge] -> IKVGraph
addLinks = (IKVGraph -> CEdge -> IKVGraph) -> IKVGraph -> [CEdge] -> IKVGraph
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' IKVGraph -> CEdge -> IKVGraph
addLink

addLink :: IKVGraph -> CEdge -> IKVGraph
addLink :: IKVGraph -> CEdge -> IKVGraph
addLink IKVGraph
g (CVertex
u, CVertex
v) = CEdge -> IKVGraph -> IKVGraph
addSucc (CVertex
u, CVertex
v) (IKVGraph -> IKVGraph)
-> (IKVGraph -> IKVGraph) -> IKVGraph -> IKVGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CEdge -> IKVGraph -> IKVGraph
addPred (CVertex
u, CVertex
v) (IKVGraph -> IKVGraph) -> IKVGraph -> IKVGraph
forall a b. (a -> b) -> a -> b
$ IKVGraph
g

delNodes :: IKVGraph -> [CVertex] -> IKVGraph
delNodes :: IKVGraph -> [CVertex] -> IKVGraph
delNodes = (IKVGraph -> CVertex -> IKVGraph)
-> IKVGraph -> [CVertex] -> IKVGraph
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' IKVGraph -> CVertex -> IKVGraph
delNode

delNode :: IKVGraph -> CVertex -> IKVGraph
delNode :: IKVGraph -> CVertex -> IKVGraph
delNode IKVGraph
g CVertex
v = CVertex -> IKVGraph -> IKVGraph
delVtx CVertex
v (IKVGraph -> IKVGraph)
-> (IKVGraph -> IKVGraph) -> IKVGraph -> IKVGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CEdge -> IKVGraph -> IKVGraph) -> [CEdge] -> IKVGraph -> IKVGraph
forall a b. (a -> b -> b) -> [a] -> b -> b
txMany CEdge -> IKVGraph -> IKVGraph
delSucc [CEdge]
uvs (IKVGraph -> IKVGraph)
-> (IKVGraph -> IKVGraph) -> IKVGraph -> IKVGraph
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CEdge -> IKVGraph -> IKVGraph) -> [CEdge] -> IKVGraph -> IKVGraph
forall a b. (a -> b -> b) -> [a] -> b -> b
txMany CEdge -> IKVGraph -> IKVGraph
delPred [CEdge]
vws (IKVGraph -> IKVGraph) -> IKVGraph -> IKVGraph
forall a b. (a -> b) -> a -> b
$ IKVGraph
g
  where
    uvs :: [CEdge]
uvs     = [ (CVertex
u, CVertex
v) | CVertex
u <- IKVGraph -> CVertex -> [CVertex]
getPreds IKVGraph
g CVertex
v ]
    vws :: [CEdge]
vws     = [ (CVertex
v, CVertex
w) | CVertex
w <- IKVGraph -> CVertex -> [CVertex]
getSuccs IKVGraph
g CVertex
v ]

edgesIkvg :: [CEdge] -> IKVGraph
edgesIkvg :: [CEdge] -> IKVGraph
edgesIkvg = IKVGraph -> [CEdge] -> IKVGraph
addLinks IKVGraph
empty

ikvgEdges :: IKVGraph -> [CEdge]
ikvgEdges :: IKVGraph -> [CEdge]
ikvgEdges IKVGraph
g = [ (CVertex
u, CVertex
v) | (CVertex
u, HashSet CVertex
vs) <- HashMap CVertex (HashSet CVertex) -> [(CVertex, HashSet CVertex)]
forall k v. HashMap k v -> [(k, v)]
M.toList (IKVGraph -> HashMap CVertex (HashSet CVertex)
igSucc IKVGraph
g), CVertex
v <- HashSet CVertex -> [CVertex]
forall a. HashSet a -> [a]
S.toList HashSet CVertex
vs]

getSuccs :: IKVGraph -> CVertex -> [CVertex]
getSuccs :: IKVGraph -> CVertex -> [CVertex]
getSuccs IKVGraph
g CVertex
u = HashSet CVertex -> [CVertex]
forall a. HashSet a -> [a]
S.toList (HashSet CVertex -> [CVertex]) -> HashSet CVertex -> [CVertex]
forall a b. (a -> b) -> a -> b
$ HashSet CVertex
-> CVertex -> HashMap CVertex (HashSet CVertex) -> HashSet CVertex
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault HashSet CVertex
forall a. HashSet a
S.empty CVertex
u (IKVGraph -> HashMap CVertex (HashSet CVertex)
igSucc IKVGraph
g)

getPreds :: IKVGraph -> CVertex -> [CVertex]
getPreds :: IKVGraph -> CVertex -> [CVertex]
getPreds IKVGraph
g CVertex
v = HashSet CVertex -> [CVertex]
forall a. HashSet a -> [a]
S.toList (HashSet CVertex -> [CVertex]) -> HashSet CVertex -> [CVertex]
forall a b. (a -> b) -> a -> b
$ HashSet CVertex
-> CVertex -> HashMap CVertex (HashSet CVertex) -> HashSet CVertex
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault HashSet CVertex
forall a. HashSet a
S.empty CVertex
v (IKVGraph -> HashMap CVertex (HashSet CVertex)
igPred IKVGraph
g)

--------------------------------------------------------------------------------
empty :: IKVGraph
empty :: IKVGraph
empty = HashMap CVertex (HashSet CVertex)
-> HashMap CVertex (HashSet CVertex) -> IKVGraph
IKVGraph HashMap CVertex (HashSet CVertex)
forall k v. HashMap k v
M.empty HashMap CVertex (HashSet CVertex)
forall k v. HashMap k v
M.empty

txMany :: (a -> b -> b) -> [a] -> b -> b
txMany :: (a -> b -> b) -> [a] -> b -> b
txMany a -> b -> b
op [a]
es b
g = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
op) b
g [a]
es

addSucc :: CEdge -> IKVGraph -> IKVGraph
addSucc :: CEdge -> IKVGraph -> IKVGraph
addSucc (CVertex
u, CVertex
v) IKVGraph
g = IKVGraph
g { igSucc :: HashMap CVertex (HashSet CVertex)
igSucc = CVertex
-> CVertex
-> HashMap CVertex (HashSet CVertex)
-> HashMap CVertex (HashSet CVertex)
forall k v.
(Eq k, Eq v, Hashable k, Hashable v) =>
k -> v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
inserts CVertex
u CVertex
v (IKVGraph -> HashMap CVertex (HashSet CVertex)
igSucc IKVGraph
g) }

addPred :: CEdge -> IKVGraph -> IKVGraph
addPred :: CEdge -> IKVGraph -> IKVGraph
addPred (CVertex
u, CVertex
v) IKVGraph
g = IKVGraph
g { igPred :: HashMap CVertex (HashSet CVertex)
igPred = CVertex
-> CVertex
-> HashMap CVertex (HashSet CVertex)
-> HashMap CVertex (HashSet CVertex)
forall k v.
(Eq k, Eq v, Hashable k, Hashable v) =>
k -> v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
inserts CVertex
v CVertex
u (IKVGraph -> HashMap CVertex (HashSet CVertex)
igPred IKVGraph
g) }

delSucc :: CEdge -> IKVGraph -> IKVGraph
delSucc :: CEdge -> IKVGraph -> IKVGraph
delSucc (CVertex
u, CVertex
v) IKVGraph
g = IKVGraph
g { igSucc :: HashMap CVertex (HashSet CVertex)
igSucc = CVertex
-> CVertex
-> HashMap CVertex (HashSet CVertex)
-> HashMap CVertex (HashSet CVertex)
forall k v.
(Eq k, Eq v, Hashable k, Hashable v) =>
k -> v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
removes CVertex
u CVertex
v (IKVGraph -> HashMap CVertex (HashSet CVertex)
igSucc IKVGraph
g)}

delPred :: (CVertex, CVertex) -> IKVGraph -> IKVGraph
delPred :: CEdge -> IKVGraph -> IKVGraph
delPred (CVertex
u, CVertex
v) IKVGraph
g = IKVGraph
g { igPred :: HashMap CVertex (HashSet CVertex)
igPred = CVertex
-> CVertex
-> HashMap CVertex (HashSet CVertex)
-> HashMap CVertex (HashSet CVertex)
forall k v.
(Eq k, Eq v, Hashable k, Hashable v) =>
k -> v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
removes CVertex
v CVertex
u (IKVGraph -> HashMap CVertex (HashSet CVertex)
igPred IKVGraph
g)}

delVtx :: CVertex -> IKVGraph -> IKVGraph
delVtx :: CVertex -> IKVGraph -> IKVGraph
delVtx CVertex
v IKVGraph
g = IKVGraph
g { igSucc :: HashMap CVertex (HashSet CVertex)
igSucc = CVertex
-> HashMap CVertex (HashSet CVertex)
-> HashMap CVertex (HashSet CVertex)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete CVertex
v (IKVGraph -> HashMap CVertex (HashSet CVertex)
igSucc IKVGraph
g) }
               { igPred :: HashMap CVertex (HashSet CVertex)
igPred = CVertex
-> HashMap CVertex (HashSet CVertex)
-> HashMap CVertex (HashSet CVertex)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete CVertex
v (IKVGraph -> HashMap CVertex (HashSet CVertex)
igPred IKVGraph
g) }

inserts :: (Eq k, Eq v, Hashable k, Hashable v)
        => k -> v -> M.HashMap k (S.HashSet v) -> M.HashMap k (S.HashSet v)
inserts :: k -> v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
inserts k
k v
v HashMap k (HashSet v)
m = k -> HashSet v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert k
k (v -> HashSet v -> HashSet v
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
S.insert v
v (HashSet v -> HashSet v) -> HashSet v -> HashSet v
forall a b. (a -> b) -> a -> b
$ HashSet v -> k -> HashMap k (HashSet v) -> HashSet v
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault HashSet v
forall a. HashSet a
S.empty k
k HashMap k (HashSet v)
m) HashMap k (HashSet v)
m

removes :: (Eq k, Eq v, Hashable k, Hashable v)
        => k -> v -> M.HashMap k (S.HashSet v) -> M.HashMap k (S.HashSet v)
removes :: k -> v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
removes k
k v
v HashMap k (HashSet v)
m = k -> HashSet v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert k
k (v -> HashSet v -> HashSet v
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
S.delete v
v (HashSet v -> k -> HashMap k (HashSet v) -> HashSet v
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
M.lookupDefault HashSet v
forall a. HashSet a
S.empty k
k HashMap k (HashSet v)
m)) HashMap k (HashSet v)
m