diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -11,10 +11,16 @@ import qualified Tintin.Capabilities.Process as Process -data Options = Options - { outputDirectory :: Maybe Text - , verbose :: Bool - } +data Options + = Run + { outputDirectory :: Maybe Text + , verbose :: Bool + , runghc :: Bool + } + | Publish + { verbose :: Bool + , documentationDirectory :: Maybe Text + } deriving instance Generic Options instance ParseRecord Options @@ -23,10 +29,22 @@ main :: IO () main = do opts <- getRecord "Tintin, the tutorial website generator" - let outputDir = fromMaybe ".stack-work/tintin/rendered/" (outputDirectory opts) - let logger = if verbose opts - then Logging.stdOut - else Logging.mute - let filesystem = Filesystem.local - let process = Process.local - runEffects ( runApp $ OutputDirectory outputDir ) (logger, filesystem, process) + case opts of + Run outputDirectory verbose shouldUseCabal -> do + let outputDir = fromMaybe ".stack-work/tintin/rendered/" outputDirectory + let logger = if verbose + then Logging.stdOut + else Logging.mute + let filesystem = Filesystem.local + let process = Process.local + runEffects ( runApp shouldUseCabal $ OutputDirectory outputDir ) (logger, filesystem, process) + + Publish verbose documentationDirectory -> do + let outputDir = fromMaybe ".stack-work/tintin/rendered/" documentationDirectory + let logger = if verbose + then Logging.stdOut + else Logging.mute + let filesystem = Filesystem.local + let process = Process.local + runEffects ( publish $ OutputDirectory outputDir ) (logger, filesystem, process) + diff --git a/src/Tintin.hs b/src/Tintin.hs --- a/src/Tintin.hs +++ b/src/Tintin.hs @@ -1,5 +1,6 @@ module Tintin ( runApp + , publish ) where @@ -10,22 +11,75 @@ require Tintin.Capabilities.Process require Tintin.Parse require Tintin.Render +require Tintin.Errors require Tintin.ConfigurationLoading +require Tintin.Domain.HtmlFile +require Data.Text + + +publish :: ( Has Logging.Capability eff + , Has Filesystem.Capability eff + , Has Process.Capability eff + ) + => OutputDirectory + -> Effectful eff () +publish (OutputDirectory p)= do + gitContents <- Filesystem.readFile ( Filesystem.Path ".git/config" ) + let r = lines gitContents + |> dropWhile (not . Text.isInfixOf "origin") + |> nonEmpty + |$> tail + |>> safeHead + |$> Text.dropWhile (/= '=') + |$> Text.dropWhile (/= 'g') + case r of + Nothing -> + Errors.textDie ["Could not read origin remote. Are you in a Git repository?"] + + Just remote -> do + Logging.debug "Initializing repo" + Process.call ( Process.CommandName $ "cd " <> p + <> " && git init" + ) + Logging.debug "Adding origin remote" + Process.call ( Process.CommandName $ "cd " <> p + <> " && git remote add origin " <> remote + ) + Logging.debug "Cheking out gh-pages" + Process.call ( Process.CommandName $ "cd " <> p + <> " && git checkout -b gh-pages" + ) + Logging.debug "Adding new docs" + Process.call ( Process.CommandName $ "cd " <> p + <> " && git add *" + ) + Logging.debug "Commiting" + Process.call ( Process.CommandName $ "cd " <> p + <> " && git commit -m 'Update docs'" + ) + Logging.debug "Pushing" + Process.call ( Process.CommandName $ "cd " <> p + <> " && git push -f origin gh-pages" + ) + + runApp :: ( Has Logging.Capability eff , Has Filesystem.Capability eff , Has Process.Capability eff ) - => OutputDirectory + => Bool + -> OutputDirectory -> Effectful eff () -runApp outputDirectory = do +runApp shouldUseCabal outputDirectory = do cleanUp outputDirectory docDir <- getDocumentationDirectory filenames <- getDocumentationFilenames docDir + let buildTool = if shouldUseCabal then HtmlFile.Cabal else HtmlFile.Stack Parse.docs docDir filenames - |>> Render.perform + |>> Render.perform buildTool |>> ConfigurationLoading.loadInfo |>> Render.writeOutput outputDirectory diff --git a/src/Tintin/Capabilities/Process.hs b/src/Tintin/Capabilities/Process.hs --- a/src/Tintin/Capabilities/Process.hs +++ b/src/Tintin/Capabilities/Process.hs @@ -8,6 +8,7 @@ , local , read + , call ) where @@ -24,8 +25,9 @@ newtype StdOut = StdOut Text newtype StdErr = StdErr Text -newtype Capability = Capability - { _read :: CommandName -> Arguments -> IO (Either StdErr StdOut) +data Capability = Capability + { _read :: CommandName -> Arguments -> IO (Either StdErr StdOut) + , _call :: CommandName -> IO () } @@ -39,9 +41,16 @@ (ExitSuccess, stdout, _) -> return (Right . StdOut $ toText stdout) (_, _, stderr) -> return (Left . StdErr $ toText stderr) + _call (CommandName cn) = callCommand (toString $ cn) + read :: Has Capability eff => CommandName -> Arguments -> Effectful eff (Either StdErr StdOut) read = liftCapability _read + +call :: Has Capability eff + => CommandName + -> Effectful eff () +call = liftCapability _call diff --git a/src/Tintin/Domain/HtmlFile.hs b/src/Tintin/Domain/HtmlFile.hs --- a/src/Tintin/Domain/HtmlFile.hs +++ b/src/Tintin/Domain/HtmlFile.hs @@ -8,6 +8,10 @@ require Data.Text +data BuildTool + = Stack + | Cabal + newtype CompilationError = CompilationError Text deriving Show showCompilationError :: CompilationError @@ -34,9 +38,10 @@ run :: ( Has Filesystem.Capability eff , Has Process.Capability eff ) - => HtmlFile + => BuildTool + -> HtmlFile -> Effectful eff (Either CompilationError HtmlFile) -run HtmlFile {..} = do +run buildTool HtmlFile {..} = do Filesystem.Path currentDirectory <- Filesystem.currentDirectory let tintinDir = currentDirectory <> "/.stack-work/tintin/" let tempDir = tintinDir <> "temp/" @@ -52,10 +57,13 @@ Filesystem.deleteIfExists (Filesystem.Path tempDir) Filesystem.makeDirectory (Filesystem.Path tempDir) Filesystem.writeFile (Filesystem.Path hsFilename) content - result <- Process.read - (Process.CommandName "stack") - (Process.Arguments ["runghc", hsFilename, "--", "--no-inlit-wrap"]) - + result <- case buildTool of + Stack -> Process.read + (Process.CommandName "stack") + (Process.Arguments ["runghc", hsFilename, "--", "--no-inlit-wrap"]) + Cabal -> Process.read + (Process.CommandName "runghc") + (Process.Arguments [hsFilename, "--no-inlit-wrap"]) case result of Left (Process.StdErr err) -> diff --git a/src/Tintin/Render.hs b/src/Tintin/Render.hs --- a/src/Tintin/Render.hs +++ b/src/Tintin/Render.hs @@ -19,13 +19,14 @@ , Has Filesystem.Capability eff , Has Process.Capability eff ) - => [DocumentationFile] + => HtmlFile.BuildTool + -> [DocumentationFile] -> Effectful eff [HtmlFile] -perform docFiles = do +perform buildTool docFiles = do Logging.debug "Rendering" (errors, htmlFiles) <- docFiles |> map HtmlFile.fromDocumentationFile - |> mapM HtmlFile.run + |> mapM (HtmlFile.run buildTool) |$> partitionEithers unless (null errors) (Errors.textDie (HtmlFile.showCompilationError <$> errors)) return htmlFiles diff --git a/tintin.cabal b/tintin.cabal --- a/tintin.cabal +++ b/tintin.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: c7cd5c0e91efcd6cc40ef2f2822bc4bc66b5bb5d1ee2803ca3757eeae2c2eec4 +-- hash: 848c7ddf6e86b36b47395d20a2a0db79970dde0c64c1e0bab0728fc21e1da2d2 name: tintin -version: 1.5.0 +version: 1.7.0 synopsis: A softer alternative to Haddock description: Please see the website category: Documentation