diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Daniel Lovasko (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Daniel Lovasko nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Latex.hs b/src/Latex.hs new file mode 100644 --- /dev/null +++ b/src/Latex.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Latex +( render +) where + +import Data.Monoid +import qualified Data.ByteString.Char8 as C +import qualified System.FilePath as F + +-- | Translate an extension into a Minted language name. Note that +-- extensions that are not recognized will be rendered without any +-- syntax highlighting. +translateExt :: String -- ^ file extension + -> C.ByteString -- ^ Minted language +translateExt ext + | ext == "c" || ext == "h" = "c" + | ext == "sh" = "bash" + | ext == "hs" = "haskell" + | ext == "pl" = "perl" + | ext == "py" = "python" + | ext == "rb" = "ruby" + | ext == "java" = "java" + | otherwise = "text" + +-- | Append newline as the last character of a string if it does not end +-- with one. +ensureNewline :: C.ByteString -- ^ old string + -> C.ByteString -- ^ new string +ensureNewline str + | C.null str = str + | C.last str == '\n' = str + | otherwise = str <> "\n" + +-- | All underscores must be escaped in order to prevent the subscript +-- redenring. +escapeUnderscore :: String -- ^ old string + -> String -- ^ new string +escapeUnderscore [] = [] +escapeUnderscore (x:xs) + | x == '_' = '\\':x:escapeUnderscore xs + | otherwise = x:escapeUnderscore xs + +-- | Apply decoration to a single file and its contents. +decorateFile :: (String, C.ByteString) -- ^ file name & content + -> C.ByteString -- ^ decorated file +decorateFile (name, content) = C.unlines + [ "\\section*{" <> name' <> "}" + , "\\addcontentsline{toc}{subsection}{" <> name' <> "}" + , "\\begin{minted}{" <> translateExt (tail $ F.takeExtensions name) <> "}" + , ensureNewline content <> "\\end{minted}" + , "\n" ] + where name' = C.pack $ escapeUnderscore name + +-- | Wrap the document in a standard envelope. +envelope :: String -- ^ project name + -> C.ByteString -- ^ content + -> C.ByteString -- ^ finished document +envelope name content = C.unlines + [ "\\documentclass{article}" + , "\\usepackage{minted}" + , "\\usepackage{fullpage}" + , "\\begin{document}" + , "\\centerline{\\bf{\\Huge{" <> name' <> "}}}" + , "\\bigskip" + , "\\tableofcontents" + , "\\bigskip" + , content + , "\\end{document}" ] + where name' = C.pack $ escapeUnderscore name + +-- | Apply decoration to a whole codebase in order to create a document. +render :: String -- ^ project name + -> [(String, C.ByteString)] -- ^ file names & contents + -> C.ByteString -- ^ final document +render name entries = envelope name (C.unlines $ map decorateFile entries) diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,65 @@ +import Data.List +import Data.List.Split (splitOn) +import Options.Applicative (execParser) +import qualified System.FilePath as F +import qualified System.FilePath.Find as F +import qualified Data.ByteString.Char8 as C + +import Latex +import Markdown +import Options + + +-- | Convert paths to be relative to the project root. +relativePaths :: Options -- ^ command-line options + -> [FilePath] -- ^ absolute file paths + -> [FilePath] -- ^ relative file paths +relativePaths options = map (F.makeRelative (getRootDir options)) + +-- | Generate the contents of the resuling document. +generateOutput :: Options -- ^ command-line options + -> [(String, C.ByteString)] -- ^ file names & contents + -> C.ByteString -- ^ final document +generateOutput options entries = run (getOutputFormat options) + where + run FmtLatex = Latex.render name entries + run FmtMarkdown = Markdown.render name entries + name = getProjectName options + +-- | Sort the file names alphabetically and by the number of path +-- components. +sortNames :: [FilePath] -- ^ file names + -> [FilePath] -- ^ sorted file names +sortNames names = sortBy compSort (sort names) + where + compSort a b = compare (compCount a) (compCount b) + compCount = length . F.splitPath + +-- | Filter predicate to determine relevant file extensions. +acceptExtensions :: Options -- ^ command-line options + -> F.FindClause Bool -- ^ filter predicate +acceptExtensions options + | null exts = return False + | otherwise = foldr (F.||?) (return False) clauses + where + clauses = map (F.extension F.==?) withDots + withDots = map ('.' :) $ filter (not . null) (splitOn "," exts) + exts = getExtensions options + +-- | Find all files that are relevant to the provided options. +findFiles :: Options -- ^ options + -> IO [FilePath] -- ^ file names +findFiles options = do + let recurse = acceptExtensions options + files <- F.find F.always recurse (getRootDir options) + return $ sortNames files + +-- | Pretty-printing of a whole codebase into a document. +main :: IO () +main = do + options <- execParser Options.parser + names <- findFiles options + contents <- mapM C.readFile names + let entries = zip (relativePaths options names) contents + C.writeFile (getOutputFile options) (generateOutput options entries) + diff --git a/src/Markdown.hs b/src/Markdown.hs new file mode 100644 --- /dev/null +++ b/src/Markdown.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Markdown +( render +) where + +import Data.Char +import Data.Monoid +import qualified Data.ByteString.Char8 as C +import qualified System.FilePath as F + + +-- | Translate an extension into a GitHub markdown language name. Note +-- that extensions that are not recognized will be rendered without any +-- syntax highlighting. +translateExt :: String -- ^ file extension + -> C.ByteString -- ^ Markdown language +translateExt ext + | ext == "c" || ext == "h" = "c" + | ext == "sh" = "sh" + | ext == "hs" = "haskell" + | ext == "pl" = "perl" + | ext == "py" = "python" + | ext == "rb" = "ruby" + | ext == "java" = "java" + | otherwise = "" + +-- | Append newline as the last character of a string if it does not end +-- with one. +ensureNewline :: C.ByteString -- ^ old string + -> C.ByteString -- ^ new string +ensureNewline str + | C.null str = str + | C.last str == '\n' = str + | otherwise = str <> "\n" + +-- | Apply decoration to a single file and its contents. +decorateFile :: (String, C.ByteString) -- ^ file name & content + -> C.ByteString -- ^ decorated file +decorateFile (name, content) = C.unlines + [ "## " <> C.pack name + , "```" <> translateExt (tail $ F.takeExtensions name) + , ensureNewline content <> "```" ] + +-- | Generate the "table of contents" section +generateTOC :: [String] -- ^ file names + -> C.ByteString -- ^ section content +generateTOC names = C.unlines (header : map (convert . C.pack) names) + where + header = "### Files" + convert name = "* [" <> name <> "](#" <> linkify name <> ")" + linkify = C.map toLower . C.filter (\c -> isAlpha c || c == '_') + +-- | Apply decoration to a whole codebase in order to create a document. +render :: String -- ^ project name + -> [(String, C.ByteString)] -- ^ file names & contents + -> C.ByteString -- ^ final document +render name entries = C.unlines + ["# " <> C.pack name + , generateTOC $ map fst entries + , C.unlines $ map decorateFile entries ] diff --git a/src/Options.hs b/src/Options.hs new file mode 100644 --- /dev/null +++ b/src/Options.hs @@ -0,0 +1,97 @@ +module Options +( Format(..) +, Options(..) +, parser +) where + +import Data.Monoid +import Options.Applicative + +-- | Output formats. +data Format = FmtLatex -- ^ LaTeX + | FmtMarkdown -- ^ GitHub Flavoured Markdown + +-- | Command-line options. +data Options = Options { getExtensions :: String + , getProjectName :: String + , getOutputFormat :: Format + , getOutputFile :: String + , getRootDir :: String } + +-- | Textual representation of the Format type. +instance Show Format where + show FmtLatex = "latex" + show FmtMarkdown = "markdown" + +-- | Parse a output format name. +formatReader :: String -- ^ input + -> Either String Format -- ^ error message | format +formatReader "latex" = Right FmtLatex +formatReader "markdown" = Right FmtMarkdown +formatReader _ = Left "Format not supported" + +-- | Relevant file extensions options. +optionExtensions :: Parser String -- ^ parser +optionExtensions = strOption + $ short 'e' + <> long "extensions" + <> value "hs" + <> metavar "EXTS" + <> help "Comma-separated list of relevant file extensions" + <> showDefault + +-- | Project name option. +optionProjectName :: Parser String -- ^ parser +optionProjectName = strOption + $ short 'n' + <> long "name" + <> metavar "NAME" + <> help "Name of the codebase. Appears in footers and as a title" + +-- | Output file location option. +optionOutputFile :: Parser String -- ^ parser +optionOutputFile = strOption + $ short 'o' + <> long "output" + <> metavar "PATH" + <> help "Location of the resulting document" + +-- | Output format option. +optionOutputFormat :: Parser Format -- ^ parser +optionOutputFormat = option (eitherReader formatReader) + $ short 'f' + <> long "format" + <> value FmtLatex + <> metavar "FORMAT" + <> help "Format of the resulting document, supported: latex, markdown" + <> showDefault + +-- | Root source directory option. +optionRootDir :: Parser String -- ^ parser +optionRootDir = strOption + $ short 'd' + <> long "root-dir" + <> value "." + <> metavar "PATH" + <> help "Root source directory path" + <> showDefault + +-- | Command-line user interface. +optionsParser :: Parser Options -- ^ parser +optionsParser = Options + <$> optionExtensions + <*> optionProjectName + <*> optionOutputFormat + <*> optionOutputFile + <*> optionRootDir + +-- | Description of the utility. +optionsDescription :: InfoMod Options -- ^ parser description +optionsDescription = + header "wembley - pretty-print a whole codebase into a document" + <> fullDesc + +-- | Parser of the command-line options. +parser :: ParserInfo Options -- ^ parser +parser = info (helper <*> optionsParser) optionsDescription + diff --git a/wembley.cabal b/wembley.cabal new file mode 100644 --- /dev/null +++ b/wembley.cabal @@ -0,0 +1,33 @@ +name: wembley +version: 0.1.0.0 +synopsis: Pretty-printing of codebases +description: Pretty-printing of codebases for the purposes of code + review on paper or publication of a whole codebase + in a document form. +homepage: https://github.com/lovasko/wembley +license: BSD3 +license-file: LICENSE +author: Daniel Lovasko +maintainer: Daniel Lovasko +copyright: 2016 Daniel Lovasko +category: Pretty-printing +build-type: Simple +cabal-version: >=1.10 + +executable wembley + hs-source-dirs: src + main-is: Main.hs + other-modules: Latex + , Markdown + , Options + build-depends: base >= 4.7 && < 5 + , bytestring + , filepath + , filemanip + , optparse-applicative + , split + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/lovasko/wembley