diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/pandoc-placetable.cabal b/pandoc-placetable.cabal --- a/pandoc-placetable.cabal +++ b/pandoc-placetable.cabal @@ -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 diff --git a/pandoc-placetable.hs b/pandoc-placetable.hs --- a/pandoc-placetable.hs +++ b/pandoc-placetable.hs @@ -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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-7.5 +resolver: lts-7.8 packages: - '.'