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"