bed5f70 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: extract meta parsing code to module

bed5f70Albert Krewinkel10 years ago

pandoc.cabal+1

compare with master

unifiedsplit

@@ -401,6 +401,7 @@ Library

401 Text.Pandoc.Readers.Org.Blocks,

402 Text.Pandoc.Readers.Org.ExportSettings,

403 Text.Pandoc.Readers.Org.Inlines,

404+ Text.Pandoc.Readers.Org.Meta,

404 Text.Pandoc.Readers.Org.ParserState,

405 Text.Pandoc.Readers.Org.ParserState,

405 Text.Pandoc.Readers.Org.Parsing,

406 Text.Pandoc.Readers.Org.Parsing,

406 Text.Pandoc.Readers.Org.Shared,

407 Text.Pandoc.Readers.Org.Shared,

src/Text/Pandoc/Readers/Org/Blocks.hs+1−64

@@ -34,8 +34,8 @@ module Text.Pandoc.Readers.Org.Blocks

34 ) where

36import Text.Pandoc.Readers.Org.BlockStarts

37−import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )

38import Text.Pandoc.Readers.Org.Inlines

37import Text.Pandoc.Readers.Org.Inlines

38+import Text.Pandoc.Readers.Org.Meta ( metaLine )

39import Text.Pandoc.Readers.Org.ParserState

40import Text.Pandoc.Readers.Org.Parsing

41import Text.Pandoc.Readers.Org.Shared

@@ -52,9 +52,7 @@ import Text.Pandoc.Shared ( compactify', compactify'DL )

52import Control.Monad ( foldM, guard, mzero, void )

53import Data.Char ( isSpace, toLower, toUpper)

54import Data.List ( foldl', intersperse, isPrefixOf )

55−import qualified Data.Map as M

56import Data.Maybe ( fromMaybe, isNothing )

55import Data.Maybe ( fromMaybe, isNothing )

57−import Network.HTTP ( urlEncode )

59--

57--

60-- Org headers

58-- Org headers

@@ -631,67 +629,9 @@ exampleCode = B.codeBlockWith ("", ["example"], [])

631specialLine :: OrgParser (F Blocks)

629specialLine :: OrgParser (F Blocks)

632specialLine = fmap return . try $ metaLine <|> commentLine

630specialLine = fmap return . try $ metaLine <|> commentLine

633

631

634−-- The order, in which blocks are tried, makes sure that we're not looking at

635−-- the beginning of a block, so we don't need to check for it

636−metaLine :: OrgParser Blocks

637−metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)

638−

639commentLine :: OrgParser Blocks

632commentLine :: OrgParser Blocks

640commentLine = commentLineStart *> anyLine *> pure mempty

633commentLine = commentLineStart *> anyLine *> pure mempty

641

634

642−declarationLine :: OrgParser ()

643−declarationLine = try $ do

644− key <- metaKey

645− value <- metaInlines

646− updateState $ \st ->

647− let meta' = B.setMeta key <$> value <*> pure nullMeta

648− in st { orgStateMeta = orgStateMeta st <> meta' }

649−

650−metaInlines :: OrgParser (F MetaValue)

651−metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline

652−

653−metaKey :: OrgParser String

654−metaKey = map toLower <$> many1 (noneOf ": \n\r")

655− <* char ':'

656− <* skipSpaces

657−

658−optionLine :: OrgParser ()

659−optionLine = try $ do

660− key <- metaKey

661− case key of

662− "link" -> parseLinkFormat >>= uncurry addLinkFormat

663− "options" -> exportSettings

664− _ -> mzero

665−

666−addLinkFormat :: String

667− -> (String -> String)

668− -> OrgParser ()

669−addLinkFormat key formatter = updateState $ \s ->

670− let fs = orgStateLinkFormatters s

671− in s{ orgStateLinkFormatters = M.insert key formatter fs }

672−

673−parseLinkFormat :: OrgParser ((String, String -> String))

674−parseLinkFormat = try $ do

675− linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces

676− linkSubst <- parseFormat

677− return (linkType, linkSubst)

678−

679−-- | An ad-hoc, single-argument-only implementation of a printf-style format

680−-- parser.

681−parseFormat :: OrgParser (String -> String)

682−parseFormat = try $ do

683− replacePlain <|> replaceUrl <|> justAppend

684− where

685− -- inefficient, but who cares

686− replacePlain = try $ (\x -> concat . flip intersperse x)

687− <$> sequence [tillSpecifier 's', rest]

688− replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)

689− <$> sequence [tillSpecifier 'h', rest]

690− justAppend = try $ (++) <$> rest

691−

692− rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")

693− tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))

694−

695

635

696--

636--

697-- Tables

637-- Tables

@@ -868,9 +808,6 @@ paraOrPlain = try $ do

868 *> return (B.para <$> ils))

808 *> return (B.para <$> ils))

869 <|> (return (B.plain <$> ils))

809 <|> (return (B.plain <$> ils))

870

810

871−inlinesTillNewline :: OrgParser (F Inlines)

872−inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline

873−

874

811

875--

812--

876-- list blocks

813-- list blocks

src/Text/Pandoc/Readers/Org/Meta.hsnew file+110

@@ -0,0 +1,110 @@

1+{-# LANGUAGE FlexibleContexts #-}

2+{-

5+This program is free software; you can redistribute it and/or modify

6+it under the terms of the GNU General Public License as published by

7+the Free Software Foundation; either version 2 of the License, or

8+(at your option) any later version.

10+This program is distributed in the hope that it will be useful,

11+but WITHOUT ANY WARRANTY; without even the implied warranty of

12+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

13+GNU General Public License for more details.

14+

15+You should have received a copy of the GNU General Public License

16+along with this program; if not, write to the Free Software

17+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

18+-}

19+

20+{- |

21+ Module : Text.Pandoc.Readers.Org.Meta

23+ License : GNU GPL, version 2 or above

24+

25+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>

26+

27+Parsers for Org-mode meta declarations.

28+-}

29+module Text.Pandoc.Readers.Org.Meta

30+ ( metaLine

31+ ) where

32+

33+import Text.Pandoc.Readers.Org.BlockStarts

34+import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )

35+import Text.Pandoc.Readers.Org.Inlines

36+import Text.Pandoc.Readers.Org.ParserState

37+import Text.Pandoc.Readers.Org.Parsing

38+

39+import qualified Text.Pandoc.Builder as B

40+import Text.Pandoc.Builder ( Blocks, Inlines )

41+import Text.Pandoc.Definition

42+import Text.Pandoc.Compat.Monoid ((<>))

43+

44+import Control.Monad ( mzero )

45+import Data.Char ( toLower )

46+import Data.List ( intersperse )

47+import qualified Data.Map as M

48+import Network.HTTP ( urlEncode )

49+

50+-- | Parse and handle a single line containing meta information

51+-- The order, in which blocks are tried, makes sure that we're not looking at

52+-- the beginning of a block, so we don't need to check for it

53+metaLine :: OrgParser Blocks

54+metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)

55+

56+declarationLine :: OrgParser ()

57+declarationLine = try $ do

58+ key <- metaKey

59+ value <- metaInlines

60+ updateState $ \st ->

61+ let meta' = B.setMeta key <$> value <*> pure nullMeta

62+ in st { orgStateMeta = orgStateMeta st <> meta' }

63+

64+metaInlines :: OrgParser (F MetaValue)

65+metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline

66+

67+metaKey :: OrgParser String

68+metaKey = map toLower <$> many1 (noneOf ": \n\r")

69+ <* char ':'

70+ <* skipSpaces

71+

72+optionLine :: OrgParser ()

73+optionLine = try $ do

74+ key <- metaKey

75+ case key of

76+ "link" -> parseLinkFormat >>= uncurry addLinkFormat

77+ "options" -> exportSettings

78+ _ -> mzero

79+

80+addLinkFormat :: String

81+ -> (String -> String)

82+ -> OrgParser ()

83+addLinkFormat key formatter = updateState $ \s ->

84+ let fs = orgStateLinkFormatters s

85+ in s{ orgStateLinkFormatters = M.insert key formatter fs }

86+

87+parseLinkFormat :: OrgParser ((String, String -> String))

88+parseLinkFormat = try $ do

89+ linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces

90+ linkSubst <- parseFormat

91+ return (linkType, linkSubst)

92+

93+-- | An ad-hoc, single-argument-only implementation of a printf-style format

94+-- parser.

95+parseFormat :: OrgParser (String -> String)

96+parseFormat = try $ do

97+ replacePlain <|> replaceUrl <|> justAppend

98+ where

99+ -- inefficient, but who cares

100+ replacePlain = try $ (\x -> concat . flip intersperse x)

101+ <$> sequence [tillSpecifier 's', rest]

102+ replaceUrl = try $ (\x -> concat . flip intersperse x . urlEncode)

103+ <$> sequence [tillSpecifier 'h', rest]

104+ justAppend = try $ (++) <$> rest

105+

106+ rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")

107+ tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))

108+

109+inlinesTillNewline :: OrgParser (F Inlines)

110+inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline