-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Graph-based heuristics for arranging the
-- order of sections in the schema docs
module Swarm.Doc.Schema.Arrangement (sortAndPruneSchemas) where

import Data.Graph
import Data.Set qualified as Set
import Swarm.Doc.Schema.Parse
import Swarm.Doc.Schema.Refined
import Swarm.Doc.Schema.SchemaType

-- | Sort the schemas in topological order.
--
-- Only includes schema files that are reachable from
-- the root schema
-- (i.e. exclude @entities.json@ and @recipes.json@,
-- which are used independently to validate @entities.yaml@
-- and @recipes.yaml@).
sortAndPruneSchemas ::
  SchemaIdReference ->
  [SchemaData] ->
  [SchemaData]
sortAndPruneSchemas :: SchemaIdReference -> [SchemaData] -> [SchemaData]
sortAndPruneSchemas SchemaIdReference
rootSchemaKey [SchemaData]
schemas =
  [SchemaData] -> [SchemaData]
forall a. [a] -> [a]
reverse ([SchemaData] -> [SchemaData])
-> ([(SchemaData, SchemaIdReference, [SchemaIdReference])]
    -> [SchemaData])
-> [(SchemaData, SchemaIdReference, [SchemaIdReference])]
-> [SchemaData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SCC SchemaData] -> [SchemaData]
forall a. [SCC a] -> [a]
flattenSCCs ([SCC SchemaData] -> [SchemaData])
-> ([(SchemaData, SchemaIdReference, [SchemaIdReference])]
    -> [SCC SchemaData])
-> [(SchemaData, SchemaIdReference, [SchemaIdReference])]
-> [SchemaData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(SchemaData, SchemaIdReference, [SchemaIdReference])]
-> [SCC SchemaData]
forall key node. Ord key => [(node, key, [key])] -> [SCC node]
stronglyConnComp ([(SchemaData, SchemaIdReference, [SchemaIdReference])]
 -> [SchemaData])
-> [(SchemaData, SchemaIdReference, [SchemaIdReference])]
-> [SchemaData]
forall a b. (a -> b) -> a -> b
$ [(SchemaData, SchemaIdReference, [SchemaIdReference])]
reachableEdges
 where
  rawEdgeList :: [(SchemaData, SchemaIdReference, [SchemaIdReference])]
rawEdgeList = (SchemaData
 -> (SchemaData, SchemaIdReference, [SchemaIdReference]))
-> [SchemaData]
-> [(SchemaData, SchemaIdReference, [SchemaIdReference])]
forall a b. (a -> b) -> [a] -> [b]
map SchemaData -> (SchemaData, SchemaIdReference, [SchemaIdReference])
getNodeEdgesEntry [SchemaData]
schemas
  (Graph
graph, Vertex -> (SchemaData, SchemaIdReference, [SchemaIdReference])
_nodeFromVertex, SchemaIdReference -> Maybe Vertex
vertexFromKey) = [(SchemaData, SchemaIdReference, [SchemaIdReference])]
-> (Graph,
    Vertex -> (SchemaData, SchemaIdReference, [SchemaIdReference]),
    SchemaIdReference -> Maybe Vertex)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)
graphFromEdges [(SchemaData, SchemaIdReference, [SchemaIdReference])]
rawEdgeList
  reachableVertices :: Set Vertex
reachableVertices = [Vertex] -> Set Vertex
forall a. Ord a => [a] -> Set a
Set.fromList ([Vertex] -> Set Vertex) -> [Vertex] -> Set Vertex
forall a b. (a -> b) -> a -> b
$ [Vertex] -> (Vertex -> [Vertex]) -> Maybe Vertex -> [Vertex]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Graph -> Vertex -> [Vertex]
reachable Graph
graph) (Maybe Vertex -> [Vertex]) -> Maybe Vertex -> [Vertex]
forall a b. (a -> b) -> a -> b
$ SchemaIdReference -> Maybe Vertex
vertexFromKey SchemaIdReference
rootSchemaKey

  reachableEdges :: [(SchemaData, SchemaIdReference, [SchemaIdReference])]
reachableEdges = ((SchemaData, SchemaIdReference, [SchemaIdReference]) -> Bool)
-> [(SchemaData, SchemaIdReference, [SchemaIdReference])]
-> [(SchemaData, SchemaIdReference, [SchemaIdReference])]
forall a. (a -> Bool) -> [a] -> [a]
filter (SchemaData, SchemaIdReference, [SchemaIdReference]) -> Bool
forall {a} {c}. (a, SchemaIdReference, c) -> Bool
f [(SchemaData, SchemaIdReference, [SchemaIdReference])]
rawEdgeList
  f :: (a, SchemaIdReference, c) -> Bool
f (a
_, SchemaIdReference
k, c
_) = Bool -> (Vertex -> Bool) -> Maybe Vertex -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Vertex -> Set Vertex -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Vertex
reachableVertices) (Maybe Vertex -> Bool)
-> (SchemaIdReference -> Maybe Vertex) -> SchemaIdReference -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaIdReference -> Maybe Vertex
vertexFromKey (SchemaIdReference -> Bool) -> SchemaIdReference -> Bool
forall a b. (a -> b) -> a -> b
$ SchemaIdReference
k

getNodeEdgesEntry ::
  SchemaData ->
  (SchemaData, SchemaIdReference, [SchemaIdReference])
getNodeEdgesEntry :: SchemaData -> (SchemaData, SchemaIdReference, [SchemaIdReference])
getNodeEdgesEntry sd :: SchemaData
sd@(SchemaData FilePath
fp ToplevelSchema
schem [Pandoc]
_) =
  ( SchemaData
sd
  , FilePath -> SchemaIdReference
fromFilePath FilePath
fp
  , Set SchemaIdReference -> [SchemaIdReference]
forall a. Set a -> [a]
Set.toList (Set SchemaIdReference -> [SchemaIdReference])
-> Set SchemaIdReference -> [SchemaIdReference]
forall a b. (a -> b) -> a -> b
$ SwarmSchema -> Set SchemaIdReference
extractReferences (SwarmSchema -> Set SchemaIdReference)
-> SwarmSchema -> Set SchemaIdReference
forall a b. (a -> b) -> a -> b
$ ToplevelSchema -> SwarmSchema
content ToplevelSchema
schem
  )