Org reader: extract meta parsing code to module

Parsing of meta-data is well separable from other block parsing tasks.
Moving into new module to get small files and clearly arranged code.
This commit is contained in:
Albert Krewinkel 2016-08-29 14:10:51 +02:00
parent 500de5e979
commit bed5f700ce
No known key found for this signature in database
GPG key ID: 388DC0B21F631124
3 changed files with 112 additions and 64 deletions

View file

@ -401,6 +401,7 @@ Library
Text.Pandoc.Readers.Org.Blocks,
Text.Pandoc.Readers.Org.ExportSettings,
Text.Pandoc.Readers.Org.Inlines,
Text.Pandoc.Readers.Org.Meta,
Text.Pandoc.Readers.Org.ParserState,
Text.Pandoc.Readers.Org.Parsing,
Text.Pandoc.Readers.Org.Shared,

View file

@ -34,8 +34,8 @@ module Text.Pandoc.Readers.Org.Blocks
) where
import Text.Pandoc.Readers.Org.BlockStarts
import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )
import Text.Pandoc.Readers.Org.Inlines
import Text.Pandoc.Readers.Org.Meta ( metaLine )
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
import Text.Pandoc.Readers.Org.Shared
@ -52,9 +52,7 @@ import Text.Pandoc.Shared ( compactify', compactify'DL )
import Control.Monad ( foldM, guard, mzero, void )
import Data.Char ( isSpace, toLower, toUpper)
import Data.List ( foldl', intersperse, isPrefixOf )
import qualified Data.Map as M
import Data.Maybe ( fromMaybe, isNothing )
import Network.HTTP ( urlEncode )
--
-- Org headers
@ -631,67 +629,9 @@ exampleCode = B.codeBlockWith ("", ["example"], [])
specialLine :: OrgParser (F Blocks)
specialLine = fmap return . try $ metaLine <|> commentLine
-- The order, in which blocks are tried, makes sure that we're not looking at
-- the beginning of a block, so we don't need to check for it
metaLine :: OrgParser Blocks
metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
commentLine :: OrgParser Blocks
commentLine = commentLineStart *> anyLine *> pure mempty
declarationLine :: OrgParser ()
declarationLine = try $ do
key <- metaKey
value <- metaInlines
updateState $ \st ->
let meta' = B.setMeta key <$> value <*> pure nullMeta
in st { orgStateMeta = orgStateMeta st <> meta' }
metaInlines :: OrgParser (F MetaValue)
metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
metaKey :: OrgParser String
metaKey = map toLower <$> many1 (noneOf ": \n\r")
<* char ':'
<* skipSpaces
optionLine :: OrgParser ()
optionLine = try $ do
key <- metaKey
case key of
"link" -> parseLinkFormat >>= uncurry addLinkFormat
"options" -> exportSettings
_ -> mzero
addLinkFormat :: String
-> (String -> String)
-> OrgParser ()
addLinkFormat key formatter = updateState $ \s ->
let fs = orgStateLinkFormatters s
in s{ orgStateLinkFormatters = M.insert key formatter fs }
parseLinkFormat :: OrgParser ((String, String -> String))
parseLinkFormat = try $ do
linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
linkSubst <- parseFormat
return (linkType, linkSubst)
-- | An ad-hoc, single-argument-only implementation of a printf-style format
-- parser.
parseFormat :: OrgParser (String -> String)
parseFormat = try $ do
replacePlain <|> replaceUrl <|> justAppend
where
-- inefficient, but who cares
replacePlain = try $ (\x -> concat . flip intersperse x)
<$> sequence [tillSpecifier 's', rest]
replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)
<$> sequence [tillSpecifier 'h', rest]
justAppend = try $ (++) <$> rest
rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
--
-- Tables
@ -868,9 +808,6 @@ paraOrPlain = try $ do
*> return (B.para <$> ils))
<|> (return (B.plain <$> ils))
inlinesTillNewline :: OrgParser (F Inlines)
inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline
--
-- list blocks

View file

@ -0,0 +1,110 @@
{-# LANGUAGE FlexibleContexts #-}
{-
Copyright (C) 2014-2016 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- |
Module : Text.Pandoc.Readers.Org.Meta
Copyright : Copyright (C) 2014-2016 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Parsers for Org-mode meta declarations.
-}
module Text.Pandoc.Readers.Org.Meta
( metaLine
) where
import Text.Pandoc.Readers.Org.BlockStarts
import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )
import Text.Pandoc.Readers.Org.Inlines
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Builder ( Blocks, Inlines )
import Text.Pandoc.Definition
import Text.Pandoc.Compat.Monoid ((<>))
import Control.Monad ( mzero )
import Data.Char ( toLower )
import Data.List ( intersperse )
import qualified Data.Map as M
import Network.HTTP ( urlEncode )
-- | Parse and handle a single line containing meta information
-- The order, in which blocks are tried, makes sure that we're not looking at
-- the beginning of a block, so we don't need to check for it
metaLine :: OrgParser Blocks
metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
declarationLine :: OrgParser ()
declarationLine = try $ do
key <- metaKey
value <- metaInlines
updateState $ \st ->
let meta' = B.setMeta key <$> value <*> pure nullMeta
in st { orgStateMeta = orgStateMeta st <> meta' }
metaInlines :: OrgParser (F MetaValue)
metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
metaKey :: OrgParser String
metaKey = map toLower <$> many1 (noneOf ": \n\r")
<* char ':'
<* skipSpaces
optionLine :: OrgParser ()
optionLine = try $ do
key <- metaKey
case key of
"link" -> parseLinkFormat >>= uncurry addLinkFormat
"options" -> exportSettings
_ -> mzero
addLinkFormat :: String
-> (String -> String)
-> OrgParser ()
addLinkFormat key formatter = updateState $ \s ->
let fs = orgStateLinkFormatters s
in s{ orgStateLinkFormatters = M.insert key formatter fs }
parseLinkFormat :: OrgParser ((String, String -> String))
parseLinkFormat = try $ do
linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
linkSubst <- parseFormat
return (linkType, linkSubst)
-- | An ad-hoc, single-argument-only implementation of a printf-style format
-- parser.
parseFormat :: OrgParser (String -> String)
parseFormat = try $ do
replacePlain <|> replaceUrl <|> justAppend
where
-- inefficient, but who cares
replacePlain = try $ (\x -> concat . flip intersperse x)
<$> sequence [tillSpecifier 's', rest]
replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)
<$> sequence [tillSpecifier 'h', rest]
justAppend = try $ (++) <$> rest
rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")
tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))
inlinesTillNewline :: OrgParser (F Inlines)
inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline