pandoc-placetable 0.4.1 → 0.4.2
raw patch · 4 files changed
+211/−85 lines, 4 filesdep +aesondep +bytestringdep ~http-conduit
Dependencies added: aeson, bytestring
Dependency ranges changed: http-conduit
Files
- README.md +16/−2
- pandoc-placetable.cabal +5/−3
- pandoc-placetable.hs +189/−79
- stack.yaml +1/−1
README.md view
@@ -29,9 +29,20 @@ ```{.table file="foo.csv" header=yes aligns=LRCRR inlinemarkdown=yes caption="my **caption**" delimiter="," quotechar="\"" } ```-All attributes are optional and are specified as follows: -- **file**: The path or URL to the CSV file that is appended to the code block's content+Alternatively, the program can be used as an ad-hoc csv-reader and run without a markdown file.+Then the options can be provided as command-line arguments. For example:++ $ pandoc-placetable --file=foo.csv --widths="0.2 0.8" | pandoc -f json -o output.html++Or also:++ $ cat foo.csv | pandoc-placetable --widths="0.2 0.8" | pandoc -f json -o output.html++All options are optional and are specified as follows (cf. `pandoc-placetable -h`):++- **csv**: The path or URL to the CSV file that is appended to the code block's content+- **file**: synonym for `csv` - **header**: If set to `yes`, then the first row of data is interpreted as the table headers. - **aligns**: For each column, one letter (L, R or C) that specifies the column's alignment. - **widths**: For each column, a number specifying its width as a fraction of the page width,@@ -57,6 +68,8 @@ ### Using stack + git clone git@github.com:mb21/pandoc-placetable.git+ cd pandoc-placetable stack install pandoc-placetable ### The inlineMarkdown flag@@ -69,6 +82,7 @@ or: + cd pandoc-placetable stack install --flag pandoc-placetable:inlineMarkdown pandoc-placetable ## Usage
pandoc-placetable.cabal view
@@ -1,5 +1,5 @@ Name: pandoc-placetable-Version: 0.4.1+Version: 0.4.2 Build-Type: Simple Synopsis: Pandoc filter to include CSV files Description: A Pandoc filter that replaces code blocks (that have the class `table`)@@ -28,9 +28,11 @@ Executable pandoc-placetable Main-Is: pandoc-placetable.hs- Build-Depends: base >=4.2 && < 5,+ Build-Depends: aeson >= 0.7 && < 1.1,+ base >=4.2 && < 5,+ bytestring >= 0.10, utf8-string >= 1.0,- http-conduit >= 2.1,+ http-conduit >= 2.1.11, spreadsheet >= 0.1.3 && < 0.1.4, explicit-exception == 0.1.*, pandoc-types >= 1.12.0.0
pandoc-placetable.hs view
@@ -1,21 +1,27 @@ {-# LANGUAGE CPP #-} module Main where+import Data.Aeson (encode) import Data.Spreadsheet as S-import Control.Monad.Exception.Asynchronous.Lazy as AsExc import Control.Monad (liftM)+import Control.Monad.Exception.Asynchronous.Lazy as AsExc+import qualified Data.ByteString.Lazy as BS (putStr) import qualified Data.ByteString.Lazy.UTF8 as U+import Data.Maybe (fromMaybe) import Data.Monoid (mempty) import Data.Char (toUpper) import Data.List (isSuffixOf) import Data.Version (showVersion) import Network.HTTP.Conduit import Paths_pandoc_placetable (version)-import System.Environment (getArgs)+import System.Environment (getArgs, getProgName)+import System.Console.GetOpt+import System.Exit (exitWith, ExitCode(..))+import System.IO (hPutStrLn, stderr) import Text.Pandoc.JSON-import Text.Pandoc.Definition import Text.Pandoc.Builder ( Inlines , Blocks+ , doc , toList , fromList , table@@ -28,106 +34,207 @@ import Text.Pandoc.Options #endif ++data Options = Options { optAligns :: [Alignment] -- ^ table column alignments+ , optCaption :: String -- ^ table caption+ , optDelimiter :: Char -- ^ csv field separator like ,+ , optHeader :: Bool -- ^ interpret first row as headers+ , optInlineMarkdown :: Bool -- ^ interpret markdown (needs compile flag)+ , optCsv :: Maybe (IO String)+ , optQuoteChar :: Char -- ^ csv quotation character like "+ , optWidths :: [Double] -- ^ table column widths+ }+++defaultOpts :: Options+defaultOpts = Options { optAligns = repeat AlignDefault+ , optCaption = ""+ , optDelimiter = ','+ , optHeader = False+ , optInlineMarkdown = False+ , optCsv = Nothing+ , optQuoteChar = '"'+ , optWidths = []+ }+++options :: [ OptDescr (Options -> IO Options) ]+options =+ [ Option [] ["aligns"]+ (ReqArg+ (\arg opt -> do+ let toAlign c = case toUpper c of+ 'L' -> AlignLeft+ 'R' -> AlignRight+ 'C' -> AlignCenter+ _ -> AlignDefault+ return opt { optAligns = map toAlign arg } )+ "[L|R|C]+")+ "table column alignments"+ , Option [] ["widths"]+ (ReqArg+ (\arg opt -> do+ return opt { optWidths = map read $ words arg } )+ "[DECIMAL ]+")+ "table column widths"+ , Option [] ["header"]+ (OptArg+ (\arg opt -> do+ return opt { optHeader = maybe True isTruthy arg } )+ "BOOL")+ "interpret first row as headers"+ , Option [] ["inlinemarkdown"]+ (OptArg+ (\arg opt -> do+ return opt { optInlineMarkdown = maybe True isTruthy arg } )+ "BOOL")+ "interpret text in CSV as markdown (needs inlineMarkdown compile flag)"+ , Option [] ["caption"]+ (ReqArg+ (\arg opt -> do+ return opt { optCaption = arg } )+ "STRING")+ "table caption"+ , Option [] ["quotechar"]+ (ReqArg+ (\arg opt -> do+ return opt { optQuoteChar = head arg } )+ "CHAR")+ "csv quotation character like \""+ , Option [] ["delimiter"]+ (ReqArg+ (\arg opt -> do+ let d = if head arg == '\\'+ then case head (tail arg) of+ 't' -> '\t'+ 's' -> ' '+ _ -> '\\'+ else head arg+ return opt { optDelimiter = d } )+ "CHAR")+ "csv field separator like ,"+ , Option [] ["csv", "file"]+ (ReqArg+ (\arg opt -> do+ let appendNewline s+ | isSuffixOf "\n" s = s+ | otherwise = s ++ "\n"+ let getCsv = case parseUrlThrow arg of+ Nothing -> readFile arg+ Just req -> do+ mgr <- httpConduitManager+ res <- httpLbs req mgr+ return $ U.toString $ responseBody res+ return opt { optCsv = Just $ liftM appendNewline getCsv } )+ "FILE")+ "csv file or URL"+ , Option "v" ["version"]+ (NoArg+ (\_ -> do+ #if defined(INLINE_MARKDOWN)+ let withInlineMarkdown = "with"+ #else+ let withInlineMarkdown = "without"+ #endif+ hPutStrLn stderr $ unlines [+ "pandoc-placetable " ++ showVersion version+ , "Compiled " ++ withInlineMarkdown ++ " the inlineMarkdown flag."+ , "https://github.com/mb21/pandoc-placetable"+ ]+ exitWith ExitSuccess ))+ "Print version"+ , Option "h" ["help"]+ (NoArg+ (\_ -> do+ prg <- getProgName+ hPutStrLn stderr (usageInfo prg options)+ exitWith ExitSuccess))+ "Show help"+ ]+ where+ isTruthy x = elem x ["yes", "1", "true", "TRUE"]++ main :: IO () main = do-#if defined(INLINE_MARKDOWN)- let withInlineMarkdown = "with"-#else- let withInlineMarkdown = "without"-#endif- args <- getArgs- let hasArg a = a `elem` args- if hasArg "-v" || hasArg "--version" || hasArg "-h" || hasArg "--help"- then putStrLn $ unlines [- "pandoc-placetable " ++ showVersion version- , "Compiled " ++ withInlineMarkdown ++ " the inlineMarkdown flag."- , "https://github.com/mb21/pandoc-placetable"- ]- else toJSONFilter placeTable+ rawArgs <- getArgs+ (opts, args) <- rawArgsToOpts rawArgs + if null args+ then do+ -- either read csv from stdin or if --file option provided form there+ s <- fromMaybe getContents (optCsv opts)+ BS.putStr $ encode $ doc $ csvToTable opts s+ else+ -- if argument provided, assume we are being run as a filter by pandoc+ toJSONFilter placeTable+++rawArgsToOpts :: [String] -> IO (Options, [String])+rawArgsToOpts rawArgs = do+ let (actions, args, _) = getOpt Permute options rawArgs++ -- thread defaultOpts through all supplied option actions+ opts <- foldl (>>=) (return defaultOpts) actions++ return (opts, args)+++-- flatten key-value tuples to commandline argument-like strings+kvsToArgs :: [(String, String)] -> [String]+kvsToArgs [] = []+kvsToArgs ((k,v):rest) = ("--" ++ k) : v : (kvsToArgs rest)++ httpConduitManager :: IO Manager httpConduitManager = newManager tlsManagerSettings + placeTable :: Block -> IO [Block] placeTable (CodeBlock (ident, cls, kvs) txt) | "table" `elem` cls = do- csv <- find "file" (return "") getCsv- let header = find "header" False (== "yes")- let inlinemd = find "inlinemarkdown" False (== "yes")- let aligns = find "aligns" (repeat AlignDefault) (map toAlign)- let widths = find "widths" [] (map read . words)- let capt = find "caption" "" id- let qc = find "quotechar" '"' head- let sep = find "delimiter" ',' $ \d ->- if head d == '\\'- then case head (tail d) of- 't' -> '\t'- 's' -> ' '- _ -> '\\'- else head d- let s' = if null txt- then csv- else txt ++ "\n" ++ csv- let s = if isSuffixOf "\n" s'- then s'- else s' ++ "\n"- let csvTable = csvToTable header inlinemd aligns widths capt qc sep s- return $ toList $ if null ident+ (opts, _) <- rawArgsToOpts $ kvsToArgs kvs+ csv <- fromMaybe (return "") (optCsv opts)+ let s = if null txt+ then csv+ else txt ++ "\n" ++ csv+ let csvTable = csvToTable opts s+ return $ toList $ if null ident && null kvs' then csvTable- else divWith (ident,cls,[]) csvTable+ else divWith (ident,cls,kvs') csvTable where- find key def extract = case lookup key kvs of- Just x -> extract x- Nothing -> def- getCsv url = case parseUrl url of- Nothing -> readFile url- Just req -> do- mgr <- httpConduitManager- res <- httpLbs req mgr- return $ U.toString $ responseBody res- toAlign c = case toUpper c of- 'L' -> AlignLeft- 'R' -> AlignRight- 'C' -> AlignCenter- _ -> AlignDefault+ kvs' = filter (\(k,_) -> not $ elem k $ concatMap getNames options) kvs+ getNames (Option _ ns _ _) = ns placeTable a = return [a] --- | Convert a CSV String to a Pandoc Table-simpleCsvToTable :: String -> Blocks-simpleCsvToTable s = csvToTable False False (repeat AlignDefault) [] mempty '"' ',' s---- | Convert a bunch of options and a CSV String to a Pandoc Table-csvToTable :: Bool -- ^ interpret first row as headers- -> Bool -- ^ interpret as inline markdown (needs inlineMarkdown compile flag)- -> [Alignment] -- ^ table column alignments- -> [Double] -- ^ table column widths- -> String -- ^ table caption- -> Char -- ^ csv quotation character like "- -> Char -- ^ csv field separator like ,- -> String -- ^ csv string to parse- -> Blocks-csvToTable header inlinemd aligns widths caption qc sep s =- table (strToInlines caption) cellspecs (map strToBlocks headers)+-- | Convert options and a CSV String to a Pandoc Table+csvToTable :: Options -> String -> Blocks+csvToTable opts csv =+ table (strToInlines $ optCaption opts) cellspecs (map strToBlocks headers) $ (map . map) strToBlocks rows where- exc = S.fromString qc sep s+ exc = S.fromString (optQuoteChar opts) (optDelimiter opts) csv rows' = case exception exc of Nothing -> result exc Just e -> [["Error parsing CSV: " ++ e]]- (headers, rows) = if header && length rows' > 0+ (headers, rows) = if optHeader opts && length rows' > 0 then (head rows', tail rows') else (replicate nrCols [], rows') nrCols = if null rows' then 0 else length $ head rows'+ calculatedWidth = if optInlineMarkdown opts+ then 1.0 / fromIntegral nrCols+ else 0 --simulate simple_table+ widths = optWidths opts widths' = if length widths == nrCols then widths- else replicate nrCols 0- cellspecs = zip aligns widths'+ else replicate nrCols calculatedWidth+ cellspecs = zip (optAligns opts) widths' #if defined(INLINE_MARKDOWN) strToInlines s =- if inlinemd+ if optInlineMarkdown opts then -- strip newlines and wrap s in a header so only inline syntax is parsed let s' = "# " ++ (concat $ lines s)@@ -142,15 +249,18 @@ else str s strToBlocks s =- if inlinemd+ if optInlineMarkdown opts then case readMarkdown def s of Right (Pandoc _ bs) -> fromList bs Left e -> plain $ str $ show e else- plain $ str s+ if null s+ then mempty+ else plain $ str s #else strToInlines [] = mempty- strToInlines s = str s- strToBlocks s = plain $ str s+ strToInlines s = str s+ strToBlocks [] = mempty+ strToBlocks s = plain $ str s #endif
stack.yaml view
@@ -1,4 +1,4 @@-resolver: lts-7.5+resolver: lts-7.8 packages: - '.'