seihou-core-0.4.0.0: src/Seihou/Engine/Section.hs
module Seihou.Engine.Section
( SectionMarker (..),
renderSectionOpen,
renderSectionClose,
wrapInSection,
removeSection,
applyTextPatch,
)
where
import Data.Text qualified as T
import Seihou.Core.Types
import Seihou.Prelude
-- | A section marker identifies content contributed by a module.
data SectionMarker = SectionMarker
{ sectionPrefix :: Text,
sectionModule :: ModuleName
}
deriving stock (Eq, Show)
-- | Render an opening section marker line.
-- Result: @"# --- seihou:haskell-base ---\\n"@
renderSectionOpen :: SectionMarker -> Text
renderSectionOpen marker =
marker.sectionPrefix <> " --- seihou:" <> marker.sectionModule.unModuleName <> " ---\n"
-- | Render a closing section marker line.
-- Result: @"# --- /seihou:haskell-base ---\\n"@
renderSectionClose :: SectionMarker -> Text
renderSectionClose marker =
marker.sectionPrefix <> " --- /seihou:" <> marker.sectionModule.unModuleName <> " ---\n"
-- | Wrap content in section markers.
wrapInSection :: SectionMarker -> Text -> Text
wrapInSection marker content =
renderSectionOpen marker <> content <> ensureTrailingNewline content <> renderSectionClose marker
where
ensureTrailingNewline t
| T.null t = ""
| T.last t == '\n' = ""
| otherwise = "\n"
-- | Remove a module's section from file content.
--
-- Strips all lines between the opening and closing section markers (inclusive)
-- for the given module name. The comment prefix (e.g., @"#"@) determines
-- the marker format. If no matching markers are found, the content is returned
-- unchanged. Cleans up resulting double blank lines.
removeSection :: ModuleName -> Text -> Text -> Text
removeSection modName prefix content =
let marker = SectionMarker {sectionPrefix = prefix, sectionModule = modName}
openTag = T.stripEnd (renderSectionOpen marker)
closeTag = T.stripEnd (renderSectionClose marker)
ls = T.lines content
filtered = dropSection openTag closeTag ls
cleaned = collapseBlankLines filtered
in if null cleaned
then ""
else T.unlines cleaned
where
dropSection _ _ [] = []
dropSection open close (l : rest)
| T.stripEnd l == open =
-- Skip until we find the close tag
case dropWhile (\x -> T.stripEnd x /= close) rest of
[] -> [] -- Close tag not found, drop remaining
(_ : after) -> dropSection open close after
| otherwise = l : dropSection open close rest
collapseBlankLines [] = []
collapseBlankLines [x] = [x]
collapseBlankLines (x : y : rest)
| T.null (T.strip x) && T.null (T.strip y) = collapseBlankLines (y : rest)
| otherwise = x : collapseBlankLines (y : rest)
-- | Apply a patch operation to existing content.
--
-- @applyTextPatch patchOp moduleName commentPrefix existingContent newContent@
--
-- Returns the merged content or an error.
applyTextPatch :: PatchOp -> ModuleName -> Text -> Text -> Text -> Either Text Text
applyTextPatch AppendFile _ _ existing new =
Right (ensureTrailingNewline existing <> new)
applyTextPatch PrependFile _ _ existing new =
Right (ensureTrailingNewline new <> existing)
applyTextPatch AppendSection modName prefix existing new =
let marker = SectionMarker {sectionPrefix = prefix, sectionModule = modName}
in Right (ensureTrailingNewline existing <> wrapInSection marker new)
applyTextPatch AppendLineIfAbsent _ _ existing new =
let existingLines = map T.stripEnd (T.lines existing)
newLines = filter (not . T.null . T.strip) (T.lines (T.stripEnd new))
missing = filter (\l -> T.stripEnd l `notElem` existingLines) newLines
in if null missing
then Right existing
else Right (ensureTrailingNewline existing <> T.unlines missing)
-- | Ensure text ends with a newline. Returns the text unchanged if it already
-- ends with one, or with an appended newline if not. Returns empty text unchanged.
ensureTrailingNewline :: Text -> Text
ensureTrailingNewline t
| T.null t = t
| T.last t == '\n' = t
| otherwise = t <> "\n"