PandocCodeDown.hs modulemodule PandocCodeDown ( -- * Parameters -- ** Formats Format, TypeOfText (..), typeOfText, -- ** Parameter type Parameter (..), -- ** Get functions for parameter lists getReadfrom, getWriteto, getInput, getOutput, getHelp, -- ** Set functions for parameter lists setReadfrom, setWriteto, setInput, setOutput, -- ** Parsing and showing parameters lists showParameters, parseParameters, parseParametersIO, -- * The converters pandoc', codeDown', pandoc, codeDown, codeDownIO, -- * Help functions printHelp ) where
import Char import Maybe (fromJust) import List (intersperse) import System.IO (getContents) import System.Exit import System import System.FilePath.Posix import Text.Pandoc (pandocVersion) import CoreCodeDown import CommandLine (Option, showOptions, parseOptions)
type Format = String -- either TypeOfCodeName or a Pandoc document format data TypeOfText = MARKDOWN | CODE | DOCUMENT deriving (Show, Read, Eq, Ord) typeOfText :: Format -> TypeOfText typeOfText format = if (map toUpper format) == "MARKDOWN" then MARKDOWN else if (map toUpper format) == "CODE" then CODE else if elem (map toUpper format) typeOfCodeNameList then CODE else DOCUMENT
data Parameter = INPUT [FilePath] -- -in --input | OUTPUT (Maybe FilePath) -- -out --ouput | READFROM Format -- -f --from -r --read | WRITETO Format -- -t --to -w --write (if format=code then pureCodeDown) | HELP String -- -h --help | OPTION (String, [String]) -- all the other pandoc options deriving (Show, Read, Eq, Ord)
getHelp :: [Parameter] -> Maybe String getHelp [] = Nothing getHelp ((HELP str) : _) = Just str getHelp (_ : parList) = getHelp parList getReadfrom :: [Parameter] -> Maybe Format getReadfrom [] = Nothing getReadfrom ((READFROM format) : _ ) = Just (map toUpper format) getReadfrom (_ : parList) = getReadfrom parList getWriteto :: [Parameter] -> Maybe Format getWriteto [] = Nothing getWriteto ((WRITETO format) : _) = Just (map toUpper format) getWriteto (_ : parList ) = getWriteto parList getInput :: [Parameter] -> [FilePath] getInput [] = [] getInput ((INPUT fileList) : parList) = fileList ++ (getInput parList) getInput (_ : parList) = getInput parList getOutput :: [Parameter] -> Maybe FilePath getOutput [] = Nothing getOutput ((OUTPUT maybeFile) : _) = maybeFile getOutput (_ : parList) = getOutput parList getPandocOptions :: [Parameter] -> [Parameter] getPandocOptions [] = [] getPandocOptions ((OPTION opt) : parList) = (OPTION opt) : (getPandocOptions parList) getPandocOptions (_ : parList) = getPandocOptions parList
setReadfrom :: [Parameter] -> Format -> [Parameter] setReadfrom [] format = [READFROM format] setReadfrom ((READFROM format') : parList) format = (READFROM format) : parList setReadfrom (par:parList) format = par : (setReadfrom parList format) setWriteto :: [Parameter] -> Format -> [Parameter] setWriteto [] format = [WRITETO format] setWriteto ((WRITETO format') : parList) format = (WRITETO format) : parList setWriteto (par:parList) format = par : (setWriteto parList format) setInput :: [Parameter] -> [FilePath] -> [Parameter] setInput [] files = [INPUT files] setInput ((INPUT files') : parList) files = (INPUT files) : parList setInput (par:parList) files = par : (setInput parList files) setOutput :: [Parameter] -> Maybe FilePath -> [Parameter] setOutput [] maybeFile = [OUTPUT maybeFile] setOutput ((OUTPUT maybeFile') : parList) maybeFile = (OUTPUT maybeFile) : parList setOutput (par:parList) maybeFile = par : (setOutput parList maybeFile)
showParameters :: [Parameter] -> String showParameters parList = showOptions (concat (map toOption parList)) where toOption :: Parameter -> [Option] toOption (INPUT []) = [] toOption (INPUT files) = [("--input", files)] toOption (OUTPUT Nothing) = [] toOption (OUTPUT (Just file)) = [("--output", [file])] toOption (READFROM format) = [("--from", [format])] toOption (WRITETO format) = [("--to", [format])] toOption (HELP str) = [("--help", [str])] toOption (OPTION (key,values)) = [(key, values)] parseParameters :: String -> [Parameter] parseParameters argStr = case parseOptions argStr of Left mess -> error mess Right opts -> (map toParameter opts) where toParameter :: Option -> Parameter toParameter (key,values) | key `elem` ["-f","-r","--from","--read"] = READFROM (head values) | key `elem` ["-t","-w","--to","--write"] = WRITETO (head values) | key `elem` ["-i","--input"] = INPUT values | key `elem` ["-o","--output"] = OUTPUT (Just (head values)) | key `elem` ["-h","--help"] = if null values then HELP "" else HELP (head values) | otherwise = OPTION (key, values) parseParametersIO :: IO [Parameter] parseParametersIO = do args <- getArgs let argStr = unwords args let parList = parseParameters argStr return parList
A normalization of a given option list (of a codedown call) applies the following hierarchy of rules:
If the option list is empty, the --help option is set.
If a --help option is among the members of the option list, all other options are deleted.
If the --from/--read option is not in the option list, then try to determine the input format from the extension of the (first) file value of the --input option. If that is not possible, either, then set the input format to MARKDOWN.
If the --to/--write option is not in the option list, then try to determine the output format form the extension of the file value of the --output option. If that is not possible, either, then set the input format to MARKDOWN.
normalParameterList :: [Parameter] -> [Parameter] normalParameterList parList = if null parList then [HELP ""] else case getHelp parList of Just str -> [HELP str] Nothing -> let inPar = getInput parList :: [FilePath] outPar = getOutput parList :: Maybe FilePath readPar = case getReadfrom parList of Just format -> format Nothing -> guessReadFormat inPar :: Format writePar = case getWriteto parList of Just format -> format Nothing -> guessWriteFormat outPar :: Format panPar = getPandocOptions parList :: [Parameter] in if null parList then [HELP ""] else case getHelp parList of Just str -> [HELP str] Nothing -> setWriteto (setReadfrom parList readPar) writePar where guessReadFormat :: [FilePath] -> Format guessReadFormat [] = "MARKDOWN" guessReadFormat (file:_) = case codeFileType file of Just format -> format Nothing -> case docFileType file of Just format -> format Nothing -> error "read format cannot be determined" guessWriteFormat :: Maybe FilePath -> Format guessWriteFormat Nothing = "MARKDOWN" guessWriteFormat (Just file) = case docFileType file of Just format -> format Nothing -> case codeFileType file of Just format -> format Nothing -> error "write format cannot be determined" docFileType :: FilePath -> Maybe Format docFileType file = case map toLower $ takeExtension file of ".tex" -> Just "latex" ".latex" -> Just "latex" ".ltx" -> Just "latex" ".context" -> Just "context" ".ctx" -> Just "context" ".rtf" -> Just "rtf" ".rst" -> Just "rst" ".s5" -> Just "s5" ".native" -> Just "native" ".json" -> Just "json" ".txt" -> Just "markdown" ".text" -> Just "markdown" ".md" -> Just "markdown" ".markdown" -> Just "markdown" ".textile" -> Just "textile" ".lhs" -> Just "markdown+lhs" ".texi" -> Just "texinfo" ".texinfo" -> Just "texinfo" ".db" -> Just "docbook" ".odt" -> Just "odt" ".epub" -> Just "epub" ".org" -> Just "org" ".html" -> Just "html" ".htm" -> Just "html" otherwise -> Nothing codeFileType :: FilePath -> Maybe Format codeFileType file = case map toLower $ takeExtension file of ".scm" -> Just "SCHEME" ".ss" -> Just "SCHEME" ".sh" -> Just "BASH" ".tex" -> Just "LATEX_CODE" ".pl" -> Just "PERL" ".py" -> Just "PYTHON" ".rb" -> Just "RUBY" ".sml" -> Just "SML" ".sql" -> Just "SQL" ".html" -> Just "HTML_CODE" ".htm" -> Just "HTML_CODE" ".xhtml" -> Just "HTML_CODE" ".c" -> Just "C" ".cpp" -> Just "CPP" ".java" -> Just "JAVA" ".jav" -> Just "JAVA" ".scala" -> Just "SCALA" ".js" -> Just "JAVASCRIPT" ".php" -> Just "PHP" ".hs" -> Just "HASKELL" ".lisp" -> Just "LISP" ".lsp" -> Just "LISP"
pandoc' :: [Parameter] -> IO () pandoc' parList = let inFiles = getInput parList :: [FilePath] outFile = getOutput parList :: Maybe FilePath pandocOptions = getPandocOptions parList :: [Parameter] inFileString = concat (intersperse "" inFiles) :: String parList' = case getReadfrom parList of Nothing -> setOutput pandocOptions outFile Just format -> setReadfrom (setOutput pandocOptions outFile) format parList'' = case getWriteto parList of Nothing -> parList' Just format -> setWriteto parList' format command = if getWriteto parList == Just "PDF" then "markdown2pdf " ++ (showParameters parList') ++ " " ++ inFileString else "pandoc " ++ (showParameters parList'') ++ " " ++ inFileString in do exitCode <- system command case exitCode of ExitSuccess -> return () ExitFailure n -> error ("ExitFailure " ++ (show n)) pandoc :: String -> IO () pandoc = pandoc' . parseParameters
temporaryMarkdownFile :: [FilePath] -> FilePath temporaryMarkdownFile [] = "TEMP.CODEDOWN.MARKDOWN" temporaryMarkdownFile (file : _) = file ++ ".markdown" codeDown' :: [Parameter] -> IO () codeDown' parList' = let parList = normalParameterList parList' in case getHelp parList of Just str -> printHelp str Nothing -> let readForm = fromJust $ getReadfrom parList :: Format writeForm = fromJust $ getWriteto parList :: Format inFiles = getInput parList :: [FilePath] outFile = getOutput parList :: Maybe FilePath in case (typeOfText readForm, typeOfText writeForm) of (CODE, MARKDOWN) -> if readForm == "CODE" then pureCodeToMarkdownIO inFiles outFile else codeToMarkdownIO readForm inFiles outFile (MARKDOWN, CODE) -> if writeForm == "CODE" then markdownToPureCodeIO inFiles outFile else markdownToCodeIO writeForm inFiles outFile (CODE, DOCUMENT) -> let tmp = temporaryMarkdownFile inFiles parList1 = setOutput (setWriteto parList "MARKDOWN") (Just tmp) parList2 = setInput (setReadfrom parList "MARKDOWN") [tmp] in do codeDown' parList1 pandoc' parList2 putStrLn ("Intermediate Markdown file was created: " ++ tmp) (DOCUMENT, CODE) -> let tmp = temporaryMarkdownFile inFiles parList1 = setOutput (setWriteto parList "MARKDOWN") (Just tmp) parList2 = setInput (setReadfrom parList "MARKDOWN") [tmp] in do pandoc' parList1 codeDown' parList2 putStrLn ("Intermediate Markdown file was created: " ++ tmp) (DOCUMENT, DOCUMENT) -> pandoc' parList (DOCUMENT, MARKDOWN) -> pandoc' parList (MARKDOWN, DOCUMENT) -> pandoc' parList (CODE, CODE) -> print "Read and write format are both types of codes." (MARKDOWN, MARKDOWN) -> print "Read and write format are both Markdown." codeDown :: String -> IO () codeDown = codeDown' . parseParameters codeDownIO :: IO () codeDownIO = do parList <- parseParametersIO let normParList = normalParameterList parList codeDown' normParList
printHelp :: String -> IO () printHelp str | str' == "CODES" = putStrLn $ concat $ intersperse ", " typeOfCodeNameList | str' == "DOCS" = putStrLn $ concat $ intersperse ", " listOfSupportedDocumentTypes | str' == "SYMBOLS" = printSymbolismTable | str' == "VERSION" = putStrLn $ "CodeDown version " ++ codeDownVersion ++ ", Pandoc version " ++ pandocVersion | str' == "PANDOC" = do exitCode <- system "pandoc --help" case exitCode of ExitSuccess -> return () ExitFailure n -> error ("Error when trying to call: pandoc --help") | isCodeName = printCodeHelp str' | otherwise = putStrLn showGeneralHelp where str' = map toUpper str isCodeName = str' `elem` typeOfCodeNameList codeDownVersion :: String codeDownVersion = "1.0" listOfSupportedDocumentTypes :: [Format] listOfSupportedDocumentTypes = ["HTML", "DOCBOOK", "OPENDOCUMENT", "LATEX", "CONTEXT", "MAN", "MARKDOWN", "RST", "MEDIAWIKI", "TEXTILE", "RTF", "ORG", "ODT", "EPUB", "PDF"] showGeneralHelp :: String showGeneralHelp = let tocList = concat $ intersperse ", " $ map (map toLower) typeOfCodeNameList docList = concat $ intersperse ", " $ map (map toLower) listOfSupportedDocumentTypes in unlines [ "SYNTAX:", " codedown OPTION_1 OPTION_2 ... OPTION_N ", "TYPES OF CODE:", " " ++ tocList, "TYPES OF DOCUMENTS:", " " ++ docList, "HELP OPTIONS:", " --help -h this general help message", " --help=codes -h codes list of supported types of codes", " --help=docs -h docs list of supported document type formats", " --help=symbols -h symbols prints the table of code types symbols", " --help=version -h version print the current version numbers of codedown and pandoc", " --help=pandoc -h pandoc same as: pandoc --help", " --help=CODE -h CODE the CodeDown rules for specified type of CODE", "CORE OPTIONS:", " --from=FORMAT -f FORMAT --read=FORMAT -r FORMAT specifies the FORMAT of the source", " --to=FORMAT -t FORMAT --write=FORMAT -w FORMAT specifies the FORMAT of the target", " --input=FILE_1,...,FILE_N -i FILE_1 ... FILE_N the input source files", " --output=FILE -o FILE the output targe file", "ADDITIONAL PANDOC OPTIONS: (see `pandoc --help` for many more):", " --standalone -s produce a whole document, with header etc.", " --html5 -5 produce HTML5 instead of HTML4", " --number-sections -N number the headings", " --table-of-contents --toc include an automatically generated table of contents", " --css=URL -c URL use URL as CSS stylesheet", "LINKS:", " http://bucephalus.org/CodeDown", " http://johnmacfarlane.net/pandoc" ]