Refactor to pipeline
introduce CompilationM monad
This commit is contained in:
parent
a7db2a53df
commit
dbefe27f9f
@ -23,12 +23,27 @@ import System.Exit (ExitCode(..))
|
|||||||
import Control.Exception (throwIO)
|
import Control.Exception (throwIO)
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
|
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)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
|
||||||
-- | Success indicator for user feedback
|
-- | Success indicator for user feedback
|
||||||
successEmoji :: Text
|
successEmoji :: Text
|
||||||
successEmoji = "✅"
|
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
|
-- | Strategy pattern: Record of format-specific operations
|
||||||
data CompilationStrategy = CompilationStrategy
|
data CompilationStrategy = CompilationStrategy
|
||||||
{ -- | Format for diagram configuration
|
{ -- | Format for diagram configuration
|
||||||
@ -118,36 +133,61 @@ processHTMLOutput outputPath html = do
|
|||||||
|
|
||||||
return $ Right ()
|
return $ Right ()
|
||||||
|
|
||||||
-- | Helper function to lift IO (Either DocsterError a) into ExceptT
|
-- | Helper function to lift IO (Either DocsterError a) into CompilationM
|
||||||
liftEitherIO :: IO (Either DocsterError a) -> ExceptT DocsterError IO a
|
liftEitherM :: IO (Either DocsterError a) -> CompilationM a
|
||||||
liftEitherIO action = do
|
liftEitherM action = do
|
||||||
result <- liftIO action
|
result <- liftIO action
|
||||||
case result of
|
case result of
|
||||||
Left err -> throwE err
|
Left err -> lift $ throwE err
|
||||||
Right value -> return value
|
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
|
-- | Higher-order compilation function that takes a strategy and executes the pipeline
|
||||||
compileWithStrategy :: CompilationStrategy -> SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
compileWithStrategy :: CompilationStrategy -> SourceDir -> OutputPath -> OutputPath -> IO (Either DocsterError ())
|
||||||
compileWithStrategy strategy sourceDir (OutputPath inputPath) (OutputPath outputPath) = runExceptT $ do
|
compileWithStrategy strategy sourceDir (OutputPath inputPath) (OutputPath outputPath) = do
|
||||||
-- Step 1: Read and parse markdown
|
|
||||||
content <- liftIO $ TIO.readFile inputPath
|
|
||||||
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
let readerOptions = def { readerExtensions = getDefaultExtensions "markdown" }
|
||||||
config = DiagramConfig sourceDir (csOutputFormat strategy)
|
config = DiagramConfig sourceDir (csOutputFormat strategy)
|
||||||
|
context = CompilationContext strategy sourceDir inputPath outputPath readerOptions config
|
||||||
|
pipeline = readContent >>= parseDocument >>= transformDocumentM >>= generateOutputM >>= processOutput >> printSuccess
|
||||||
|
|
||||||
-- Step 2: Parse markdown
|
runExceptT $ runReaderT pipeline context
|
||||||
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
|
|
||||||
|
|
||||||
-- | Parse markdown with error handling
|
-- | Parse markdown with error handling
|
||||||
parseMarkdown :: ReaderOptions -> Text -> IO (Either DocsterError Pandoc)
|
parseMarkdown :: ReaderOptions -> Text -> IO (Either DocsterError Pandoc)
|
||||||
|
Loading…
x
Reference in New Issue
Block a user