tintin 1.5.0 → 1.7.0
raw patch · 6 files changed
+117/−27 lines, 6 files
Files
- app/Main.hs +29/−11
- src/Tintin.hs +57/−3
- src/Tintin/Capabilities/Process.hs +11/−2
- src/Tintin/Domain/HtmlFile.hs +14/−6
- src/Tintin/Render.hs +4/−3
- tintin.cabal +2/−2
app/Main.hs view
@@ -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)+
src/Tintin.hs view
@@ -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
src/Tintin/Capabilities/Process.hs view
@@ -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
src/Tintin/Domain/HtmlFile.hs view
@@ -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) ->
src/Tintin/Render.hs view
@@ -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
tintin.cabal view
@@ -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 <https://theam.github.io/tintin> category: Documentation