Docs.hs

module Command.Docs (command, infoModList) where

import Prelude

import           Command.Docs.Html
import           Command.Docs.Markdown
import           Control.Applicative
import           Control.Monad.Writer
import           Control.Monad.Trans.Except (runExceptT)
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Language.PureScript as P
import qualified Language.PureScript.Docs as D
import           Language.PureScript.Docs.Tags (dumpCtags, dumpEtags)
import qualified Options.Applicative as Opts
import qualified Text.PrettyPrint.ANSI.Leijen as PP
import           System.Directory (getCurrentDirectory, createDirectoryIfMissing, removeFile)
import           System.Exit (exitFailure)
import           System.FilePath ((</>))
import           System.FilePath.Glob (compile, glob, globDir1)
import           System.IO (hPutStrLn, stderr)
import           System.IO.UTF8 (writeUTF8FileT)

-- | Available output formats
data Format
  = Markdown
  | Html
  | Ctags -- Output ctags symbol index suitable for use with vi
  | Etags -- Output etags symbol index suitable for use with emacs
  deriving (Show, Eq, Ord)

data PSCDocsOptions = PSCDocsOptions
  { _pscdFormat :: Format
  , _pscdOutput :: Maybe FilePath
  , _pscdCompileOutputDir :: FilePath
  , _pscdInputFiles  :: [FilePath]
  }
  deriving (Show)

docgen :: PSCDocsOptions -> IO ()
docgen (PSCDocsOptions fmt moutput compileOutput inputGlob) = do
  input <- concat <$> mapM glob inputGlob
  when (null input) $ do
    hPutStrLn stderr "purs docs: no input files."
    exitFailure

  let output = fromMaybe (defaultOutputForFormat fmt) moutput

  fileMs <- parseAndConvert input
  let ms = D.primModules ++ map snd fileMs
  case fmt of
    Etags -> writeTagsToFile output $ dumpEtags fileMs
    Ctags -> writeTagsToFile output $ dumpCtags fileMs
    Html -> do
      let ext = compile "*.html"
      let msHtml = map asHtml ms
      createDirectoryIfMissing True output
      globDir1 ext output >>= mapM_ removeFile
      writeHtmlModules output msHtml
    Markdown -> do
      let ext = compile "*.md"
      let msMarkdown = map asMarkdown ms
      createDirectoryIfMissing True output
      globDir1 ext output >>= mapM_ removeFile
      writeMarkdownModules output msMarkdown

  putStrLn $ "Documentation written to: " ++ output

  where
  successOrExit :: Either P.MultipleErrors a -> IO a
  successOrExit act =
    case act of
      Right x ->
        return x
      Left err -> do
        hPutStrLn stderr $ P.prettyPrintMultipleErrors P.defaultPPEOptions err
        exitFailure

  parseAndConvert input =
    runExceptT (fmap fst (D.collectDocs compileOutput input []))
    >>= successOrExit

  writeTagsToFile :: String -> [String] -> IO ()
  writeTagsToFile outputFilename tags = do
    currentDir <- getCurrentDirectory
    let outputFile = currentDir </> outputFilename
    let text = T.pack . unlines $ tags
    writeUTF8FileT outputFile text

instance Read Format where
  readsPrec _ "etags" = [(Etags, "")]
  readsPrec _ "ctags" = [(Ctags, "")]
  readsPrec _ "markdown" = [(Markdown, "")]
  readsPrec _ "html" = [(Html, "")]
  readsPrec _ _ = []

defaultOutputForFormat :: Format -> FilePath
defaultOutputForFormat fmt =
  case fmt of
    Markdown -> "generated-docs/md"
    Html -> "generated-docs/html"
    Etags -> "TAGS"
    Ctags -> "tags"

pscDocsOptions :: Opts.Parser PSCDocsOptions
pscDocsOptions = PSCDocsOptions <$> format <*> output <*> compileOutputDir <*> many inputFile
  where
  format :: Opts.Parser Format
  format = Opts.option Opts.auto $
       Opts.value Html
    <> Opts.long "format"
    <> Opts.metavar "FORMAT"
    <> Opts.help "Set output FORMAT (markdown | html | etags | ctags)"

  output :: Opts.Parser (Maybe FilePath)
  output = optional $ Opts.strOption $
       Opts.long "output"
    <> Opts.short 'o'
    <> Opts.metavar "DEST"
    <> Opts.help "File/directory path for docs to be written to"

  compileOutputDir :: Opts.Parser FilePath
  compileOutputDir = Opts.strOption $
       Opts.value "output"
    <> Opts.showDefault
    <> Opts.long "compile-output"
    <> Opts.metavar "DIR"
    <> Opts.help "Compiler output directory"

  inputFile :: Opts.Parser FilePath
  inputFile = Opts.strArgument $
       Opts.metavar "FILE"
    <> Opts.help "The input .purs file(s)"

command :: Opts.Parser (IO ())
command = docgen <$> (Opts.helper <*> pscDocsOptions)

infoModList :: Opts.InfoMod a
infoModList = Opts.fullDesc <> footerInfo where
  footerInfo = Opts.footerDoc $ Just examples

examples :: PP.Doc
examples =
  PP.vcat $ map PP.text
    [ "Examples:"
    , "  write documentation for all modules to ./generated-docs:"
    , "    purs docs \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\""
    , ""
    , "  write documentation in Markdown format for all modules to ./generated-docs:"
    , "    purs docs --format markdown \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\""
    , ""
    , "  write CTags to ./tags:"
    , "    purs docs --format ctags \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\""
    , ""
    , "  write ETags to ./TAGS:"
    , "    purs docs --format etags \"src/**/*.purs\" \".psc-package/*/*/*/src/**/*.purs\""
    ]