{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Aeson (encode)
import Data.Spreadsheet as S
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 qualified Data.Text as T
import Data.Version (showVersion)
import Network.HTTP.Conduit
import Paths_pandoc_placetable (version)
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.Builder ( Inlines
, Blocks
, doc
, toList
, fromList
, table
, plain
, str
, divWith )
#if defined(INLINE_MARKDOWN)
import Text.Pandoc.Class (runPure)
import Text.Pandoc.Extensions (getDefaultExtensions)
import Text.Pandoc.Readers.Markdown
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
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 :: [(T.Text, T.Text)] -> [String]
kvsToArgs [] = []
kvsToArgs ((k,v):rest) = ("--" ++ T.unpack k) : T.unpack v : (kvsToArgs rest)
httpConduitManager :: IO Manager
httpConduitManager = newManager tlsManagerSettings
placeTable :: Block -> IO [Block]
placeTable (CodeBlock (ident, cls, kvs) txt) | "table" `elem` cls = do
(opts, _) <- rawArgsToOpts $ kvsToArgs kvs
csv <- fromMaybe (return "") (optCsv opts)
let s = if T.null txt
then csv
else T.unpack txt ++ "\n" ++ csv
let csvTable = csvToTable opts s
return $ toList $ if T.null ident && null kvs'
then csvTable
else divWith (ident,cls,kvs') csvTable
where
kvs' = filter (\(k,_) -> k `notElem` optWhitelist) kvs
optWhitelist = concatMap getNames options
getNames (Option _ ns _ _) = map T.pack ns
placeTable a = return [a]
-- | 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 (optQuoteChar opts) (optDelimiter opts) csv
rows' = case exception exc of
Nothing -> result exc
Just e -> [["Error parsing CSV: " ++ e]]
(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 calculatedWidth
cellspecs = zip (optAligns opts) widths'
#if defined(INLINE_MARKDOWN)
readerOpts = def {readerExtensions = getDefaultExtensions "markdown"}
strToInlines s =
if optInlineMarkdown opts
then
-- strip newlines and wrap s in a header so only inline syntax is parsed
let s' = "# " ++ (concat $ lines s)
extractIns (Header _ _ ins) = ins
extractIns _ = []
in case runPure (readMarkdown readerOpts $ T.pack s') of
Right (Pandoc _ bs) -> fromList $ extractIns $ head bs
Left e -> str $ show e
else
if null s
then mempty
else str s
strToBlocks s =
if optInlineMarkdown opts
then
case runPure (readMarkdown readerOpts $ T.pack s) of
Right (Pandoc _ bs) -> fromList bs
Left e -> plain $ str $ show e
else
if null s
then mempty
else plain $ str s
#else
strToInlines [] = mempty
strToInlines s = str $ T.pack s
strToBlocks [] = mempty
strToBlocks s = plain $ str $ T.pack s
#endif