packages feed

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

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

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.
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
  records <- mapM (executeOp targetDir ownerFor now) ops
  pure (Map.fromList [(k, v) | Just (k, v) <- records])

-- | Execute a single operation and return a FileRecord if a file was written.
executeOp ::
  (Filesystem :> es) =>
  FilePath ->
  (FilePath -> ModuleName) ->
  UTCTime ->
  Operation ->
  Eff es (Maybe (FilePath, FileRecord))
executeOp targetDir ownerFor 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
            }
    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
            }
    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
                }
        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 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"