Refactor to pipeline

introduce CompilationM monad
This commit is contained in:
Willem van den Ende 2025-07-30 12:38:14 +02:00
parent a7db2a53df
commit dbefe27f9f

View File

@ -23,12 +23,27 @@ import System.Exit (ExitCode(..))
import Control.Exception (throwIO)
import Control.Monad (void)
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
import Control.Monad.Trans.Reader (ReaderT, runReaderT, asks)
import Control.Monad.Trans.Class (lift)
import Control.Monad.IO.Class (liftIO)
-- | Success indicator for user feedback
successEmoji :: Text
successEmoji = ""
-- | Compilation context for pipeline operations
data CompilationContext = CompilationContext
{ ccStrategy :: CompilationStrategy
, ccSourceDir :: SourceDir
, ccInputPath :: FilePath
, ccOutputPath :: FilePath
, ccReaderOptions :: ReaderOptions
, ccConfig :: DiagramConfig
}
-- | Monad stack for compilation pipeline
type CompilationM = ReaderT CompilationContext (ExceptT DocsterError IO)
-- | Strategy pattern: Record of format-specific operations
data CompilationStrategy = CompilationStrategy
{ -- | Format for diagram configuration
@ -118,36 +133,61 @@ processHTMLOutput outputPath html = do
return $ Right ()
-- | Helper function to lift IO (Either DocsterError a) into ExceptT
liftEitherIO :: IO (Either DocsterError a) -> ExceptT DocsterError IO a
liftEitherIO action = do
-- | Helper function to lift IO (Either DocsterError a) into CompilationM
liftEitherM :: IO (Either DocsterError a) -> CompilationM a
liftEitherM action = do
result <- liftIO action
case result of
Left err -> throwE err
Left err -> lift $ throwE err
Right value -> return value
-- | Pipeline step: Read content from input file
readContent :: CompilationM Text
readContent = do
inputPath <- asks ccInputPath
liftIO $ TIO.readFile inputPath
-- | Pipeline step: Parse markdown content into Pandoc AST
parseDocument :: Text -> CompilationM Pandoc
parseDocument content = do
readerOptions <- asks ccReaderOptions
liftEitherM $ parseMarkdown readerOptions content
-- | Pipeline step: Transform document (process Mermaid diagrams)
transformDocumentM :: Pandoc -> CompilationM Pandoc
transformDocumentM pandoc = do
config <- asks ccConfig
liftEitherM $ transformDocument config pandoc
-- | Pipeline step: Generate output using format-specific writer
generateOutputM :: Pandoc -> CompilationM Text
generateOutputM pandoc = do
strategy <- asks ccStrategy
liftEitherM $ generateOutput strategy pandoc
-- | Pipeline step: Process output and write to file
processOutput :: Text -> CompilationM ()
processOutput output = do
strategy <- asks ccStrategy
outputPath <- asks ccOutputPath
liftEitherM $ csProcessOutput strategy outputPath output
-- | Pipeline step: Print success message
printSuccess :: CompilationM ()
printSuccess = do
strategy <- asks ccStrategy
outputPath <- asks ccOutputPath
liftIO $ putStrLn $ T.unpack $ csSuccessMessage strategy outputPath
-- | Higher-order compilation function that takes a strategy and executes the pipeline
compileWithStrategy :: CompilationStrategy -> SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
compileWithStrategy strategy sourceDir (OutputPath inputPath) (OutputPath outputPath) = runExceptT $ do
-- Step 1: Read and parse markdown
content <- liftIO $ TIO.readFile inputPath
compileWithStrategy strategy sourceDir (OutputPath inputPath) (OutputPath outputPath) = do
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
config = DiagramConfig sourceDir (csOutputFormat strategy)
context = CompilationContext strategy sourceDir inputPath outputPath readerOptions config
pipeline = readContent >>= parseDocument >>= transformDocumentM >>= generateOutputM >>= processOutput >> printSuccess
-- Step 2: Parse markdown
pandoc <- liftEitherIO $ parseMarkdown readerOptions content
-- Step 3: Transform document (process Mermaid diagrams)
transformed <- liftEitherIO $ transformDocument config pandoc
-- Step 4: Generate output using format-specific writer
output <- liftEitherIO $ generateOutput strategy transformed
-- Step 5: Process output and write to file
liftEitherIO $ csProcessOutput strategy outputPath output
-- Step 6: Print success message
liftIO $ putStrLn $ T.unpack $ csSuccessMessage strategy outputPath
runExceptT $ runReaderT pipeline context
-- | Parse markdown with error handling
parseMarkdown :: ReaderOptions -> Text -> IO (Either DocsterError Pandoc)