-- |
-- Module      : Test.Speculate.Utils.Digraph
-- Copyright   : (c) 2016 Colin Runciman
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
module Test.Speculate.Utils.Digraph
  ( Digraph
  , empty
  , succs
  , preds
  , filter
  , discard
  , isNode
  , isEdge
  , fromEdges
  , narrow
  )
where

import Prelude hiding (filter)
import qualified Data.List as L
import Data.Maybe (fromMaybe,isJust)
import Test.Speculate.Utils (collectSndByFst)

type Digraph a = [(a,[a])]

empty :: Digraph a
empty :: Digraph a
empty = []

succs :: Eq a => a -> Digraph a -> [a]
succs :: a -> Digraph a -> [a]
succs a
x = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [a] -> [a]) -> (Digraph a -> Maybe [a]) -> Digraph a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Digraph a -> Maybe [a]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x

preds :: Eq a => a -> Digraph a -> [a]
preds :: a -> Digraph a -> [a]
preds a
x Digraph a
yyss = [a
y | (a
y,[a]
ys) <- Digraph a
yyss, a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
ys]

isNode :: Eq a => a -> Digraph a -> Bool
isNode :: a -> Digraph a -> Bool
isNode a
x = Maybe [a] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [a] -> Bool)
-> (Digraph a -> Maybe [a]) -> Digraph a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Digraph a -> Maybe [a]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
x

isEdge :: Eq a => a -> a -> Digraph a -> Bool
isEdge :: a -> a -> Digraph a -> Bool
isEdge a
x a
y Digraph a
d = a
y a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` a -> Digraph a -> [a]
forall a. Eq a => a -> Digraph a -> [a]
succs a
x Digraph a
d

filter :: Eq a => (a -> Bool) -> Digraph a -> Digraph a
filter :: (a -> Bool) -> Digraph a -> Digraph a
filter a -> Bool
p Digraph a
xxss = [(a
x,(a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter a -> Bool
p [a]
xs) | (a
x,[a]
xs) <- Digraph a
xxss, a -> Bool
p a
x]

discard :: Eq a => (a -> Bool) -> Digraph a -> Digraph a
discard :: (a -> Bool) -> Digraph a -> Digraph a
discard a -> Bool
p = (a -> Bool) -> Digraph a -> Digraph a
forall a. Eq a => (a -> Bool) -> Digraph a -> Digraph a
filter (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

subgraph :: Eq a => [a] -> Digraph a -> Digraph a
subgraph :: [a] -> Digraph a -> Digraph a
subgraph [a]
xs = (a -> Bool) -> Digraph a -> Digraph a
forall a. Eq a => (a -> Bool) -> Digraph a -> Digraph a
filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs)

invsubgraph :: Eq a => [a] -> Digraph a -> Digraph a
invsubgraph :: [a] -> Digraph a -> Digraph a
invsubgraph [a]
xs = (a -> Bool) -> Digraph a -> Digraph a
forall a. Eq a => (a -> Bool) -> Digraph a -> Digraph a
discard (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
xs)

fromEdges :: Ord a => [(a,a)] -> Digraph a
fromEdges :: [(a, a)] -> Digraph a
fromEdges = [(a, a)] -> Digraph a
forall a b. Ord a => [(a, b)] -> [(a, [b])]
collectSndByFst

-- | pick a node in a Digraph
pick :: Eq a => Digraph a -> Maybe a
pick :: Digraph a -> Maybe a
pick []            = Maybe a
forall a. Maybe a
Nothing
pick ((a
x,[a]
xs):Digraph a
xxss) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

narrow :: Eq a => (a -> Bool) -> Digraph a -> [a]
narrow :: (a -> Bool) -> Digraph a -> [a]
narrow a -> Bool
p Digraph a
d =
  case Digraph a -> Maybe a
forall a. Eq a => Digraph a -> Maybe a
pick Digraph a
d of
    Maybe a
Nothing -> []
    Just a
n
      | a -> Bool
p a
n -> case (a -> Bool) -> Digraph a -> [a]
forall a. Eq a => (a -> Bool) -> Digraph a -> [a]
narrow a -> Bool
p ([a] -> Digraph a -> Digraph a
forall a. Eq a => [a] -> Digraph a -> Digraph a
subgraph (a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
L.delete a
n ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a -> Digraph a -> [a]
forall a. Eq a => a -> Digraph a -> [a]
succs a
n Digraph a
d) Digraph a
d) of
                 [] -> a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> Bool) -> Digraph a -> [a]
forall a. Eq a => (a -> Bool) -> Digraph a -> [a]
narrow a -> Bool
p ([a] -> Digraph a -> Digraph a
forall a. Eq a => [a] -> Digraph a -> Digraph a
invsubgraph (a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> Digraph a -> [a]
forall a. Eq a => a -> Digraph a -> [a]
succs a
n Digraph a
d [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a -> Digraph a -> [a]
forall a. Eq a => a -> Digraph a -> [a]
preds a
n Digraph a
d) Digraph a
d)
                 [a]
xs -> [a]
xs
      | Bool
otherwise -> (a -> Bool) -> Digraph a -> [a]
forall a. Eq a => (a -> Bool) -> Digraph a -> [a]
narrow a -> Bool
p ([a] -> Digraph a -> Digraph a
forall a. Eq a => [a] -> Digraph a -> Digraph a
invsubgraph (a
na -> [a] -> [a]
forall a. a -> [a] -> [a]
:a -> Digraph a -> [a]
forall a. Eq a => a -> Digraph a -> [a]
succs a
n Digraph a
d) Digraph a
d)