WorkspaceDiff.hs

-- | Whole-service evolution findings enriched with workspace source ownership.
--
-- The ordinary differ remains the single authority for compatibility. This module
-- runs it over the two composed 'WorkspaceSpec' graphs and adds only source
-- citations. Consequently, file layout can never manufacture, suppress, or demote
-- a wire finding.
module Keiro.Dsl.WorkspaceDiff
  ( OwnedSite (..),
    WorkspaceChange (..),
    WorkspaceMeta (..),
    WorkspaceDiffReport,
    workspaceDiffReport,
    workspaceDiffReportWithSemanticImpact,
    workspaceDiffReportWithCoordinationImpact,
    workspaceDiffReportWithImpacts,
    diffWorkspaces,
    renderWorkspaceFinding,
  )
where

import Control.Applicative ((<|>))
import Data.Char (isSpace)
import Data.List (find)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as T
import Keiro.Dsl.Diff (Change (..), ChangeKind (..), advisoryAt, consumerBuildContext, diffServices, sourceLanguageChange)
import Keiro.Dsl.DiffReport (OwnedSite (..), WorkspaceChange (..), WorkspaceDiffReport, WorkspaceMeta (..), renderFinding, workspaceDiffReport, workspaceDiffReportWithCoordinationImpact, workspaceDiffReportWithImpacts, workspaceDiffReportWithSemanticImpact)
import Keiro.Dsl.FoldFingerprint (FoldSurfaceError)
import Keiro.Dsl.Grammar (Loc (..), Name, Placement (..))
import Keiro.Dsl.LanguageVersion (SourceLanguage (..))
import Keiro.Dsl.Validate (DiagnosticCode (..))
import Keiro.Dsl.Workspace (OwnershipIndex (..), WorkspaceMember (..), WorkspaceSpec (..), checkedWorkspace)

-- | Diff two composed service graphs and cite every participant we can resolve.
diffWorkspaces :: WorkspaceSpec -> WorkspaceSpec -> Either FoldSurfaceError [WorkspaceChange]
diffWorkspaces old new = do
  semanticChanges <- diffServices (checkedWorkspace old) (checkedWorkspace new)
  pure
    ( memberLanguageChanges old new
        <> map annotate semanticChanges
        <> ownershipMoveChanges old new
        <> authorityChanges old new
    )
  where
    annotate change =
      WorkspaceChange
        { change = change,
          declarationSite =
            ownedSiteForName new (declarationName kind)
              <|> ownedSiteForName old (declarationName kind),
          useSites =
            [ (path, ownedSiteForName new (pathRoot path) <|> ownedSiteForName old (pathRoot path))
            | path <- (.paths) kind
            ]
        }
      where
        kind = changeKind change

memberLanguageChanges :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange]
memberLanguageChanges old new =
  [ WorkspaceChange
      { change = change,
        declarationSite = Just (OwnedSite path (sourceLine ((.sourceLanguage) newMember))),
        useSites = []
      }
  | (path, newMember) <- Map.toAscList newByPath,
    Just oldMember <- [Map.lookup path oldByPath],
    change <- sourceLanguageChange ((.service) new) (T.pack path) ((.sourceLanguage) oldMember) ((.sourceLanguage) newMember)
  ]
  where
    oldByPath = Map.fromList [((.path) member, member) | member <- (.members) old]
    newByPath = Map.fromList [((.path) member, member) | member <- (.members) new]
    sourceLine LegacyUnversioned = 1
    sourceLine DeclaredLanguage {languageVersionLoc = Loc lineNumber} = lineNumber

-- | Preserve the existing headline/vector bytes and append indented citations.
renderWorkspaceFinding :: WorkspaceChange -> Text
renderWorkspaceFinding workspaceChange =
  T.intercalate "\n" (renderFinding ((.change) workspaceChange) : declarationLine <> useLines)
  where
    declarationLine = case (.declarationSite) workspaceChange of
      Nothing -> []
      Just site -> ["    declared: " <> renderOwnedSite site]
    useLines =
      [ "    use-site: " <> path <> " (" <> renderOwnedSite site <> ")"
      | (path, Just site) <- (.useSites) workspaceChange
      ]

renderOwnedSite :: OwnedSite -> Text
renderOwnedSite site = T.pack ((.file) site) <> ":" <> T.pack (show ((.line) site))

ownedSiteForName :: WorkspaceSpec -> Name -> Maybe OwnedSite
ownedSiteForName workspace name = do
  (_, (file, Loc line)) <- find ((== name) . snd . fst) entries
  pure (OwnedSite file line)
  where
    ownership = (.ownership) workspace
    entries = Map.toAscList ((.declarations) ownership) <> Map.toAscList ((.nodes) ownership)

declarationName :: ChangeKind -> Name
declarationName kind
  | "mapped-" `T.isPrefixOf` (.facet) kind,
    Just mapped <- mappedNameFromSubject ((.subject) kind) =
      mapped
  | otherwise = (.node) kind

mappedNameFromSubject :: Text -> Maybe Name
mappedNameFromSubject subject =
  case T.breakOn " : " subject of
    (_, rest)
      | not (T.null rest),
        let name = T.takeWhile (not . isSpace) (T.drop 3 rest),
        not (T.null name) ->
          Just name
    _ -> Nothing

pathRoot :: Text -> Name
pathRoot = T.takeWhile (\c -> c /= '.' && not (isSpace c))

changeKind :: Change -> ChangeKind
changeKind (Additive kind) = kind
changeKind (Advisory kind) = kind
changeKind (Breaking kind) = kind

ownershipMoveChanges :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange]
ownershipMoveChanges old new =
  [ WorkspaceChange
      { change =
          advisoryAt
            (consumerBuildContext name [])
            name
            "ownership"
            name
            OwnershipMoved
            ( "declaration moved "
                <> T.pack oldFile
                <> " -> "
                <> T.pack newFile
                <> "; source ownership changed while wire evolution remains independently classified"
            ),
        declarationSite = Just (OwnedSite newFile ((.unLoc) newLoc)),
        useSites = []
      }
  | (key@(_, name), (oldFile, _)) <- Map.toAscList (ownershipEntries ((.ownership) old)),
    Just (newFile, newLoc) <- [Map.lookup key (ownershipEntries ((.ownership) new))],
    oldFile /= newFile
  ]

ownershipEntries :: OwnershipIndex -> Map.Map (Text, Name) (FilePath, Loc)
ownershipEntries ownership = (.declarations) ownership <> (.nodes) ownership

authorityChanges :: WorkspaceSpec -> WorkspaceSpec -> [WorkspaceChange]
authorityChanges old new =
  concat
    [ changed "service-identity" ((.service) old) ((.service) new) serviceDetail,
      changed "context" ((.context) old) ((.context) new) contextDetail,
      changed "module-root" (renderModuleRoot ((.moduleRoot) old)) (renderModuleRoot ((.moduleRoot) new)) moduleDetail,
      changed "layout" (renderLayout ((.layout) old)) (renderLayout ((.layout) new)) layoutDetail
    ]
  where
    changed field before after detail
      | before == after = []
      | otherwise =
          [ WorkspaceChange
              { change =
                  advisoryAt
                    (consumerBuildContext ((.service) new) [])
                    ((.service) new)
                    "workspace-authority"
                    field
                    WorkspaceAuthorityChanged
                    (field <> " changed '" <> before <> "' -> '" <> after <> "'; " <> detail),
                declarationSite = Nothing,
                useSites = []
              }
          ]
    serviceDetail = "scaffold and compatibility history are re-keyed; follow the workspace adoption path"
    contextDetail = "generated module namespaces change, and read-model registry/subscription identities may emit separate DerivedIdentityChanged findings"
    moduleDetail = "generated module paths change without changing persisted wire identity"
    layoutDetail = "generated module placement changes without changing persisted wire identity"

renderModuleRoot :: Maybe Text -> Text
renderModuleRoot = maybe "(default)" id

renderLayout :: Maybe Placement -> Text
renderLayout Nothing = "(default)"
renderLayout (Just GeneratedPrefix) = "prefixed"
renderLayout (Just CollocatedLeaf) = "collocated"