packages feed

seihou-core-0.9.0.0: src/Seihou/Engine/Execute.hs

module Seihou.Engine.Execute
  ( executePlan,
    dryRunPlan,
  )
where

import Data.Generics.Labels ()
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Time (UTCTime)
import Seihou.Core.Types
import Seihou.Effect.Filesystem
import Seihou.Engine.Section (applyTextPatch)
import Seihou.Manifest.Hash (hashContent)
import Seihou.Prelude

-- | Execute a list of operations against the filesystem.
-- Returns a map of file paths to FileRecord entries for the manifest.
--
-- The @ownerMap@ attributes each generated file to the module instance
-- (by its qualified name) that produced it. Paths not present in the
-- map fall back to the default @moduleName'@ — this preserves single-
-- module call-sites and test usage that do not build an ownership map.
--
-- Each record's @additiveOnly@ is folded across /every/ operation that
-- targets the same destination, so a path a module both writes and patches
-- records 'False'. Only a path reached exclusively through additive patches
-- records 'True'.
executePlan ::
  (Filesystem :> es) =>
  FilePath ->
  [Operation] ->
  Map FilePath ModuleName ->
  ModuleName ->
  UTCTime ->
  Eff es (Map FilePath FileRecord)
executePlan targetDir ops ownerMap moduleName' now = do
  let ownerFor dest = Map.findWithDefault moduleName' dest ownerMap
      additiveFor dest = Map.findWithDefault False dest additiveMap
  records <- mapM (executeOp targetDir ownerFor additiveFor now) ops
  pure (Map.fromList [(k, v) | Just (k, v) <- records])
  where
    additiveMap =
      Map.fromListWith
        (&&)
        [ (dest, isAdditiveOperation op)
        | op <- ops,
          Just dest <- [operationDestination op]
        ]

-- | The file a generated operation targets, if it targets one at all.
operationDestination :: Operation -> Maybe FilePath
operationDestination (WriteFileOp dest _ _) = Just dest
operationDestination (CopyFileOp _ dest) = Just dest
operationDestination (PatchFileOp dest _ _ _ _) = Just dest
operationDestination CreateDirOp {} = Nothing
operationDestination RunCommandOp {} = Nothing

-- | Execute a single operation and return a FileRecord if a file was written.
executeOp ::
  (Filesystem :> es) =>
  FilePath ->
  (FilePath -> ModuleName) ->
  (FilePath -> Bool) ->
  UTCTime ->
  Operation ->
  Eff es (Maybe (FilePath, FileRecord))
executeOp targetDir ownerFor additiveFor now op = case op of
  WriteFileOp dest content strat -> do
    let fullPath = targetDir </> dest
    writeFileText fullPath content
    let record =
          FileRecord
            { hash = hashContent content,
              moduleName = ownerFor dest,
              strategy = strat,
              generatedAt = now,
              baseline = Nothing,
              applicationIds = mempty,
              additiveOnly = additiveFor dest
            }
    pure (Just (dest, record))
  CreateDirOp path -> do
    let fullPath = targetDir </> path
    createDirectoryIfMissing True fullPath
    pure Nothing
  CopyFileOp src dest -> do
    let fullDest = targetDir </> dest
    content <- readFileText src
    writeFileText fullDest content
    let record =
          FileRecord
            { hash = hashContent content,
              moduleName = ownerFor dest,
              strategy = Copy,
              generatedAt = now,
              baseline = Nothing,
              applicationIds = mempty,
              additiveOnly = additiveFor dest
            }
    pure (Just (dest, record))
  RunCommandOp {} -> do
    -- Command execution is deferred to the CLI layer.
    pure Nothing
  PatchFileOp dest newContent patchOp' strat modName -> do
    let fullPath = targetDir </> dest
    -- Read existing content if the file exists, otherwise start empty
    exists <- doesFileExist fullPath
    existing <-
      if exists
        then readFileText fullPath
        else pure ""
    -- Apply the patch with "#" as default comment prefix
    case applyTextPatch patchOp' modName "#" existing newContent of
      Left err -> error ("Patch failed: " <> T.unpack err)
      Right merged -> do
        writeFileText fullPath merged
        let record =
              FileRecord
                { hash = hashContent merged,
                  moduleName = ownerFor dest,
                  strategy = strat,
                  generatedAt = now,
                  baseline = Nothing,
                  applicationIds = mempty,
                  additiveOnly = additiveFor dest
                }
        pure (Just (dest, record))

-- | Format a human-readable description of the plan without executing anything.
dryRunPlan :: [Operation] -> Text
dryRunPlan ops =
  if null ops
    then "No operations to perform."
    else T.unlines (map formatOp ops)
  where
    formatOp :: Operation -> Text
    formatOp (WriteFileOp dest _ _) = "  write " <> T.pack dest
    formatOp (CreateDirOp path) = "  mkdir " <> T.pack path
    formatOp (CopyFileOp src dest) = "  copy  " <> T.pack src <> " -> " <> T.pack dest
    formatOp RunCommandOp {command = cmd} = "  run   " <> cmd
    formatOp (PatchFileOp dest _ patchOp' _ modName) =
      "  patch " <> T.pack dest <> " (" <> formatPatchOp patchOp' <> " from " <> modName ^. #unModuleName <> ")"
    formatPatchOp AppendFile = "append-file"
    formatPatchOp PrependFile = "prepend-file"
    formatPatchOp AppendSection = "append-section"
    formatPatchOp AppendLineIfAbsent = "append-line-if-absent"