% The `PandocCodeDown.hs` module % bucephalus.org % August 2011 # The Implementation ## The header > module 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 ## Imported modules > 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) ## Formats > 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 ## Parameter types > 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) ## Get functions for paramters > 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 ## Set functions for parameter lists > 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) ## Showing and parsing parameter > 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 ## Normalization of parameter lists A normalization of a given option list (of a `codedown` call) applies the following hierarchy of rules: 1. If the option list is empty, the `--help` option is set. 2. If a `--help` option is among the members of the option list, all other options are deleted. 3. 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`. 4. 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" ## The Pandoc call functions > 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 ## The main CodeDown functions > 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 ## The help function > 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" ]