Graph.hs

-- | Markdown link extraction and concept graph construction.
module Okf.Graph
  ( Edge (..),
    Graph (..),
    Node (..),
    buildGraph,
    extractConceptLinks,
    danglingReferences,
    duplicateConceptIds,
  )
where

import CMarkGFM qualified
import Data.Aeson (ToJSON (..), object, (.=))
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Okf.Bundle
import Okf.ConceptId
import Okf.Document (body)
import Okf.Markdown (markdownOptions)
import Okf.Path (PathReference (..), classifyPathReference)
import Okf.Prelude hiding ((.=))
import System.FilePath qualified as FilePath

-- | A graph node for one concept.
data Node = Node
  { id :: !ConceptId,
    label :: !Text,
    type_ :: !Text,
    description :: !(Maybe Text),
    resource :: !(Maybe Text),
    tags :: ![Text]
  }
  deriving stock (Generic, Eq, Show)

-- | A directed concept-to-concept link.
data Edge = Edge
  { source :: !ConceptId,
    target :: !ConceptId
  }
  deriving stock (Generic, Eq, Ord, Show)

-- | Bundle graph data with presentation-free nodes and edges.
data Graph = Graph
  { nodes :: ![Node],
    edges :: ![Edge]
  }
  deriving stock (Generic, Eq, Show)

instance ToJSON Node where
  toJSON Node {id = nodeId, label = nodeLabel, type_ = nodeType, description = nodeDescription, resource = nodeResource, tags = nodeTags} =
    object
      [ "id" .= nodeId,
        "label" .= nodeLabel,
        "type" .= nodeType,
        "description" .= nodeDescription,
        "resource" .= nodeResource,
        "tags" .= nodeTags
      ]

instance ToJSON Edge where
  toJSON Edge {source, target} =
    object
      [ "source" .= source,
        "target" .= target
      ]

instance ToJSON Graph where
  toJSON Graph {nodes, edges} =
    object
      [ "nodes" .= nodes,
        "edges" .= edges
      ]

-- | Build a graph, excluding links whose targets are not known concepts.
buildGraph :: [Concept] -> Graph
buildGraph concepts =
  Graph
    { nodes = conceptNode <$> sortedConcepts,
      edges = Set.toAscList knownEdges
    }
  where
    sortedConcepts = List.sortOn (renderConceptId . conceptIdOf) concepts
    knownIds = Set.fromList (conceptIdOf <$> concepts)
    knownEdges =
      Set.fromList
        [ Edge {source = conceptIdOf concept, target}
        | concept <- concepts,
          target <- extractConceptLinks concept,
          target `Set.member` knownIds
        ]

-- | Extract OKF concept links from a concept body.
extractConceptLinks :: Concept -> [ConceptId]
extractConceptLinks concept =
  foldMap (resolveLink concept) (extractMarkdownLinks (body (conceptDocument concept)))

-- | Every @(source, target)@ pair where a document links to a @.md@ concept ID
-- that is not present in the bundle. These are the edges 'buildGraph' silently
-- drops. An empty list means every internal link resolves to a real concept.
danglingReferences :: [Concept] -> [(ConceptId, ConceptId)]
danglingReferences concepts =
  [ (conceptIdOf concept, target)
  | concept <- concepts,
    target <- extractConceptLinks concept,
    not (target `Set.member` knownIds)
  ]
  where
    knownIds = Set.fromList (conceptIdOf <$> concepts)

-- | Concept IDs that appear more than once in a concept list. Always empty for
-- a bundle read from disk (paths are unique) but possible for an in-memory
-- producer assembling concepts before writing.
duplicateConceptIds :: [Concept] -> [ConceptId]
duplicateConceptIds concepts =
  [ conceptId
  | (conceptId, count) <- Map.toList counts,
    count > (1 :: Int)
  ]
  where
    counts = Map.fromListWith (+) [(conceptIdOf concept, 1) | concept <- concepts]

conceptNode :: Concept -> Node
conceptNode concept =
  Node
    { id = conceptIdOf concept,
      label = fromMaybe (renderConceptId (conceptIdOf concept)) (conceptTitle concept),
      type_ = conceptType concept,
      description = conceptDescription concept,
      resource = conceptResource concept,
      tags = conceptTags concept
    }

extractMarkdownLinks :: Text -> [Text]
extractMarkdownLinks markdown =
  walk (CMarkGFM.commonmarkToNode markdownOptions [] markdown)
  where
    walk (CMarkGFM.Node _ nodeType childNodes) =
      case nodeType of
        CMarkGFM.LINK url _title -> [url]
        _ -> foldMap walk childNodes

-- | Resolve one Markdown link destination to the concept it names, if any.
--
-- The §6.2 grammar lives in 'Okf.Path' and is shared with the profile layer, but
-- this function deliberately differs from it in one place, and the difference is
-- the point of keeping 'isExternalUrl' here. A body link is a heuristic over
-- prose, so only the three schemes a Markdown author plausibly writes are
-- treated as external, and anything that resolves to no concept is dropped in
-- silence — OKF v0.2 §6.1 says a broken body link may be knowledge not yet
-- written. A path-valued /field/ is read the other way round: every scheme is
-- recognized, and one the profile did not permit is reported rather than
-- ignored.
resolveLink :: Concept -> Text -> [ConceptId]
resolveLink concept rawUrl
  | isExternalUrl rawUrl = []
  | otherwise =
      case classifyPathReference (conceptIdOf concept) rawUrl of
        BundlePath resolved
          | FilePath.takeExtension resolved == ".md" ->
              either (const []) pure (conceptIdFromFilePath resolved)
        _ -> []

isExternalUrl :: Text -> Bool
isExternalUrl rawUrl =
  let lower = Text.toLower rawUrl
   in "http://" `Text.isPrefixOf` lower
        || "https://" `Text.isPrefixOf` lower
        || "mailto:" `Text.isPrefixOf` lower