pandoc-plot-0.5.0.0: executable/Main.hs

{-# LANGUAGE ApplicativeDo     #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE RecordWildCards   #-}

module Main where

import           Control.Applicative              ((<|>))
import           Control.Monad                    (join, forM_)

import           Data.List                        (intersperse, (\\))
import           Data.Monoid                      ((<>))
import           Data.Text                        (unpack)

import           GitHash                          as Git

import           Options.Applicative
import qualified Options.Applicative.Help.Pretty  as P

import           System.Directory                 (doesFileExist)
import           System.IO.Temp                   (writeSystemTempFile)

import           Text.Pandoc.Filter.Plot          (availableToolkits,
                                                   plotTransform,
                                                   defaultConfiguration, 
                                                   configuration, 
                                                   Configuration(..))
import           Text.Pandoc.Filter.Plot.Internal (cls, supportedSaveFormats, 
                                                   toolkits, readDoc, 
                                                   cleanOutputDirs, )

import           Text.Pandoc                      (pandocVersion)
import           Text.Pandoc.Definition           (pandocTypesVersion)
import           Text.Pandoc.JSON                 (toJSONFilter)

import           Web.Browser                      (openBrowser)

import qualified Data.Version                     as V
import           Paths_pandoc_plot                (version)

import           ManPage                          (embedManualHtml)
import           ExampleConfig                    (embedExampleConfig)

-- It is understood that Opts Nothing Nothing should be used for filtering
data Opts = Opts
    { optCommand :: Maybe Command
    , optFlag :: Maybe Flag
    }

-- The difference between commands and flags is that commands perform actions,
-- while flags only display information.

data Command = Clean FilePath
             | WriteConfig

data Flag = Version
          | FullVersion
          | Manual
          | Toolkits
    deriving (Eq)


main :: IO ()
main = join $ execParser opts
    where 
        opts = info (optparse <**> helper)
            (fullDesc
            <> progDesc "This pandoc filter generates plots from code blocks using a multitude of possible renderers. \
                        \This allows to keep documentation and figures in perfect synchronicity."
            <> header "pandoc-plot - generate figures directly in documents using your plotting toolkit of choice."
            <> footerDoc (Just footer')
            )
        
        optparse = do
            flag_ <- flagParser
            command_ <- commandParser
            -- The extra optional input below only serves to show
            -- to the user that the last argument is the AST from pandoc
            -- The parsed input is never used
            input <- optional $ strArgument (metavar "AST")
            return $ go flag_ command_ input
        
        go :: Maybe Flag -> Maybe Command -> Maybe String -> IO ()
        go (Just Version)     _ _ = putStrLn (V.showVersion version)
        go (Just FullVersion) _ _ = showFullVersion
        go (Just Manual)      _ _ = showManPage
        go (Just Toolkits)    _ _ = showAvailableToolkits
        go _ (Just (Clean fp))  _ = clean fp
        go _ (Just WriteConfig) _ = writeFile ".example-pandoc-plot.yml" $(embedExampleConfig)
        go Nothing Nothing      _ = toJSONFilterWithConfig

flagParser :: Parser (Maybe Flag)
flagParser = versionP <|> fullVersionP <|> manualP <|> toolkitsP
    where
        versionP = flag Nothing (Just Version) (mconcat
            [ long "version"
            , short 'v'
            , help "Show version number and exit."
            ])
        
        fullVersionP = flag Nothing (Just FullVersion) (mconcat
            [ long "full-version"
            , help "Show full version information and exit."
            ])

        manualP  = flag Nothing (Just Manual) (mconcat
            [ long "manual"
            , short 'm'
            , help "Open the manual page in the default web browser and exit."
            ])

        toolkitsP = flag Nothing (Just Toolkits) (mconcat
            [ long "toolkits"
            , short 't'
            , help "Show information on toolkits and exit. Executables from the configuration \
                   \file will be used, if a '.pandoc-plot.yml' file is in the current directory."
            ])

commandParser :: Parser (Maybe Command)
commandParser = optional $ subparser (
            command "clean" (
                info (cleanP <**> helper) ( 
                    progDesc "Clean output directories where figures from FILE might be stored.\
                              \ WARNING: All files in those directories will be deleted." 
                    )
                )
            <> command "write-example-config" (
                    info (writeConfigP <**> helper) (progDesc "Write example configuration to a file.")
                    )
                )
    where
        cleanP = Clean <$> strArgument (metavar "FILE")
        writeConfigP = pure WriteConfig


toJSONFilterWithConfig :: IO ()
toJSONFilterWithConfig = do
    c <- config
    toJSONFilter (plotTransform c)


config :: IO Configuration
config = do 
    configExists <- doesFileExist ".pandoc-plot.yml"
    if configExists
        then configuration ".pandoc-plot.yml" 
        else return defaultConfiguration


showFullVersion :: IO ()
showFullVersion = do
    putStrLn $ "pandoc-plot " <> (V.showVersion version)
    putStrLn $ "Git revision " <> gitrev
    putStrLn $ mconcat [ "Compiled with pandoc "
                        , (unpack pandocVersion)
                        , " and pandoc-types "
                        , V.showVersion pandocTypesVersion
                        ]
    where
        -- In certain environments (e.g. Hackage when building documentation),
        -- there is no git information. 
        gitrev = either (const "unknown") Git.giHash ($$tGitInfoCwdTry)


showAvailableToolkits :: IO ()
showAvailableToolkits = do
    c <- config
    putStrLn "\nAVAILABLE TOOLKITS\n"
    available <- availableToolkits c
    return available >>= mapM_ toolkitInfo
    putStrLn "\nUNAVAILABLE TOOLKITS\n"
    -- We don't use unavailableToolkits because this would force
    -- more IO actions
    let unavailable = toolkits \\ available
    return unavailable >>= mapM_ toolkitInfo
    where
        toolkitInfo tk = do
            putStrLn $ "Toolkit: " <> show tk
            putStrLn $ "    Code block trigger: " <> (unpack . cls $ tk)
            putStrLn $ "    Supported save formats: " <> (mconcat . intersperse ", " . fmap show $ supportedSaveFormats tk)
            putStrLn mempty


clean :: FilePath -> IO ()
clean fp = do
    conf <- config
    putStrLn $ "Cleaning output directories for " <> fp
    cleanedDirs <- readDoc fp >>= cleanOutputDirs conf
    forM_ cleanedDirs $ \d -> putStrLn $ "Removed directory " <> d


showManPage :: IO ()
showManPage = 
    writeSystemTempFile "pandoc-plot-manual.html" $(embedManualHtml)
        >>= \fp -> openBrowser ("file:///" <> fp)
        >> return ()

-- | Use Doc type directly because of newline formatting
footer' :: P.Doc
footer' = mconcat 
    [ P.text "More information can be found via the manual (pandoc-plot --manual) or the repository README, located at"
    , P.line
    , P.indent 4 $ P.text "https://github.com/LaurentRDC/pandoc-plot"
    , P.line
    ]