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"