-- |
-- Module      : ZuulWeeder.Graph
-- Description : Configuration graph
-- Copyright   : (c) Red Hat, 2022
-- License     : Apache-2.0
--
-- Maintainer  : tdecacqu@redhat.com, fboucher@redhat.com
-- Stability   : provisional
-- Portability : portable
--
-- This module contains the core configuration graph.
-- The config analysis results looks like this:
-- ![demo-graph](doc/demo-graph.svg)
module ZuulWeeder.Graph
  ( ConfigGraph,
    Analysis (..),
    Vertex (..),
    VertexName (..),
    analyzeConfig,
    findReachable,
    findReachableForest,
  )
where

import Algebra.Graph qualified
import Algebra.Graph.ToGraph qualified
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
import Data.Set qualified as Set
import Zuul.Config
import Zuul.ConfigLoader (Config (..), ConfigMap)
import Zuul.Tenant
import ZuulWeeder.Prelude

-- | The graph vertex
data Vertex = Vertex
  { -- | The vertex identifier
    Vertex -> VertexName
name :: VertexName,
    -- | The list of tenants using that vertex
    Vertex -> Set TenantName
tenants :: Set TenantName
  }
  deriving (Vertex -> Vertex -> Bool
(Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool) -> Eq Vertex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vertex -> Vertex -> Bool
$c/= :: Vertex -> Vertex -> Bool
== :: Vertex -> Vertex -> Bool
$c== :: Vertex -> Vertex -> Bool
Eq, Eq Vertex
Eq Vertex
-> (Vertex -> Vertex -> Ordering)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Bool)
-> (Vertex -> Vertex -> Vertex)
-> (Vertex -> Vertex -> Vertex)
-> Ord Vertex
Vertex -> Vertex -> Bool
Vertex -> Vertex -> Ordering
Vertex -> Vertex -> Vertex
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
min :: Vertex -> Vertex -> Vertex
$cmin :: Vertex -> Vertex -> Vertex
max :: Vertex -> Vertex -> Vertex
$cmax :: Vertex -> Vertex -> Vertex
>= :: Vertex -> Vertex -> Bool
$c>= :: Vertex -> Vertex -> Bool
> :: Vertex -> Vertex -> Bool
$c> :: Vertex -> Vertex -> Bool
<= :: Vertex -> Vertex -> Bool
$c<= :: Vertex -> Vertex -> Bool
< :: Vertex -> Vertex -> Bool
$c< :: Vertex -> Vertex -> Bool
compare :: Vertex -> Vertex -> Ordering
$ccompare :: Vertex -> Vertex -> Ordering
Ord, Int -> Vertex -> ShowS
[Vertex] -> ShowS
Vertex -> String
(Int -> Vertex -> ShowS)
-> (Vertex -> String) -> ([Vertex] -> ShowS) -> Show Vertex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vertex] -> ShowS
$cshowList :: [Vertex] -> ShowS
show :: Vertex -> String
$cshow :: Vertex -> String
showsPrec :: Int -> Vertex -> ShowS
$cshowsPrec :: Int -> Vertex -> ShowS
Show, (forall x. Vertex -> Rep Vertex x)
-> (forall x. Rep Vertex x -> Vertex) -> Generic Vertex
forall x. Rep Vertex x -> Vertex
forall x. Vertex -> Rep Vertex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Vertex x -> Vertex
$cfrom :: forall x. Vertex -> Rep Vertex x
Generic, Eq Vertex
Eq Vertex
-> (Int -> Vertex -> Int) -> (Vertex -> Int) -> Hashable Vertex
Int -> Vertex -> Int
Vertex -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Vertex -> Int
$chash :: Vertex -> Int
hashWithSalt :: Int -> Vertex -> Int
$chashWithSalt :: Int -> Vertex -> Int
Hashable)

-- WARNING: when adding new VertexName, you need to update the FromHttpApiData VertexTypeUrl instance in the UI module.

-- | A Vertex can be a raw zuul config element, or a custom element added through analysis
data VertexName
  = -- | An abstract job
    VAbstractJob JobName
  | -- | A job
    VJob JobName
  | -- | A secret
    VSecret SecretName
  | -- | A semaphore
    VSemaphore SemaphoreName
  | -- | A nodeset
    VNodeset NodesetName
  | -- | A node label
    VNodeLabel NodeLabelName
  | -- | A queue
    VQueue QueueName
  | -- | A project
    VProject CanonicalProjectName
  | -- | A project regex
    VProjectRegex ProjectRegex
  | -- | A project template
    VProjectTemplate ProjectTemplateName
  | -- | A pipeline
    VPipeline PipelineName
  | -- | A project pipeline config
    VProjectPipeline PipelineName CanonicalProjectName
  | -- | A project regex config
    VRegexPipeline PipelineName ProjectRegex
  | -- | A template pipeline config
    VTemplatePipeline PipelineName ProjectTemplateName
  | -- | A pipeline trigger
    VTrigger ConnectionName
  | -- | A pipeline reporter
    VReporter ConnectionName
  deriving (VertexName -> VertexName -> Bool
(VertexName -> VertexName -> Bool)
-> (VertexName -> VertexName -> Bool) -> Eq VertexName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VertexName -> VertexName -> Bool
$c/= :: VertexName -> VertexName -> Bool
== :: VertexName -> VertexName -> Bool
$c== :: VertexName -> VertexName -> Bool
Eq, Eq VertexName
Eq VertexName
-> (VertexName -> VertexName -> Ordering)
-> (VertexName -> VertexName -> Bool)
-> (VertexName -> VertexName -> Bool)
-> (VertexName -> VertexName -> Bool)
-> (VertexName -> VertexName -> Bool)
-> (VertexName -> VertexName -> VertexName)
-> (VertexName -> VertexName -> VertexName)
-> Ord VertexName
VertexName -> VertexName -> Bool
VertexName -> VertexName -> Ordering
VertexName -> VertexName -> VertexName
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
min :: VertexName -> VertexName -> VertexName
$cmin :: VertexName -> VertexName -> VertexName
max :: VertexName -> VertexName -> VertexName
$cmax :: VertexName -> VertexName -> VertexName
>= :: VertexName -> VertexName -> Bool
$c>= :: VertexName -> VertexName -> Bool
> :: VertexName -> VertexName -> Bool
$c> :: VertexName -> VertexName -> Bool
<= :: VertexName -> VertexName -> Bool
$c<= :: VertexName -> VertexName -> Bool
< :: VertexName -> VertexName -> Bool
$c< :: VertexName -> VertexName -> Bool
compare :: VertexName -> VertexName -> Ordering
$ccompare :: VertexName -> VertexName -> Ordering
Ord, Int -> VertexName -> ShowS
[VertexName] -> ShowS
VertexName -> String
(Int -> VertexName -> ShowS)
-> (VertexName -> String)
-> ([VertexName] -> ShowS)
-> Show VertexName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertexName] -> ShowS
$cshowList :: [VertexName] -> ShowS
show :: VertexName -> String
$cshow :: VertexName -> String
showsPrec :: Int -> VertexName -> ShowS
$cshowsPrec :: Int -> VertexName -> ShowS
Show, (forall x. VertexName -> Rep VertexName x)
-> (forall x. Rep VertexName x -> VertexName) -> Generic VertexName
forall x. Rep VertexName x -> VertexName
forall x. VertexName -> Rep VertexName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VertexName x -> VertexName
$cfrom :: forall x. VertexName -> Rep VertexName x
Generic, Eq VertexName
Eq VertexName
-> (Int -> VertexName -> Int)
-> (VertexName -> Int)
-> Hashable VertexName
Int -> VertexName -> Int
VertexName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: VertexName -> Int
$chash :: VertexName -> Int
hashWithSalt :: Int -> VertexName -> Int
$chashWithSalt :: Int -> VertexName -> Int
Hashable)

instance From VertexName Text where
  from :: VertexName -> Text
from = \case
    VAbstractJob (JobName Text
n) -> Text
n
    VJob (JobName Text
n) -> Text
n
    VSecret (SecretName Text
n) -> Text
n
    VSemaphore (SemaphoreName Text
n) -> Text
n
    VNodeset (NodesetName Text
n) -> Text
n
    VNodeLabel (NodeLabelName Text
n) -> Text
n
    VQueue (QueueName Text
n) -> Text
n
    VProject (CanonicalProjectName (ProviderName Text
p) (ProjectName Text
n)) -> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    VProjectRegex (ProjectRegex Text
n) -> Text
n
    VProjectTemplate (ProjectTemplateName Text
n) -> Text
n
    VPipeline (PipelineName Text
n) -> Text
n
    VRegexPipeline (PipelineName Text
v) (ProjectRegex Text
n) -> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    VProjectPipeline (PipelineName Text
v) CanonicalProjectName
cp -> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CanonicalProjectName -> Text
forall source target. From source target => source -> target
from CanonicalProjectName
cp
    VTemplatePipeline (PipelineName Text
v) (ProjectTemplateName Text
n) -> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
    VTrigger (ConnectionName Text
n) -> Text
n
    VReporter (ConnectionName Text
n) -> Text
n

instance From Job VertexName where
  from :: Job -> VertexName
from Job
job
    | Job
job.abstract Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True = JobName -> VertexName
VAbstractJob Job
job.name
    | Bool
otherwise = JobName -> VertexName
VJob Job
job.name

instance From CanonicalProjectName VertexName where
  from :: CanonicalProjectName -> VertexName
from = CanonicalProjectName -> VertexName
VProject

instance From SecretName VertexName where
  from :: SecretName -> VertexName
from = SecretName -> VertexName
VSecret

instance From ProjectRegex VertexName where
  from :: ProjectRegex -> VertexName
from = ProjectRegex -> VertexName
VProjectRegex

instance From SemaphoreName VertexName where
  from :: SemaphoreName -> VertexName
from = SemaphoreName -> VertexName
VSemaphore

instance From QueueName VertexName where
  from :: QueueName -> VertexName
from = QueueName -> VertexName
VQueue

instance From ProjectTemplate VertexName where
  from :: ProjectTemplate -> VertexName
from ProjectTemplate
p = ProjectTemplateName -> VertexName
VProjectTemplate ProjectTemplate
p.name

instance From Pipeline VertexName where
  from :: Pipeline -> VertexName
from Pipeline
p = PipelineName -> VertexName
VPipeline Pipeline
p.name

instance From Nodeset VertexName where
  from :: Nodeset -> VertexName
from Nodeset
p = NodesetName -> VertexName
VNodeset Nodeset
p.name

instance From NodeLabelName VertexName where
  from :: NodeLabelName -> VertexName
from = NodeLabelName -> VertexName
VNodeLabel

mkVertex :: From a VertexName => ConfigLoc -> a -> Vertex
mkVertex :: forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc a
x = VertexName -> Set TenantName -> Vertex
Vertex (a -> VertexName
forall source target. From source target => source -> target
from a
x) ConfigLoc
loc.tenants

-- | A convenient type alias.
type ConfigGraph = Algebra.Graph.Graph Vertex

-- | Return the list of reachable 'Vertex'
findReachable ::
  -- | The list of 'Vertex' to search
  NonEmpty Vertex ->
  -- | The graph to search in
  ConfigGraph ->
  -- | The list of reachable 'Vertex'
  Set Vertex
findReachable :: NonEmpty Vertex -> ConfigGraph -> Set Vertex
findReachable NonEmpty Vertex
xs = [Vertex] -> Set Vertex
forall a. Ord a => [a] -> Set a
Set.fromList ([Vertex] -> Set Vertex)
-> (ConfigGraph -> [Vertex]) -> ConfigGraph -> Set Vertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex -> Bool) -> [Vertex] -> [Vertex]
forall a. (a -> Bool) -> [a] -> [a]
filter (Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex
v) ([Vertex] -> [Vertex])
-> (ConfigGraph -> [Vertex]) -> ConfigGraph -> [Vertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToVertex ConfigGraph] -> ConfigGraph -> [ToVertex ConfigGraph]
forall t.
(ToGraph t, Ord (ToVertex t)) =>
[ToVertex t] -> t -> [ToVertex t]
Algebra.Graph.ToGraph.dfs (NonEmpty Vertex -> [Vertex]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Vertex
xs)
  where
    v :: Vertex
v = NonEmpty Vertex -> Vertex
forall a. NonEmpty a -> a
NE.head NonEmpty Vertex
xs

-- | Return the forest of reachable 'Vertex'
findReachableForest ::
  Maybe (Set TenantName) ->
  -- | The list of 'Vertex' to search
  NonEmpty Vertex ->
  -- | The graph to search in
  ConfigGraph ->
  -- | The forest
  Forest VertexName
findReachableForest :: Maybe (Set TenantName)
-> NonEmpty Vertex -> ConfigGraph -> Forest VertexName
findReachableForest Maybe (Set TenantName)
scope NonEmpty Vertex
xs = (Tree Vertex -> Forest VertexName)
-> [Tree Vertex] -> Forest VertexName
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Vertex -> Forest VertexName
goRoot ([Tree Vertex] -> Forest VertexName)
-> (ConfigGraph -> [Tree Vertex])
-> ConfigGraph
-> Forest VertexName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ToVertex ConfigGraph]
-> ConfigGraph -> Forest (ToVertex ConfigGraph)
forall t.
(ToGraph t, Ord (ToVertex t)) =>
[ToVertex t] -> t -> Forest (ToVertex t)
Algebra.Graph.ToGraph.dfsForestFrom [ToVertex ConfigGraph]
[Vertex]
vertices
  where
    vertices :: [Vertex]
vertices = NonEmpty Vertex -> [Vertex]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Vertex
xs
    goRoot :: Tree Vertex -> Forest VertexName
goRoot (Node Vertex
_ [Tree Vertex]
child) = (Tree Vertex -> Forest VertexName)
-> [Tree Vertex] -> Forest VertexName
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Vertex -> Forest VertexName
go [Tree Vertex]
child
    go :: Tree Vertex -> [Tree VertexName]
    go :: Tree Vertex -> Forest VertexName
go tree :: Tree Vertex
tree@(Node Vertex
root [Tree Vertex]
_) = case Maybe (Set TenantName)
scope of
      Just Set TenantName
tenants
        | Set TenantName
tenants Set TenantName -> Set TenantName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Vertex
root.tenants -> Tree Vertex -> Forest VertexName
go' Tree Vertex
tree
        | Bool
otherwise -> []
      Maybe (Set TenantName)
Nothing -> Tree Vertex -> Forest VertexName
go' Tree Vertex
tree
    go' :: Tree Vertex -> [Tree VertexName]
    go' :: Tree Vertex -> Forest VertexName
go' (Node Vertex
root [Tree Vertex]
childs) = [VertexName -> Forest VertexName -> Tree VertexName
forall a. a -> [Tree a] -> Tree a
Node Vertex
root.name ((Tree Vertex -> Forest VertexName)
-> [Tree Vertex] -> Forest VertexName
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Vertex -> Forest VertexName
go [Tree Vertex]
childs)]

-- | The config analysis result used by the "ZuulWeeder.UI" module.
data Analysis = Analysis
  { -- | The requirements graph, e.g. job requires nodeset.
    Analysis -> ConfigGraph
dependencyGraph :: ConfigGraph,
    -- | The dependents graph, e.g. nodeset allows job.
    Analysis -> ConfigGraph
dependentGraph :: ConfigGraph,
    -- | The list of vertex, used for displaying search result.
    Analysis -> Set Vertex
vertices :: Set Vertex,
    -- | A map of all the names and their matching tenants, used for searching.
    Analysis -> Map VertexName (Set TenantName)
names :: Map VertexName (Set TenantName),
    -- | The zuul config.
    Analysis -> Config
config :: Config,
    -- | A list of error found when building the analysis.
    Analysis -> [String]
graphErrors :: [String]
  }
  deriving (Int -> Analysis -> ShowS
[Analysis] -> ShowS
Analysis -> String
(Int -> Analysis -> ShowS)
-> (Analysis -> String) -> ([Analysis] -> ShowS) -> Show Analysis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Analysis] -> ShowS
$cshowList :: [Analysis] -> ShowS
show :: Analysis -> String
$cshow :: Analysis -> String
showsPrec :: Int -> Analysis -> ShowS
$cshowsPrec :: Int -> Analysis -> ShowS
Show, (forall x. Analysis -> Rep Analysis x)
-> (forall x. Rep Analysis x -> Analysis) -> Generic Analysis
forall x. Rep Analysis x -> Analysis
forall x. Analysis -> Rep Analysis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Analysis x -> Analysis
$cfrom :: forall x. Analysis -> Rep Analysis x
Generic)

-- | The main function to build the 'Analysis' .
analyzeConfig :: TenantsConfig -> Config -> Analysis
analyzeConfig :: TenantsConfig -> Config -> Analysis
analyzeConfig (Zuul.Tenant.TenantsConfig Map TenantName TenantConfig
tenantsConfig) Config
config =
  Identity Analysis -> Analysis
forall a. Identity a -> a
runIdentity (StateT Analysis Identity () -> Analysis -> Identity Analysis
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT Analysis Identity ()
go (ConfigGraph
-> ConfigGraph
-> Set Vertex
-> Map VertexName (Set TenantName)
-> Config
-> [String]
-> Analysis
Analysis ConfigGraph
forall a. Graph a
Algebra.Graph.empty ConfigGraph
forall a. Graph a
Algebra.Graph.empty Set Vertex
forall a. Monoid a => a
mempty Map VertexName (Set TenantName)
forall a. Monoid a => a
mempty Config
config [String]
forall a. Monoid a => a
mempty))
  where
    -- All the default base jobs defined by the tenants
    -- Given:
    -- - tenant1, tenant2 default base job is 'base'
    -- - tenant3 default base job is 'base-minimal'
    -- Then: baseJobs = [(base, [tenant1, tenant2]), (base-minimal, [tenant3])]
    baseJobs :: [(JobName, Set TenantName)]
    baseJobs :: [(JobName, Set TenantName)]
baseJobs = Map JobName (Set TenantName) -> [(JobName, Set TenantName)]
forall k a. Map k a -> [(k, a)]
Map.toList Map JobName (Set TenantName)
baseJobsMap
      where
        baseJobsMap :: Map JobName (Set TenantName)
        baseJobsMap :: Map JobName (Set TenantName)
baseJobsMap = ((TenantName, TenantConfig)
 -> Map JobName (Set TenantName) -> Map JobName (Set TenantName))
-> Map JobName (Set TenantName)
-> [(TenantName, TenantConfig)]
-> Map JobName (Set TenantName)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (TenantName, TenantConfig)
-> Map JobName (Set TenantName) -> Map JobName (Set TenantName)
forall {k} {a} {r}.
(Ord k, Ord a, HasField "defaultParent" r k) =>
(a, r) -> Map k (Set a) -> Map k (Set a)
insertTenant Map JobName (Set TenantName)
forall a. Monoid a => a
mempty (Map TenantName TenantConfig -> [(TenantName, TenantConfig)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TenantName TenantConfig
tenantsConfig)
        insertTenant :: (a, r) -> Map k (Set a) -> Map k (Set a)
insertTenant (a
tenantName, r
tenantConfig) =
          (Set a -> Set a -> Set a)
-> k -> Set a -> Map k (Set a) -> Map k (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union r
tenantConfig.defaultParent (a -> Set a
forall a. a -> Set a
Set.singleton a
tenantName)

    -- The job list, where the tenant parent job is applied.
    -- Given:
    -- - job1: parent is Nothing
    -- - job2: parent is Just job1
    -- Then: allJobs = fromList
    --   [ (job1, [ (loc, job1 {parent = Just base})
    --            , (loc, job1 {parent = Just base-minimal}) ])
    --   , (job2, [ (loc, job2) ]) ]
    allJobs :: Zuul.ConfigLoader.ConfigMap JobName Job
    allJobs :: Map JobName [(ConfigLoc, Job)]
allJobs = ([(ConfigLoc, Job)] -> [(ConfigLoc, Job)])
-> Map JobName [(ConfigLoc, Job)] -> Map JobName [(ConfigLoc, Job)]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (((ConfigLoc, Job) -> [(ConfigLoc, Job)])
-> [(ConfigLoc, Job)] -> [(ConfigLoc, Job)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ConfigLoc, Job) -> [(ConfigLoc, Job)]
expandBaseJobs) Config
config.jobs
      where
        expandBaseJobs :: (ConfigLoc, Job) -> [(ConfigLoc, Job)]
        expandBaseJobs :: (ConfigLoc, Job) -> [(ConfigLoc, Job)]
expandBaseJobs (ConfigLoc
loc, Job
job)
          -- When parent is set, we don't touch the job
          | Maybe JobName -> Bool
forall a. Maybe a -> Bool
isJust Job
job.parent = [(ConfigLoc
loc, Job
job)]
          -- Otherwise we set the parent for each tenant
          | Bool
otherwise = case ((JobName, Set TenantName) -> Maybe (ConfigLoc, Job))
-> [(JobName, Set TenantName)] -> [(ConfigLoc, Job)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ConfigLoc, Job)
-> (JobName, Set TenantName) -> Maybe (ConfigLoc, Job)
setParentJob (ConfigLoc
loc, Job
job)) [(JobName, Set TenantName)]
baseJobs of
              [] -> String -> [(ConfigLoc, Job)]
forall a. HasCallStack => String -> a
error String
"This job is not attached to any tenant?!"
              [(ConfigLoc, Job)]
xs -> [(ConfigLoc, Job)]
xs
        setParentJob :: (ConfigLoc, Job) -> (JobName, Set TenantName) -> Maybe (ConfigLoc, Job)
        setParentJob :: (ConfigLoc, Job)
-> (JobName, Set TenantName) -> Maybe (ConfigLoc, Job)
setParentJob (ConfigLoc
loc, Job
job) (JobName
parent, Set TenantName
tenants)
          -- The default base job is from other tenants
          | (TenantName -> Bool) -> Set TenantName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TenantName -> Set TenantName -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ConfigLoc
loc.tenants) Set TenantName
tenants = Maybe (ConfigLoc, Job)
forall a. Maybe a
Nothing
          -- This job is the base job, we don't set it's parent
          | Job
job.name JobName -> JobName -> Bool
forall a. Eq a => a -> a -> Bool
== JobName
parent = (ConfigLoc, Job) -> Maybe (ConfigLoc, Job)
forall a. a -> Maybe a
Just (ConfigLoc
loc, Job
job)
          -- We create a new job with the parent set to the list of tenants defining it
          | Bool
otherwise = (ConfigLoc, Job) -> Maybe (ConfigLoc, Job)
forall a. a -> Maybe a
Just (ConfigLoc
loc ConfigLoc -> (ConfigLoc -> ConfigLoc) -> ConfigLoc
forall a b. a -> (a -> b) -> b
& (ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
#tenants ASetter ConfigLoc ConfigLoc (Set TenantName) (Set TenantName)
-> Set TenantName -> ConfigLoc -> ConfigLoc
forall s t a b. ASetter s t a b -> b -> s -> t
`set` (Set TenantName -> Set TenantName -> Set TenantName
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection ConfigLoc
loc.tenants Set TenantName
tenants)), Job
job {$sel:parent:Job :: Maybe JobName
parent = JobName -> Maybe JobName
forall a. a -> Maybe a
Just JobName
parent})

    go :: State Analysis ()
    go :: StateT Analysis Identity ()
go = do
      ((ConfigLoc, Job) -> StateT Analysis Identity ())
-> [(ConfigLoc, Job)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, Job) -> StateT Analysis Identity ()
goJob ([(ConfigLoc, Job)] -> StateT Analysis Identity ())
-> [(ConfigLoc, Job)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, Job)]] -> [(ConfigLoc, Job)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, Job)]] -> [(ConfigLoc, Job)])
-> [[(ConfigLoc, Job)]] -> [(ConfigLoc, Job)]
forall a b. (a -> b) -> a -> b
$ Map JobName [(ConfigLoc, Job)] -> [[(ConfigLoc, Job)]]
forall k a. Map k a -> [a]
Map.elems Map JobName [(ConfigLoc, Job)]
allJobs
      ((ConfigLoc, Nodeset) -> StateT Analysis Identity ())
-> [(ConfigLoc, Nodeset)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, Nodeset) -> StateT Analysis Identity ()
goNodeset ([(ConfigLoc, Nodeset)] -> StateT Analysis Identity ())
-> [(ConfigLoc, Nodeset)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, Nodeset)]] -> [(ConfigLoc, Nodeset)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, Nodeset)]] -> [(ConfigLoc, Nodeset)])
-> [[(ConfigLoc, Nodeset)]] -> [(ConfigLoc, Nodeset)]
forall a b. (a -> b) -> a -> b
$ ConfigMap NodesetName Nodeset -> [[(ConfigLoc, Nodeset)]]
forall k a. Map k a -> [a]
Map.elems Config
config.nodesets
      ((CanonicalProjectName, (ConfigLoc, Project))
 -> StateT Analysis Identity ())
-> [(CanonicalProjectName, (ConfigLoc, Project))]
-> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (CanonicalProjectName, (ConfigLoc, Project))
-> StateT Analysis Identity ()
goProject ([(CanonicalProjectName, (ConfigLoc, Project))]
 -> StateT Analysis Identity ())
-> [(CanonicalProjectName, (ConfigLoc, Project))]
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ ((CanonicalProjectName, [(ConfigLoc, Project)])
 -> [(CanonicalProjectName, (ConfigLoc, Project))])
-> [(CanonicalProjectName, [(ConfigLoc, Project)])]
-> [(CanonicalProjectName, (ConfigLoc, Project))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CanonicalProjectName, [(ConfigLoc, Project)])
-> [(CanonicalProjectName, (ConfigLoc, Project))]
projectList (Map CanonicalProjectName [(ConfigLoc, Project)]
-> [(CanonicalProjectName, [(ConfigLoc, Project)])]
forall k a. Map k a -> [(k, a)]
Map.toList Config
config.projects)
      ((ConfigLoc, Project) -> StateT Analysis Identity ())
-> [(ConfigLoc, Project)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, Project) -> StateT Analysis Identity ()
goProjectRegex ([(ConfigLoc, Project)] -> StateT Analysis Identity ())
-> [(ConfigLoc, Project)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, Project)]] -> [(ConfigLoc, Project)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, Project)]] -> [(ConfigLoc, Project)])
-> [[(ConfigLoc, Project)]] -> [(ConfigLoc, Project)]
forall a b. (a -> b) -> a -> b
$ Map ProjectRegex [(ConfigLoc, Project)] -> [[(ConfigLoc, Project)]]
forall k a. Map k a -> [a]
Map.elems Config
config.projectRegexs
      ((ConfigLoc, ProjectTemplate) -> StateT Analysis Identity ())
-> [(ConfigLoc, ProjectTemplate)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, ProjectTemplate) -> StateT Analysis Identity ()
goProjectTemplate ([(ConfigLoc, ProjectTemplate)] -> StateT Analysis Identity ())
-> [(ConfigLoc, ProjectTemplate)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, ProjectTemplate)]] -> [(ConfigLoc, ProjectTemplate)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, ProjectTemplate)]]
 -> [(ConfigLoc, ProjectTemplate)])
-> [[(ConfigLoc, ProjectTemplate)]]
-> [(ConfigLoc, ProjectTemplate)]
forall a b. (a -> b) -> a -> b
$ Map ProjectTemplateName [(ConfigLoc, ProjectTemplate)]
-> [[(ConfigLoc, ProjectTemplate)]]
forall k a. Map k a -> [a]
Map.elems Config
config.projectTemplates
      ((ConfigLoc, Pipeline) -> StateT Analysis Identity ())
-> [(ConfigLoc, Pipeline)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, Pipeline) -> StateT Analysis Identity ()
goPipeline ([(ConfigLoc, Pipeline)] -> StateT Analysis Identity ())
-> [(ConfigLoc, Pipeline)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, Pipeline)]] -> [(ConfigLoc, Pipeline)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, Pipeline)]] -> [(ConfigLoc, Pipeline)])
-> [[(ConfigLoc, Pipeline)]] -> [(ConfigLoc, Pipeline)]
forall a b. (a -> b) -> a -> b
$ Map PipelineName [(ConfigLoc, Pipeline)]
-> [[(ConfigLoc, Pipeline)]]
forall k a. Map k a -> [a]
Map.elems Config
config.pipelines
      ((ConfigLoc, SecretName) -> StateT Analysis Identity ())
-> [(ConfigLoc, SecretName)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, SecretName) -> StateT Analysis Identity ()
forall {b}.
From b VertexName =>
(ConfigLoc, b) -> StateT Analysis Identity ()
goInsert ([(ConfigLoc, SecretName)] -> StateT Analysis Identity ())
-> [(ConfigLoc, SecretName)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, SecretName)]] -> [(ConfigLoc, SecretName)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, SecretName)]] -> [(ConfigLoc, SecretName)])
-> [[(ConfigLoc, SecretName)]] -> [(ConfigLoc, SecretName)]
forall a b. (a -> b) -> a -> b
$ ConfigMap SecretName SecretName -> [[(ConfigLoc, SecretName)]]
forall k a. Map k a -> [a]
Map.elems Config
config.secrets
      ((ConfigLoc, SemaphoreName) -> StateT Analysis Identity ())
-> [(ConfigLoc, SemaphoreName)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, SemaphoreName) -> StateT Analysis Identity ()
forall {b}.
From b VertexName =>
(ConfigLoc, b) -> StateT Analysis Identity ()
goInsert ([(ConfigLoc, SemaphoreName)] -> StateT Analysis Identity ())
-> [(ConfigLoc, SemaphoreName)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, SemaphoreName)]] -> [(ConfigLoc, SemaphoreName)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, SemaphoreName)]] -> [(ConfigLoc, SemaphoreName)])
-> [[(ConfigLoc, SemaphoreName)]] -> [(ConfigLoc, SemaphoreName)]
forall a b. (a -> b) -> a -> b
$ ConfigMap SemaphoreName SemaphoreName
-> [[(ConfigLoc, SemaphoreName)]]
forall k a. Map k a -> [a]
Map.elems Config
config.semaphores
      ((ConfigLoc, QueueName) -> StateT Analysis Identity ())
-> [(ConfigLoc, QueueName)] -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc, QueueName) -> StateT Analysis Identity ()
forall {b}.
From b VertexName =>
(ConfigLoc, b) -> StateT Analysis Identity ()
goInsert ([(ConfigLoc, QueueName)] -> StateT Analysis Identity ())
-> [(ConfigLoc, QueueName)] -> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ [[(ConfigLoc, QueueName)]] -> [(ConfigLoc, QueueName)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ConfigLoc, QueueName)]] -> [(ConfigLoc, QueueName)])
-> [[(ConfigLoc, QueueName)]] -> [(ConfigLoc, QueueName)]
forall a b. (a -> b) -> a -> b
$ ConfigMap QueueName QueueName -> [[(ConfigLoc, QueueName)]]
forall k a. Map k a -> [a]
Map.elems Config
config.queues
      where
        projectList :: (CanonicalProjectName, [(ConfigLoc, Project)]) -> [(CanonicalProjectName, (ConfigLoc, Project))]
        projectList :: (CanonicalProjectName, [(ConfigLoc, Project)])
-> [(CanonicalProjectName, (ConfigLoc, Project))]
projectList (CanonicalProjectName
a, [(ConfigLoc, Project)]
b) = (CanonicalProjectName
a,) ((ConfigLoc, Project)
 -> (CanonicalProjectName, (ConfigLoc, Project)))
-> [(ConfigLoc, Project)]
-> [(CanonicalProjectName, (ConfigLoc, Project))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ConfigLoc, Project)]
b

    goInsert :: (ConfigLoc, b) -> StateT Analysis Identity ()
goInsert (ConfigLoc
loc, b
obj) = do
      let vertex :: Vertex
vertex = ConfigLoc -> b -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc b
obj
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vertex

    -- get the list of vertex matching a given name and set of tenants
    lookupTenant :: (Ord a, From b VertexName) => Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
    lookupTenant :: forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant Set TenantName
tenants a
key ConfigMap a b
cm = [(ConfigLoc, b)] -> Maybe (Set Vertex)
filterTenants ([(ConfigLoc, b)] -> Maybe (Set Vertex))
-> Maybe [(ConfigLoc, b)] -> Maybe (Set Vertex)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> ConfigMap a b -> Maybe [(ConfigLoc, b)]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
key ConfigMap a b
cm
      where
        filterTenants :: [(ConfigLoc, b)] -> Maybe (Set Vertex)
filterTenants [(ConfigLoc, b)]
xs = case ((ConfigLoc, b) -> Bool) -> [(ConfigLoc, b)] -> [(ConfigLoc, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ConfigLoc -> Bool
matchingTenant (ConfigLoc -> Bool)
-> ((ConfigLoc, b) -> ConfigLoc) -> (ConfigLoc, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConfigLoc, b) -> ConfigLoc
forall a b. (a, b) -> a
fst) [(ConfigLoc, b)]
xs of
          [] -> Maybe (Set Vertex)
forall a. Maybe a
Nothing
          [(ConfigLoc, b)]
xs' -> Set Vertex -> Maybe (Set Vertex)
forall a. a -> Maybe a
Just ([(ConfigLoc, b)] -> Set Vertex
toVertices [(ConfigLoc, b)]
xs')
        matchingTenant :: ConfigLoc -> Bool
        matchingTenant :: ConfigLoc -> Bool
matchingTenant ConfigLoc
loc = (TenantName -> Bool) -> Set TenantName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TenantName -> Set TenantName -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ConfigLoc
loc.tenants) Set TenantName
tenants
        toVertices :: [(ConfigLoc, b)] -> Set Vertex
toVertices = [Vertex] -> Set Vertex
forall a. Ord a => [a] -> Set a
Set.fromList ([Vertex] -> Set Vertex)
-> ([(ConfigLoc, b)] -> [Vertex]) -> [(ConfigLoc, b)] -> Set Vertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ConfigLoc, b) -> Vertex) -> [(ConfigLoc, b)] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (\(ConfigLoc
loc, b
dst) -> ConfigLoc -> b -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc b
dst)

    goPipeline :: (ConfigLoc, Pipeline) -> State Analysis ()
    goPipeline :: (ConfigLoc, Pipeline) -> StateT Analysis Identity ()
goPipeline (ConfigLoc
loc, Pipeline
pipeline) = do
      let vPipeline :: Vertex
vPipeline = ConfigLoc -> Pipeline -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc Pipeline
pipeline
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vPipeline
      [PipelineTrigger]
-> (PipelineTrigger -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Pipeline
pipeline.triggers ((PipelineTrigger -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (PipelineTrigger -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \(PipelineTrigger ConnectionName
trigger) -> do
        let vTrigger :: Vertex
vTrigger = VertexName -> Set TenantName -> Vertex
Vertex (ConnectionName -> VertexName
VTrigger ConnectionName
trigger) ConfigLoc
loc.tenants
        Vertex
vTrigger Vertex -> Vertex -> StateT Analysis Identity ()
`connect` Vertex
vPipeline
        ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vTrigger
      [PipelineReporter]
-> (PipelineReporter -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Pipeline
pipeline.reporters ((PipelineReporter -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (PipelineReporter -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \(PipelineReporter ConnectionName
trigger) -> do
        let vReporter :: Vertex
vReporter = VertexName -> Set TenantName -> Vertex
Vertex (ConnectionName -> VertexName
VReporter ConnectionName
trigger) ConfigLoc
loc.tenants
        Vertex
vReporter Vertex -> Vertex -> StateT Analysis Identity ()
`connect` Vertex
vPipeline
        ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vReporter

    goPipelineConfig :: ConfigLoc -> Vertex -> (PipelineName -> VertexName) -> ProjectPipeline -> State Analysis ()
    goPipelineConfig :: ConfigLoc
-> Vertex
-> (PipelineName -> VertexName)
-> ProjectPipeline
-> StateT Analysis Identity ()
goPipelineConfig ConfigLoc
loc Vertex
vProject PipelineName -> VertexName
mk ProjectPipeline
pipeline = do
      -- pipeline config is a list of jobs attached to a project pipeline
      let vPipelineConfig :: Vertex
vPipelineConfig = VertexName -> Set TenantName -> Vertex
Vertex (PipelineName -> VertexName
mk ProjectPipeline
pipeline.name) ConfigLoc
loc.tenants
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vPipelineConfig

      -- pipeline is the global pipeline object
      let vPipeline :: Vertex
vPipeline = VertexName -> Set TenantName -> Vertex
Vertex (PipelineName -> VertexName
VPipeline ProjectPipeline
pipeline.name) ConfigLoc
loc.tenants

      Vertex
vProject Vertex -> Vertex -> StateT Analysis Identity ()
`connect` Vertex
vPipelineConfig
      Vertex
vPipeline Vertex -> Vertex -> StateT Analysis Identity ()
`connect` Vertex
vPipelineConfig

      -- handle pipeline jobs
      [PipelineJob]
-> (PipelineJob -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((PipelineJob -> Bool) -> [PipelineJob] -> [PipelineJob]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PipelineJob
j -> PipelineJob -> JobName
forall source target. From source target => source -> target
from PipelineJob
j JobName -> JobName -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> JobName
JobName Text
"noop") ProjectPipeline
pipeline.jobs) ((PipelineJob -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (PipelineJob -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \PipelineJob
pJob -> do
        case Set TenantName
-> JobName -> Map JobName [(ConfigLoc, Job)] -> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants (PipelineJob -> JobName
forall source target. From source target => source -> target
from PipelineJob
pJob) Config
config.jobs of
          Just Set Vertex
jobs -> Vertex
vPipelineConfig Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
jobs
          Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> JobName -> String
forall a. Show a => a -> String
show (forall target source. From source target => source -> target
into @JobName PipelineJob
pJob)) :)
        case PipelineJob
pJob of
          PJName JobName
_ ->
            -- job referenced by name does not need to be processed.
            () -> StateT Analysis Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          PJJob Job
job ->
            -- job that are overriden are handled as a new job.
            (ConfigLoc, Job) -> StateT Analysis Identity ()
goJob (ConfigLoc
loc, Job
job)

    goQueue :: ConfigLoc -> Vertex -> Maybe QueueName -> State Analysis ()
    goQueue :: ConfigLoc
-> Vertex -> Maybe QueueName -> StateT Analysis Identity ()
goQueue ConfigLoc
loc Vertex
src = \case
      Just QueueName
queue -> case Set TenantName
-> QueueName -> ConfigMap QueueName QueueName -> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants QueueName
queue Config
config.queues of
        Just Set Vertex
queues -> Vertex
src Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
queues
        Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> QueueName -> String
forall a. Show a => a -> String
show QueueName
queue) :)
      Maybe QueueName
Nothing -> () -> StateT Analysis Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    goProject :: (CanonicalProjectName, (ConfigLoc, Project)) -> State Analysis ()
    goProject :: (CanonicalProjectName, (ConfigLoc, Project))
-> StateT Analysis Identity ()
goProject (CanonicalProjectName
projectName, (ConfigLoc
loc, Project
project)) = do
      let vProject :: Vertex
vProject = ConfigLoc -> CanonicalProjectName -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc CanonicalProjectName
projectName
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vProject

      -- handle queue and templates
      ConfigLoc -> Project -> Vertex -> StateT Analysis Identity ()
forall {r} {t :: * -> *}.
(HasField "queue" r (Maybe QueueName),
 HasField "templates" r (t ProjectTemplateName), Foldable t) =>
ConfigLoc -> r -> Vertex -> StateT Analysis Identity ()
goProjectConfig ConfigLoc
loc Project
project Vertex
vProject

      -- handle project pipeline configs
      (ProjectPipeline -> StateT Analysis Identity ())
-> Set ProjectPipeline -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc
-> Vertex
-> (PipelineName -> VertexName)
-> ProjectPipeline
-> StateT Analysis Identity ()
goPipelineConfig ConfigLoc
loc Vertex
vProject ((PipelineName -> CanonicalProjectName -> VertexName)
-> CanonicalProjectName -> PipelineName -> VertexName
forall a b c. (a -> b -> c) -> b -> a -> c
flip PipelineName -> CanonicalProjectName -> VertexName
VProjectPipeline CanonicalProjectName
projectName)) Project
project.pipelines

    goProjectConfig :: ConfigLoc -> r -> Vertex -> StateT Analysis Identity ()
goProjectConfig ConfigLoc
loc r
project Vertex
v = do
      -- handle queues
      ConfigLoc
-> Vertex -> Maybe QueueName -> StateT Analysis Identity ()
goQueue ConfigLoc
loc Vertex
v r
project.queue

      t ProjectTemplateName
-> (ProjectTemplateName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ r
project.templates ((ProjectTemplateName -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (ProjectTemplateName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \ProjectTemplateName
templateName -> do
        case Set TenantName
-> ProjectTemplateName
-> Map ProjectTemplateName [(ConfigLoc, ProjectTemplate)]
-> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants ProjectTemplateName
templateName Config
config.projectTemplates of
          Just Set Vertex
templates -> Vertex
v Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
templates
          Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProjectTemplateName -> String
forall a. Show a => a -> String
show ProjectTemplateName
templateName) :)

    goProjectRegex :: (ConfigLoc, Project) -> State Analysis ()
    goProjectRegex :: (ConfigLoc, Project) -> StateT Analysis Identity ()
goProjectRegex (ConfigLoc
loc, Project
project) = do
      let regex :: ProjectRegex
regex = forall target source. From source target => source -> target
into @ProjectRegex Project
project.name
      let vProjectRegex :: Vertex
vProjectRegex = ConfigLoc -> ProjectRegex -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc ProjectRegex
regex
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vProjectRegex

      -- handle templates
      ConfigLoc -> Project -> Vertex -> StateT Analysis Identity ()
forall {r} {t :: * -> *}.
(HasField "queue" r (Maybe QueueName),
 HasField "templates" r (t ProjectTemplateName), Foldable t) =>
ConfigLoc -> r -> Vertex -> StateT Analysis Identity ()
goProjectConfig ConfigLoc
loc Project
project Vertex
vProjectRegex

      -- handle project pipeline configs
      (ProjectPipeline -> StateT Analysis Identity ())
-> Set ProjectPipeline -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc
-> Vertex
-> (PipelineName -> VertexName)
-> ProjectPipeline
-> StateT Analysis Identity ()
goPipelineConfig ConfigLoc
loc Vertex
vProjectRegex ((PipelineName -> ProjectRegex -> VertexName)
-> ProjectRegex -> PipelineName -> VertexName
forall a b c. (a -> b -> c) -> b -> a -> c
flip PipelineName -> ProjectRegex -> VertexName
VRegexPipeline ProjectRegex
regex)) Project
project.pipelines

    goProjectTemplate :: (ConfigLoc, ProjectTemplate) -> State Analysis ()
    goProjectTemplate :: (ConfigLoc, ProjectTemplate) -> StateT Analysis Identity ()
goProjectTemplate (ConfigLoc
loc, ProjectTemplate
tmpl) = do
      let src :: Vertex
src = ConfigLoc -> ProjectTemplate -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc ProjectTemplate
tmpl
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
src

      -- handle queues
      ConfigLoc
-> Vertex -> Maybe QueueName -> StateT Analysis Identity ()
goQueue ConfigLoc
loc Vertex
src ProjectTemplate
tmpl.queue

      -- handle template pipeline config
      (ProjectPipeline -> StateT Analysis Identity ())
-> Set ProjectPipeline -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ConfigLoc
-> Vertex
-> (PipelineName -> VertexName)
-> ProjectPipeline
-> StateT Analysis Identity ()
goPipelineConfig ConfigLoc
loc Vertex
src ((PipelineName -> ProjectTemplateName -> VertexName)
-> ProjectTemplateName -> PipelineName -> VertexName
forall a b c. (a -> b -> c) -> b -> a -> c
flip PipelineName -> ProjectTemplateName -> VertexName
VTemplatePipeline ProjectTemplate
tmpl.name)) ProjectTemplate
tmpl.pipelines

    goNodeset :: (ConfigLoc, Nodeset) -> State Analysis ()
    goNodeset :: (ConfigLoc, Nodeset) -> StateT Analysis Identity ()
goNodeset (ConfigLoc
loc, Nodeset
nodeset) = do
      let src :: Vertex
src = ConfigLoc -> Nodeset -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc Nodeset
nodeset
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
src

      -- handle labels
      [NodeLabelName]
-> (NodeLabelName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Nodeset
nodeset.labels ((NodeLabelName -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (NodeLabelName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \NodeLabelName
label -> do
        let dst :: Vertex
dst = ConfigLoc -> NodeLabelName -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc NodeLabelName
label
        ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
dst
        Vertex
src Vertex -> Vertex -> StateT Analysis Identity ()
`connect` Vertex
dst

    goJob :: (ConfigLoc, Job) -> State Analysis ()
    goJob :: (ConfigLoc, Job) -> StateT Analysis Identity ()
goJob (ConfigLoc
loc, Job
job) = do
      let vJob :: Vertex
vJob = ConfigLoc -> Job -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc Job
job
      ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vJob

      -- handle nodesets and anonymous node label
      case Job
job.nodeset of
        Just (JobNodeset NodesetName
nodeset) -> case Set TenantName
-> NodesetName
-> ConfigMap NodesetName Nodeset
-> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants NodesetName
nodeset Config
config.nodesets of
          Just Set Vertex
vNodesets -> Vertex
vJob Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
vNodesets
          Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NodesetName -> String
forall a. Show a => a -> String
show NodesetName
nodeset) :)
        Just (JobAnonymousNodeset [NodeLabelName]
nodeLabels) -> do
          [NodeLabelName]
-> (NodeLabelName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [NodeLabelName]
nodeLabels ((NodeLabelName -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (NodeLabelName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \NodeLabelName
nodeLabel -> do
            let vLabel :: Vertex
vLabel = ConfigLoc -> NodeLabelName -> Vertex
forall a. From a VertexName => ConfigLoc -> a -> Vertex
mkVertex ConfigLoc
loc NodeLabelName
nodeLabel
            ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
vLabel
            Vertex
vJob Vertex -> Vertex -> StateT Analysis Identity ()
`connect` Vertex
vLabel
        Maybe JobNodeset
Nothing -> () -> StateT Analysis Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      -- handle job parent
      case Job
job.parent of
        Just JobName
parent -> do
          case Set TenantName
-> JobName -> Map JobName [(ConfigLoc, Job)] -> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants JobName
parent Map JobName [(ConfigLoc, Job)]
allJobs of
            Just Set Vertex
vParentJobs -> Vertex
vJob Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
vParentJobs
            Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> JobName -> String
forall a. Show a => a -> String
show JobName
parent) :)
        Maybe JobName
Nothing -> () -> StateT Analysis Identity ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      -- handle job dependencies
      [JobName]
-> (JobName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe [JobName] -> [JobName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Job
job.dependencies) ((JobName -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (JobName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \JobName
dJob -> do
        case Set TenantName
-> JobName -> Map JobName [(ConfigLoc, Job)] -> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants JobName
dJob Map JobName [(ConfigLoc, Job)]
allJobs of
          Just Set Vertex
vDependencyJobs -> Vertex
vJob Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
vDependencyJobs
          Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> JobName -> String
forall a. Show a => a -> String
show JobName
dJob) :)

      -- handle job secrets
      [SecretName]
-> (SecretName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe [SecretName] -> [SecretName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Job
job.secrets) ((SecretName -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (SecretName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \SecretName
secret -> do
        case Set TenantName
-> SecretName
-> ConfigMap SecretName SecretName
-> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants SecretName
secret Config
config.secrets of
          Just Set Vertex
vSecrets -> Vertex
vJob Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
vSecrets
          Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SecretName -> String
forall a. Show a => a -> String
show SecretName
secret) :)

      -- handle job semaphores
      [SemaphoreName]
-> (SemaphoreName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Maybe [SemaphoreName] -> [SemaphoreName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Job
job.semaphores) ((SemaphoreName -> StateT Analysis Identity ())
 -> StateT Analysis Identity ())
-> (SemaphoreName -> StateT Analysis Identity ())
-> StateT Analysis Identity ()
forall a b. (a -> b) -> a -> b
$ \SemaphoreName
semaphore -> do
        case Set TenantName
-> SemaphoreName
-> ConfigMap SemaphoreName SemaphoreName
-> Maybe (Set Vertex)
forall a b.
(Ord a, From b VertexName) =>
Set TenantName -> a -> ConfigMap a b -> Maybe (Set Vertex)
lookupTenant ConfigLoc
loc.tenants SemaphoreName
semaphore Config
config.semaphores of
          Just Set Vertex
vSemaphores -> Vertex
vJob Vertex -> Set Vertex -> StateT Analysis Identity ()
`connects` Set Vertex
vSemaphores
          Maybe (Set Vertex)
Nothing -> ASetter Analysis Analysis [String] [String]
#graphErrors ASetter Analysis Analysis [String] [String]
-> ([String] -> [String]) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((String
"Can't find : " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SemaphoreName -> String
forall a. Show a => a -> String
show SemaphoreName
semaphore) :)

    -- connect two vertices: src and dst, where src requires dst and dst allows src.
    -- see https://english.stackexchange.com/questions/248642/inverse-of-dependency
    --
    -- This function is used for most elements, e.g.: job <-> nodeset <-> label
    --
    -- However there are a few exceptions where the relationship is restricted:
    --
    -- - Project pipelines are not directly attached to avoid un-necessary interconnections.
    --   For example, instead of:
    --
    --     project1 <-> check <-> job1
    --     project2 <-> check <-> job2
    --
    --   We don't connect through the global check to avoid having the job2 to be a requirement of project1:
    --
    --     project1 <-> project1:check <-> job1
    --        check <-> project1:check
    --     project2 <-> project2:check <-> job2
    --        check <-> project2:check
    --
    --   That way there is no connection between job2 and project1
    --
    -- - Project containing configuration allows the element, but the project is not a requirements.
    connect :: Vertex -> Vertex -> State Analysis ()
    connect :: Vertex -> Vertex -> StateT Analysis Identity ()
connect Vertex
src Vertex
dst = do
      Vertex
src Vertex -> Vertex -> StateT Analysis Identity ()
`requires` Vertex
dst
      Vertex
dst Vertex -> Vertex -> StateT Analysis Identity ()
`allows` Vertex
src

    -- see https://english.stackexchange.com/questions/248642/inverse-of-dependency
    requires, allows :: Vertex -> Vertex -> State Analysis ()
    Vertex
a requires :: Vertex -> Vertex -> StateT Analysis Identity ()
`requires` Vertex
b = ASetter Analysis Analysis ConfigGraph ConfigGraph
#dependencyGraph ASetter Analysis Analysis ConfigGraph ConfigGraph
-> (ConfigGraph -> ConfigGraph) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ConfigGraph -> ConfigGraph -> ConfigGraph
forall a. Graph a -> Graph a -> Graph a
Algebra.Graph.overlay (Vertex -> Vertex -> ConfigGraph
forall a. a -> a -> Graph a
Algebra.Graph.edge Vertex
a Vertex
b)
    Vertex
a allows :: Vertex -> Vertex -> StateT Analysis Identity ()
`allows` Vertex
b = ASetter Analysis Analysis ConfigGraph ConfigGraph
#dependentGraph ASetter Analysis Analysis ConfigGraph ConfigGraph
-> (ConfigGraph -> ConfigGraph) -> StateT Analysis Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ConfigGraph -> ConfigGraph -> ConfigGraph
forall a. Graph a -> Graph a -> Graph a
Algebra.Graph.overlay (Vertex -> Vertex -> ConfigGraph
forall a. a -> a -> Graph a
Algebra.Graph.edge Vertex
a Vertex
b)

    -- connects one vertex to a set of vertex, such as the object founds in different tenants.
    connects :: Vertex -> Set Vertex -> State Analysis ()
    connects :: Vertex -> Set Vertex -> StateT Analysis Identity ()
connects Vertex
src = (Vertex -> StateT Analysis Identity ())
-> Set Vertex -> StateT Analysis Identity ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Vertex -> Vertex -> StateT Analysis Identity ()
connect Vertex
src)

    -- insert a vertex and connect the config loc to the vertex.
    insertVertex :: ConfigLoc -> Vertex -> State Analysis ()
    insertVertex :: ConfigLoc -> Vertex -> StateT Analysis Identity ()
insertVertex ConfigLoc
loc Vertex
v = do
      #vertices %= Set.insert v
      #names %= Map.insertWith Set.union v.name v.tenants

      let vProject = Vertex (VProject (from loc)) loc.tenants
      vProject `allows` v

      -- Ensure the project exist in the global list and the lookup names.
      -- TODO: do that only once when starting the analysis
      #vertices %= Set.insert vProject
      #names %= Map.insertWith Set.union vProject.name vProject.tenants