|
Packit |
dda32d |
{-# LANGUAGE FlexibleContexts #-}
|
|
Packit |
dda32d |
{-# LANGUAGE TupleSections #-}
|
|
Packit |
dda32d |
{-
|
|
Packit |
dda32d |
Copyright (C) 2014-2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
This program is free software; you can redistribute it and/or modify
|
|
Packit |
dda32d |
it under the terms of the GNU General Public License as published by
|
|
Packit |
dda32d |
the Free Software Foundation; either version 2 of the License, or
|
|
Packit |
dda32d |
(at your option) any later version.
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
This program is distributed in the hope that it will be useful,
|
|
Packit |
dda32d |
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit |
dda32d |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
Packit |
dda32d |
GNU General Public License for more details.
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
You should have received a copy of the GNU General Public License
|
|
Packit |
dda32d |
along with this program; if not, write to the Free Software
|
|
Packit |
dda32d |
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
Packit |
dda32d |
-}
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
{- |
|
|
Packit |
dda32d |
Module : Text.Pandoc.Readers.Org.Meta
|
|
Packit |
dda32d |
Copyright : Copyright (C) 2014-2017 Albert Krewinkel
|
|
Packit |
dda32d |
License : GNU GPL, version 2 or above
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
Parsers for Org-mode meta declarations.
|
|
Packit |
dda32d |
-}
|
|
Packit |
dda32d |
module Text.Pandoc.Readers.Org.Meta
|
|
Packit |
dda32d |
( metaExport
|
|
Packit |
dda32d |
, metaKey
|
|
Packit |
dda32d |
, metaLine
|
|
Packit |
dda32d |
) where
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
import Text.Pandoc.Readers.Org.BlockStarts
|
|
Packit |
dda32d |
import Text.Pandoc.Readers.Org.ExportSettings (exportSettings)
|
|
Packit |
dda32d |
import Text.Pandoc.Readers.Org.Inlines
|
|
Packit |
dda32d |
import Text.Pandoc.Readers.Org.ParserState
|
|
Packit |
dda32d |
import Text.Pandoc.Readers.Org.Parsing
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
import Text.Pandoc.Builder (Blocks, Inlines)
|
|
Packit |
dda32d |
import qualified Text.Pandoc.Builder as B
|
|
Packit |
dda32d |
import Text.Pandoc.Class (PandocMonad)
|
|
Packit |
dda32d |
import Text.Pandoc.Definition
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
import Control.Monad (mzero, void, when)
|
|
Packit |
dda32d |
import Data.Char (toLower)
|
|
Packit |
dda32d |
import Data.List (intersperse)
|
|
Packit |
dda32d |
import qualified Data.Map as M
|
|
Packit |
dda32d |
import Network.HTTP (urlEncode)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
-- | Returns the current meta, respecting export options.
|
|
Packit |
dda32d |
metaExport :: Monad m => OrgParser m (F Meta)
|
|
Packit |
dda32d |
metaExport = do
|
|
Packit |
dda32d |
st <- getState
|
|
Packit |
dda32d |
let settings = orgStateExportSettings st
|
|
Packit |
dda32d |
return $ (if exportWithAuthor settings then id else removeMeta "author")
|
|
Packit |
dda32d |
. (if exportWithCreator settings then id else removeMeta "creator")
|
|
Packit |
dda32d |
. (if exportWithEmail settings then id else removeMeta "email")
|
|
Packit |
dda32d |
<$> orgStateMeta st
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
removeMeta :: String -> Meta -> Meta
|
|
Packit |
dda32d |
removeMeta key meta' =
|
|
Packit |
dda32d |
let metaMap = unMeta meta'
|
|
Packit |
dda32d |
in Meta $ M.delete key metaMap
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
-- | Parse and handle a single line containing meta information
|
|
Packit |
dda32d |
-- The order, in which blocks are tried, makes sure that we're not looking at
|
|
Packit |
dda32d |
-- the beginning of a block, so we don't need to check for it
|
|
Packit |
dda32d |
metaLine :: PandocMonad m => OrgParser m Blocks
|
|
Packit |
dda32d |
metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
declarationLine :: PandocMonad m => OrgParser m ()
|
|
Packit |
dda32d |
declarationLine = try $ do
|
|
Packit |
dda32d |
key <- map toLower <$> metaKey
|
|
Packit |
dda32d |
(key', value) <- metaValue key
|
|
Packit |
dda32d |
let addMetaValue st =
|
|
Packit |
dda32d |
st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
|
|
Packit |
dda32d |
when (key' /= "results") $ updateState addMetaValue
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
metaKey :: Monad m => OrgParser m String
|
|
Packit |
dda32d |
metaKey = map toLower <$> many1 (noneOf ": \n\r")
|
|
Packit |
dda32d |
<* char ':'
|
|
Packit |
dda32d |
<* skipSpaces
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
metaValue :: PandocMonad m => String -> OrgParser m (String, F MetaValue)
|
|
Packit |
dda32d |
metaValue key =
|
|
Packit |
dda32d |
let inclKey = "header-includes"
|
|
Packit |
dda32d |
in case key of
|
|
Packit |
dda32d |
"author" -> (key,) <$> metaInlinesCommaSeparated
|
|
Packit |
dda32d |
"keywords" -> (key,) <$> metaInlinesCommaSeparated
|
|
Packit |
dda32d |
"title" -> (key,) <$> metaInlines
|
|
Packit |
dda32d |
"subtitle" -> (key,) <$> metaInlines
|
|
Packit |
dda32d |
"date" -> (key,) <$> metaInlines
|
|
Packit |
dda32d |
"nocite" -> (key,) <$> accumulatingList key metaInlines
|
|
Packit |
dda32d |
"header-includes" -> (key,) <$> accumulatingList key metaInlines
|
|
Packit |
dda32d |
"latex_header" -> (inclKey,) <$>
|
|
Packit |
dda32d |
accumulatingList inclKey (metaExportSnippet "latex")
|
|
Packit |
dda32d |
"latex_class" -> ("documentclass",) <$> metaString
|
|
Packit |
dda32d |
-- Org-mode expects class options to contain the surrounding brackets,
|
|
Packit |
dda32d |
-- pandoc does not.
|
|
Packit |
dda32d |
"latex_class_options" -> ("classoption",) <$>
|
|
Packit |
dda32d |
metaModifiedString (filter (`notElem` "[]"))
|
|
Packit |
dda32d |
"html_head" -> (inclKey,) <$>
|
|
Packit |
dda32d |
accumulatingList inclKey (metaExportSnippet "html")
|
|
Packit |
dda32d |
_ -> (key,) <$> metaString
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
metaInlines :: PandocMonad m => OrgParser m (F MetaValue)
|
|
Packit |
dda32d |
metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
metaInlinesCommaSeparated :: PandocMonad m => OrgParser m (F MetaValue)
|
|
Packit |
dda32d |
metaInlinesCommaSeparated = do
|
|
Packit |
dda32d |
itemStrs <- many1 (noneOf ",\n") `sepBy1` char ','
|
|
Packit |
dda32d |
newline
|
|
Packit |
dda32d |
items <- mapM (parseFromString inlinesTillNewline . (++ "\n")) itemStrs
|
|
Packit |
dda32d |
let toMetaInlines = MetaInlines . B.toList
|
|
Packit |
dda32d |
return $ MetaList . map toMetaInlines <$> sequence items
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
metaString :: Monad m => OrgParser m (F MetaValue)
|
|
Packit |
dda32d |
metaString = metaModifiedString id
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
metaModifiedString :: Monad m => (String -> String) -> OrgParser m (F MetaValue)
|
|
Packit |
dda32d |
metaModifiedString f = return . MetaString . f <$> anyLine
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
-- | Read an format specific meta definition
|
|
Packit |
dda32d |
metaExportSnippet :: Monad m => String -> OrgParser m (F MetaValue)
|
|
Packit |
dda32d |
metaExportSnippet format =
|
|
Packit |
dda32d |
return . MetaInlines . B.toList . B.rawInline format <$> anyLine
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
-- | Accumulate the result of the @parser@ in a list under @key@.
|
|
Packit |
dda32d |
accumulatingList :: Monad m => String
|
|
Packit |
dda32d |
-> OrgParser m (F MetaValue)
|
|
Packit |
dda32d |
-> OrgParser m (F MetaValue)
|
|
Packit |
dda32d |
accumulatingList key p = do
|
|
Packit |
dda32d |
value <- p
|
|
Packit |
dda32d |
meta' <- orgStateMeta <$> getState
|
|
Packit |
dda32d |
return $ (\m v -> MetaList (curList m ++ [v])) <$> meta' <*> value
|
|
Packit |
dda32d |
where curList m = case lookupMeta key m of
|
|
Packit |
dda32d |
Just (MetaList ms) -> ms
|
|
Packit |
dda32d |
Just x -> [x]
|
|
Packit |
dda32d |
_ -> []
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
--
|
|
Packit |
dda32d |
-- export options
|
|
Packit |
dda32d |
--
|
|
Packit |
dda32d |
optionLine :: Monad m => OrgParser m ()
|
|
Packit |
dda32d |
optionLine = try $ do
|
|
Packit |
dda32d |
key <- metaKey
|
|
Packit |
dda32d |
case key of
|
|
Packit |
dda32d |
"link" -> parseLinkFormat >>= uncurry addLinkFormat
|
|
Packit |
dda32d |
"options" -> exportSettings
|
|
Packit |
dda32d |
"todo" -> todoSequence >>= updateState . registerTodoSequence
|
|
Packit |
dda32d |
"seq_todo" -> todoSequence >>= updateState . registerTodoSequence
|
|
Packit |
dda32d |
"typ_todo" -> todoSequence >>= updateState . registerTodoSequence
|
|
Packit |
dda32d |
"macro" -> macroDefinition >>= updateState . registerMacro
|
|
Packit |
dda32d |
_ -> mzero
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
addLinkFormat :: Monad m => String
|
|
Packit |
dda32d |
-> (String -> String)
|
|
Packit |
dda32d |
-> OrgParser m ()
|
|
Packit |
dda32d |
addLinkFormat key formatter = updateState $ \s ->
|
|
Packit |
dda32d |
let fs = orgStateLinkFormatters s
|
|
Packit |
dda32d |
in s{ orgStateLinkFormatters = M.insert key formatter fs }
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
parseLinkFormat :: Monad m => OrgParser m (String, String -> String)
|
|
Packit |
dda32d |
parseLinkFormat = try $ do
|
|
Packit |
dda32d |
linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
|
|
Packit |
dda32d |
linkSubst <- parseFormat
|
|
Packit |
dda32d |
return (linkType, linkSubst)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
-- | An ad-hoc, single-argument-only implementation of a printf-style format
|
|
Packit |
dda32d |
-- parser.
|
|
Packit |
dda32d |
parseFormat :: Monad m => OrgParser m (String -> String)
|
|
Packit |
dda32d |
parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend
|
|
Packit |
dda32d |
where
|
|
Packit |
dda32d |
-- inefficient, but who cares
|
|
Packit |
dda32d |
replacePlain = try $ (\x -> concat . flip intersperse x)
|
|
Packit |
dda32d |
<$> sequence [tillSpecifier 's', rest]
|
|
Packit |
dda32d |
replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)
|
|
Packit |
dda32d |
<$> sequence [tillSpecifier 'h', rest]
|
|
Packit |
dda32d |
justAppend = try $ (++) <$> rest
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
|
|
Packit |
dda32d |
tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
inlinesTillNewline :: PandocMonad m => OrgParser m (F Inlines)
|
|
Packit |
dda32d |
inlinesTillNewline = do
|
|
Packit |
dda32d |
updateLastPreCharPos
|
|
Packit |
dda32d |
trimInlinesF . mconcat <$> manyTill inline newline
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
--
|
|
Packit |
dda32d |
-- ToDo Sequences and Keywords
|
|
Packit |
dda32d |
--
|
|
Packit |
dda32d |
todoSequence :: Monad m => OrgParser m TodoSequence
|
|
Packit |
dda32d |
todoSequence = try $ do
|
|
Packit |
dda32d |
todoKws <- todoKeywords
|
|
Packit |
dda32d |
doneKws <- optionMaybe $ todoDoneSep *> todoKeywords
|
|
Packit |
dda32d |
newline
|
|
Packit |
dda32d |
-- There must be at least one DONE keyword. The last TODO keyword is taken if
|
|
Packit |
dda32d |
-- necessary.
|
|
Packit |
dda32d |
case doneKws of
|
|
Packit |
dda32d |
Just done -> return $ keywordsToSequence todoKws done
|
|
Packit |
dda32d |
Nothing -> case reverse todoKws of
|
|
Packit |
dda32d |
[] -> mzero -- no keywords present
|
|
Packit |
dda32d |
(x:xs) -> return $ keywordsToSequence (reverse xs) [x]
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
where
|
|
Packit |
dda32d |
todoKeywords :: Monad m => OrgParser m [String]
|
|
Packit |
dda32d |
todoKeywords = try $
|
|
Packit |
dda32d |
let keyword = many1 nonspaceChar <* skipSpaces
|
|
Packit |
dda32d |
endOfKeywords = todoDoneSep <|> void newline
|
|
Packit |
dda32d |
in manyTill keyword (lookAhead endOfKeywords)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
todoDoneSep :: Monad m => OrgParser m ()
|
|
Packit |
dda32d |
todoDoneSep = void . try $ skipSpaces *> char '|' <* skipSpaces1
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
keywordsToSequence :: [String] -> [String] -> TodoSequence
|
|
Packit |
dda32d |
keywordsToSequence todo done =
|
|
Packit |
dda32d |
let todoMarkers = map (TodoMarker Todo) todo
|
|
Packit |
dda32d |
doneMarkers = map (TodoMarker Done) done
|
|
Packit |
dda32d |
in todoMarkers ++ doneMarkers
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
macroDefinition :: Monad m => OrgParser m (String, [String] -> String)
|
|
Packit |
dda32d |
macroDefinition = try $ do
|
|
Packit |
dda32d |
macroName <- many1 nonspaceChar <* skipSpaces
|
|
Packit |
dda32d |
firstPart <- expansionPart
|
|
Packit |
dda32d |
(elemOrder, parts) <- unzip <$> many ((,) <$> placeholder <*> expansionPart)
|
|
Packit |
dda32d |
let expander = mconcat . alternate (firstPart:parts) . reorder elemOrder
|
|
Packit |
dda32d |
return (macroName, expander)
|
|
Packit |
dda32d |
where
|
|
Packit |
dda32d |
placeholder :: Monad m => OrgParser m Int
|
|
Packit |
dda32d |
placeholder = try . fmap read $ char '$' *> many1 digit
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
expansionPart :: Monad m => OrgParser m String
|
|
Packit |
dda32d |
expansionPart = try $ many (notFollowedBy placeholder *> noneOf "\n\r")
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
alternate :: [a] -> [a] -> [a]
|
|
Packit |
dda32d |
alternate [] ys = ys
|
|
Packit |
dda32d |
alternate xs [] = xs
|
|
Packit |
dda32d |
alternate (x:xs) (y:ys) = x : y : alternate xs ys
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
reorder :: [Int] -> [String] -> [String]
|
|
Packit |
dda32d |
reorder perm xs =
|
|
Packit |
dda32d |
let element n = take 1 $ drop (n - 1) xs
|
|
Packit |
dda32d |
in concatMap element perm
|