From 346bcea713f933a6cf48829d948e14b9c28b4798 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 16 Apr 2014 13:22:48 +0200 Subject: Org reader: Better module description, minor style changes Use module description analogous to the markdown reader's. Use (<$) where it makes sense. --- src/Text/Pandoc/Readers/Org.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index bda0b0262..c4ea64ba7 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -24,7 +24,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Maintainer : Albert Krewinkel -Conversion of Org-Mode to 'Pandoc' document. +Conversion of org-mode formatted plain text to 'Pandoc' document. -} module Text.Pandoc.Readers.Org ( readOrg ) where @@ -711,7 +711,7 @@ math1CharBetween c = try $ do char c res <- noneOf $ c:mathForbiddenBorderChars char c - eof <|> lookAhead (oneOf mathPostChars) *> return () + eof <|> () <$ lookAhead (oneOf mathPostChars) return [res] rawMathBetween :: String @@ -734,12 +734,12 @@ emphasisEnd :: Char -> OrgParser Char emphasisEnd c = try $ do guard =<< notAfterForbiddenBorderChar char c - eof <|> lookAhead (surroundingEmphasisChar >>= \x -> - oneOf (x ++ emphasisPostChars)) - *> return () + eof <|> () <$ lookAhead acceptablePostChars updateLastStrPos popInlineCharStack return c + where acceptablePostChars = + surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars) mathStart :: Char -> OrgParser Char mathStart c = try $ @@ -749,7 +749,7 @@ mathEnd :: Char -> OrgParser Char mathEnd c = try $ do res <- noneOf (c:mathForbiddenBorderChars) char c - eof <|> lookAhead (oneOf mathPostChars *> pure ()) + eof <|> () <$ lookAhead (oneOf mathPostChars) return res -- cgit v1.2.3 From 5fc252270c8332908e3ad9ec12d16c08c49de4a2 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 14 Apr 2014 15:04:32 +0200 Subject: Org reader: Fix code for subexpression parsing --- src/Text/Pandoc/Readers/Org.hs | 25 ++++--------------------- 1 file changed, 4 insertions(+), 21 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index c4ea64ba7..ec0436f4c 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -844,24 +844,12 @@ notAfterForbiddenBorderChar = do -- | Read a sub- or superscript expression subOrSuperExpr :: OrgParser Inlines -subOrSuperExpr = try $ do - choice [ balancedSexp '{' '}' - , balancedSexp '(' ')' >>= return . enclosing ('(', ')') +subOrSuperExpr = try $ + choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r") + , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r") , simpleSubOrSuperString ] >>= parseFromString (mconcat <$> many inline) - --- | Read a balanced sexp -balancedSexp :: Char - -> Char - -> OrgParser String -balancedSexp l r = try $ do - char l - res <- concat <$> many ( many1 (noneOf ([l, r] ++ "\n\r")) - <|> try (string [l, r]) - <|> enclosing (l, r) <$> balancedSexp l r - ) - char r - return res + where enclosing (left, right) s = left : s ++ [right] simpleSubOrSuperString :: OrgParser String simpleSubOrSuperString = try $ @@ -869,8 +857,3 @@ simpleSubOrSuperString = try $ , mappend <$> option [] ((:[]) <$> oneOf "+-") <*> many1 alphaNum ] - -enclosing :: (a, a) - -> [a] - -> [a] -enclosing (left, right) s = left : s ++ [right] -- cgit v1.2.3 From 92582c6272a3a171c406699e46e88afc4835d85c Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 16 Apr 2014 11:58:16 +0200 Subject: Org reader: introduce Reader environment around Blocks/Inlines This introduces a Reader environment in the style of Text.Pandoc.Parsing.F, but adapted to the Org reader parser. --- src/Text/Pandoc/Readers/Org.hs | 306 ++++++++++++++++++++++++----------------- 1 file changed, 176 insertions(+), 130 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index ec0436f4c..bdff4869c 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {- Copyright (C) 2014 Albert Krewinkel @@ -29,21 +30,26 @@ Conversion of org-mode formatted plain text to 'Pandoc' document. module Text.Pandoc.Readers.Org ( readOrg ) where import qualified Text.Pandoc.Builder as B -import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>), HasMeta(..)) +import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..), (<>) + , trimInlines ) import Text.Pandoc.Definition import Text.Pandoc.Options import qualified Text.Pandoc.Parsing as P -import Text.Pandoc.Parsing hiding (newline, orderedListMarker, updateLastStrPos) +import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF + , newline, orderedListMarker + , updateLastStrPos ) import Text.Pandoc.Shared (compactify') -import Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>)) +import Control.Applicative ( Applicative, pure + , (<$>), (<$), (<*>), (<*), (*>), (<**>) ) import Control.Arrow ((***)) -import Control.Monad (guard, when) +import Control.Monad (foldM, guard, liftM, liftM2, when) +import Control.Monad.Reader (Reader, runReader) import Data.Char (toLower) import Data.Default -import Data.List (foldl', isPrefixOf, isSuffixOf) +import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (listToMaybe, fromMaybe) -import Data.Monoid (mconcat, mempty, mappend) +import Data.Monoid (Monoid, mconcat, mempty, mappend) -- | Parse org-mode string and return a Pandoc document. readOrg :: ReaderOptions -- ^ Reader options @@ -55,10 +61,10 @@ type OrgParser = Parser [Char] OrgParserState parseOrg:: OrgParser Pandoc parseOrg = do - blocks' <- B.toList <$> parseBlocks + blocks' <- parseBlocks st <- getState - let meta = orgStateMeta st - return $ Pandoc meta $ filter (/= Null) blocks' + let meta = runF (orgStateMeta' st) st + return $ Pandoc meta $ filter (/= Null) (B.toList $ runF blocks' st) -- -- Parser State for Org @@ -73,7 +79,8 @@ data OrgParserState = OrgParserState , orgStateLastPreCharPos :: Maybe SourcePos , orgStateLastStrPos :: Maybe SourcePos , orgStateMeta :: Meta - } deriving (Show) + , orgStateMeta' :: F Meta + } instance HasReaderOptions OrgParserState where extractReaderOptions = orgStateOptions @@ -96,6 +103,7 @@ defaultOrgParserState = OrgParserState , orgStateLastPreCharPos = Nothing , orgStateLastStrPos = Nothing , orgStateMeta = nullMeta + , orgStateMeta' = return nullMeta } updateLastStrPos :: OrgParser () @@ -138,6 +146,27 @@ resetEmphasisNewlines :: OrgParser () resetEmphasisNewlines = updateState $ \s -> s{ orgStateEmphasisNewlines = Nothing } + +-- +-- Adaptions and specializations of parsing utilities +-- + +newtype F a = F { unF :: Reader OrgParserState a + } deriving (Monad, Applicative, Functor) + +runF :: F a -> OrgParserState -> a +runF = runReader . unF + +instance Monoid a => Monoid (F a) where + mempty = return mempty + mappend = liftM2 mappend + mconcat = fmap mconcat . sequence + +trimInlinesF :: F Inlines -> F Inlines +trimInlinesF = liftM trimInlines + + +-- | Like @Text.Parsec.Char.newline@, but causes additional state changes. newline :: OrgParser Char newline = P.newline @@ -148,10 +177,10 @@ newline = -- parsing blocks -- -parseBlocks :: OrgParser Blocks +parseBlocks :: OrgParser (F Blocks) parseBlocks = mconcat <$> manyTill block eof -block :: OrgParser Blocks +block :: OrgParser (F Blocks) block = choice [ mempty <$ blanklines , orgBlock , example @@ -159,7 +188,7 @@ block = choice [ mempty <$ blanklines , figure , specialLine , header - , hline + , return <$> hline , list , table , paraOrPlain @@ -169,15 +198,15 @@ block = choice [ mempty <$ blanklines -- Org Blocks (#+BEGIN_... / #+END_...) -- -orgBlock :: OrgParser Blocks +orgBlock :: OrgParser (F Blocks) orgBlock = try $ do (indent, blockType, args) <- blockHeader blockStr <- rawBlockContent indent blockType let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ] case blockType of "comment" -> return mempty - "src" -> return $ B.codeBlockWith ("", classArgs, []) blockStr - _ -> B.divWith ("", [blockType], []) + "src" -> return . return $ B.codeBlockWith ("", classArgs, []) blockStr + _ -> fmap (B.divWith ("", [blockType], [])) <$> parseFromString parseBlocks blockStr blockHeader :: OrgParser (Int, String, [String]) @@ -222,15 +251,16 @@ commaEscaped (',':cs@('*':_)) = cs commaEscaped (',':cs@('#':'+':_)) = cs commaEscaped cs = cs -example :: OrgParser Blocks -example = try $ - B.codeBlockWith ("", ["example"], []) . unlines <$> many1 exampleLine +example :: OrgParser (F Blocks) +example = try $ do + body <- unlines <$> many1 exampleLine + return . return $ B.codeBlockWith ("", ["example"], []) body exampleLine :: OrgParser String exampleLine = try $ string ": " *> anyLine -- Drawers for properties or a logbook -drawer :: OrgParser Blocks +drawer :: OrgParser (F Blocks) drawer = try $ do drawerStart manyTill drawerLine (try drawerEnd) @@ -256,18 +286,20 @@ drawerEnd = try $ -- -- Figures (Image on a line by itself, preceded by name and/or caption) -figure :: OrgParser Blocks +figure :: OrgParser (F Blocks) figure = try $ do (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty) <$> nameAndOrCaption src <- skipSpaces *> selfTarget <* skipSpaces <* newline guard (isImageFilename src) - return . B.para $ B.image src tit cap + return $ do + cap' <- cap + return $ B.para $ B.image src tit cap' where withFigPrefix cs = if "fig:" `isPrefixOf` cs then cs else "fig:" ++ cs -nameAndOrCaption :: OrgParser (Maybe String, Maybe Inlines) +nameAndOrCaption :: OrgParser (Maybe String, Maybe (F Inlines)) nameAndOrCaption = try $ nameFirst <|> captionFirst where nameFirst = try $ do @@ -279,7 +311,7 @@ nameAndOrCaption = try $ nameFirst <|> captionFirst n <- optionMaybe name return (n, Just c) -caption :: OrgParser Inlines +caption :: OrgParser (F Inlines) caption = try $ annotation "CAPTION" *> inlinesTillNewline name :: OrgParser String @@ -289,8 +321,8 @@ annotation :: String -> OrgParser String annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':' -- Comments, Options and Metadata -specialLine :: OrgParser Blocks -specialLine = try $ metaLine <|> commentLine +specialLine :: OrgParser (F Blocks) +specialLine = fmap return . try $ metaLine <|> commentLine metaLine :: OrgParser Blocks metaLine = try $ metaLineStart *> declarationLine @@ -308,12 +340,15 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# " declarationLine :: OrgParser Blocks declarationLine = try $ do - meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta - updateState $ \st -> st { orgStateMeta = orgStateMeta st <> meta' } + key <- metaKey + inlinesF <- metaInlines + updateState $ \st -> + let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta + in st { orgStateMeta' = orgStateMeta' st <> meta' } return mempty -metaValue :: OrgParser MetaValue -metaValue = MetaInlines . B.toList <$> inlinesTillNewline +metaInlines :: OrgParser (F MetaValue) +metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline metaKey :: OrgParser String metaKey = map toLower <$> many1 (noneOf ": \n\r") @@ -321,16 +356,20 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r") <* skipSpaces -- | Headers -header :: OrgParser Blocks -header = try $ - B.header <$> headerStart - <*> inlinesTillNewline +header :: OrgParser (F Blocks) +header = try $ do + level <- headerStart + title <- inlinesTillNewline + return $ B.header level <$> title headerStart :: OrgParser Int headerStart = try $ (length <$> many1 (char '*')) <* many1 (char ' ') --- Horizontal Line (five dashes or more) +-- Don't use (or need) the reader wrapper here, we want hline to be +-- @show@able. Otherwise we can't use it with @notFollowedBy'@. + +-- | Horizontal Line (five -- dashes or more) hline :: OrgParser Blocks hline = try $ do skipSpaces @@ -344,22 +383,23 @@ hline = try $ do -- Tables -- -data OrgTableRow = OrgContentRow [Blocks] +data OrgTableRow = OrgContentRow (F [Blocks]) | OrgAlignRow [Alignment] | OrgHlineRow - deriving (Eq, Show) data OrgTable = OrgTable { orgTableColumns :: Int , orgTableAlignments :: [Alignment] , orgTableHeader :: [Blocks] , orgTableRows :: [[Blocks]] - } deriving (Eq, Show) + } -table :: OrgParser Blocks +table :: OrgParser (F Blocks) table = try $ do lookAhead tableStart - orgToPandocTable . normalizeTable . rowsToTable <$> tableRows + do + rows <- tableRows + return $ return . orgToPandocTable . normalizeTable =<< rowsToTable rows orgToPandocTable :: OrgTable -> Blocks @@ -374,11 +414,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow) tableContentRow :: OrgParser OrgTableRow tableContentRow = try $ - OrgContentRow <$> (tableStart *> manyTill tableContentCell newline) + OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline) -tableContentCell :: OrgParser Blocks +tableContentCell :: OrgParser (F Blocks) tableContentCell = try $ - B.plain . trimInlines . mconcat <$> many1Till inline endOfCell + fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell endOfCell :: OrgParser Char endOfCell = try $ char '|' <|> lookAhead newline @@ -410,8 +450,8 @@ tableHline = try $ OrgHlineRow <$ (tableStart *> char '-' *> anyLine) rowsToTable :: [OrgTableRow] - -> OrgTable -rowsToTable = foldl' (flip rowToContent) zeroTable + -> F OrgTable +rowsToTable = foldM (flip rowToContent) zeroTable where zeroTable = OrgTable 0 mempty mempty mempty normalizeTable :: OrgTable @@ -430,57 +470,64 @@ normalizeTable (OrgTable cols aligns heads lns) = -- line as a header. All other horizontal lines are discarded. rowToContent :: OrgTableRow -> OrgTable - -> OrgTable -rowToContent OrgHlineRow = maybeBodyToHeader -rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs -rowToContent (OrgAlignRow as) = setLongestRow as . setAligns as + -> F OrgTable +rowToContent OrgHlineRow t = maybeBodyToHeader t +rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t +rowToContent (OrgContentRow rf) t = do + rs <- rf + setLongestRow rs =<< appendToBody rs t setLongestRow :: [a] -> OrgTable - -> OrgTable -setLongestRow rs t = t{ orgTableColumns = max (length rs) (orgTableColumns t) } + -> F OrgTable +setLongestRow rs t = + return t{ orgTableColumns = max (length rs) (orgTableColumns t) } maybeBodyToHeader :: OrgTable - -> OrgTable + -> F OrgTable maybeBodyToHeader t = case t of OrgTable{ orgTableHeader = [], orgTableRows = b:[] } -> - t{ orgTableHeader = b , orgTableRows = [] } - _ -> t + return t{ orgTableHeader = b , orgTableRows = [] } + _ -> return t appendToBody :: [Blocks] -> OrgTable - -> OrgTable -appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] } + -> F OrgTable +appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] } setAligns :: [Alignment] -> OrgTable - -> OrgTable -setAligns aligns t = t{ orgTableAlignments = aligns } + -> F OrgTable +setAligns aligns t = return $ t{ orgTableAlignments = aligns } -- Paragraphs or Plain text -paraOrPlain :: OrgParser Blocks +paraOrPlain :: OrgParser (F Blocks) paraOrPlain = try $ - parseInlines <**> option B.plain (try $ newline *> pure B.para) + parseInlines <**> (fmap <$> option B.plain (try $ newline *> pure B.para)) -inlinesTillNewline :: OrgParser Inlines -inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline +inlinesTillNewline :: OrgParser (F Inlines) +inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline -- -- list blocks -- -list :: OrgParser Blocks +list :: OrgParser (F Blocks) list = choice [ definitionList, bulletList, orderedList ] "list" -definitionList :: OrgParser Blocks -definitionList = B.definitionList <$> many1 (definitionListItem bulletListStart) +definitionList :: OrgParser (F Blocks) +definitionList = fmap B.definitionList . sequence + <$> many1 (definitionListItem bulletListStart) -bulletList :: OrgParser Blocks -bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart) +bulletList :: OrgParser (F Blocks) +bulletList = fmap B.bulletList . fmap compactify' . sequence + <$> many1 (listItem bulletListStart) -orderedList :: OrgParser Blocks -orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart) +orderedList :: OrgParser (F Blocks) +-- orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart) +orderedList = fmap B.orderedList . fmap compactify' . sequence + <$> many1 (listItem orderedListStart) genericListStart :: OrgParser String -> OrgParser Int @@ -499,7 +546,7 @@ orderedListStart = genericListStart orderedListMarker where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)") definitionListItem :: OrgParser Int - -> OrgParser (Inlines, [Blocks]) + -> OrgParser (F (Inlines, [Blocks])) definitionListItem parseMarkerGetLength = try $ do markerLength <- parseMarkerGetLength term <- manyTill (noneOf "\n\r") (try $ string "::") @@ -507,12 +554,12 @@ definitionListItem parseMarkerGetLength = try $ do cont <- concat <$> many (listContinuation markerLength) term' <- parseFromString inline term contents' <- parseFromString parseBlocks $ first ++ cont - return (term', [contents']) + return $ (,) <$> term' <*> fmap (:[]) contents' -- parse raw text for one list item, excluding start marker and continuations listItem :: OrgParser Int - -> OrgParser Blocks + -> OrgParser (F Blocks) listItem start = try $ do markerLength <- try start firstLine <- anyLineNewline @@ -536,11 +583,11 @@ anyLineNewline = (++ "\n") <$> anyLine -- inline -- -inline :: OrgParser Inlines +inline :: OrgParser (F Inlines) inline = choice [ whitespace , linebreak - , link + , linkOrImage , str , endline , emph @@ -557,29 +604,29 @@ inline = ] <* (guard =<< newlinesCountWithinLimits) "inline" -parseInlines :: OrgParser Inlines -parseInlines = trimInlines . mconcat <$> many1 inline +parseInlines :: OrgParser (F Inlines) +parseInlines = trimInlinesF . mconcat <$> many1 inline -- treat these as potentially non-text when parsing inline: specialChars :: [Char] specialChars = "\"$'()*+-./:<=>[\\]^_{|}~" -whitespace :: OrgParser Inlines -whitespace = B.space <$ skipMany1 spaceChar - <* updateLastPreCharPos - <* updateLastForbiddenCharPos +whitespace :: OrgParser (F Inlines) +whitespace = pure B.space <$ skipMany1 spaceChar + <* updateLastPreCharPos + <* updateLastForbiddenCharPos "whitespace" -linebreak :: OrgParser Inlines -linebreak = try $ B.linebreak <$ string "\\\\" <* skipSpaces <* newline +linebreak :: OrgParser (F Inlines) +linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline -str :: OrgParser Inlines -str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ") - <* updateLastStrPos +str :: OrgParser (F Inlines) +str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ") + <* updateLastStrPos -- an endline character that can be treated as a space, not a structural break -endline :: OrgParser Inlines +endline :: OrgParser (F Inlines) endline = try $ do newline notFollowedBy blankline @@ -595,29 +642,29 @@ endline = try $ do decEmphasisNewlinesCount guard =<< newlinesCountWithinLimits updateLastPreCharPos - return B.space + return . return $ B.space -link :: OrgParser Inlines -link = explicitOrImageLink <|> selflinkOrImage "link" +linkOrImage :: OrgParser (F Inlines) +linkOrImage = explicitOrImageLink <|> selflinkOrImage "link or image" -explicitOrImageLink :: OrgParser Inlines +explicitOrImageLink :: OrgParser (F Inlines) explicitOrImageLink = try $ do char '[' src <- linkTarget title <- enclosedRaw (char '[') (char ']') title' <- parseFromString (mconcat <$> many inline) title char ']' - return . B.link src "" - $ if isImageFilename src && isImageFilename title - then B.image title "" "" - else title' + return $ B.link src "" <$> + if isImageFilename src && isImageFilename title + then return $ B.image title mempty mempty + else title' -selflinkOrImage :: OrgParser Inlines +selflinkOrImage :: OrgParser (F Inlines) selflinkOrImage = try $ do src <- char '[' *> linkTarget <* char ']' - return $ if isImageFilename src - then B.image src "" "" - else B.link src "" (B.str src) + return . return $ if isImageFilename src + then B.image src "" "" + else B.link src "" (B.str src) selfTarget :: OrgParser String selfTarget = try $ char '[' *> linkTarget <* char ']' @@ -634,51 +681,50 @@ isImageFilename filename = imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ] protocols = [ "file", "http", "https" ] -emph :: OrgParser Inlines -emph = B.emph <$> emphasisBetween '/' +emph :: OrgParser (F Inlines) +emph = fmap B.emph <$> emphasisBetween '/' -strong :: OrgParser Inlines -strong = B.strong <$> emphasisBetween '*' +strong :: OrgParser (F Inlines) +strong = fmap B.strong <$> emphasisBetween '*' -strikeout :: OrgParser Inlines -strikeout = B.strikeout <$> emphasisBetween '+' +strikeout :: OrgParser (F Inlines) +strikeout = fmap B.strikeout <$> emphasisBetween '+' -- There is no underline, so we use strong instead. -underline :: OrgParser Inlines -underline = B.strong <$> emphasisBetween '_' - -code :: OrgParser Inlines -code = B.code <$> verbatimBetween '=' +underline :: OrgParser (F Inlines) +underline = fmap B.strong <$> emphasisBetween '_' -verbatim :: OrgParser Inlines -verbatim = B.rawInline "" <$> verbatimBetween '~' +code :: OrgParser (F Inlines) +code = return . B.code <$> verbatimBetween '=' -math :: OrgParser Inlines -math = B.math <$> choice [ math1CharBetween '$' - , mathStringBetween '$' - , rawMathBetween "\\(" "\\)" - ] +verbatim :: OrgParser (F Inlines) +verbatim = return . B.rawInline "" <$> verbatimBetween '~' -displayMath :: OrgParser Inlines -displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]" - , rawMathBetween "$$" "$$" - ] +subscript :: OrgParser (F Inlines) +subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr) -subscript :: OrgParser Inlines -subscript = B.subscript <$> try (char '_' *> subOrSuperExpr) +superscript :: OrgParser (F Inlines) +superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr) -superscript :: OrgParser Inlines -superscript = B.superscript <$> try (char '^' *> subOrSuperExpr) +math :: OrgParser (F Inlines) +math = return . B.math <$> choice [ math1CharBetween '$' + , mathStringBetween '$' + , rawMathBetween "\\(" "\\)" + ] -symbol :: OrgParser Inlines -symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions) +displayMath :: OrgParser (F Inlines) +displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]" + , rawMathBetween "$$" "$$" + ] +symbol :: OrgParser (F Inlines) +symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions) where updatePositions c | c `elem` emphasisPreChars = c <$ updateLastPreCharPos | c `elem` emphasisForbiddenBorderChars = c <$ updateLastForbiddenCharPos | otherwise = return c emphasisBetween :: Char - -> OrgParser Inlines + -> OrgParser (F Inlines) emphasisBetween c = try $ do startEmphasisNewlinesCounting emphasisAllowedNewlines res <- enclosedInlines (emphasisStart c) (emphasisEnd c) @@ -755,9 +801,9 @@ mathEnd c = try $ do enclosedInlines :: OrgParser a -> OrgParser b - -> OrgParser Inlines + -> OrgParser (F Inlines) enclosedInlines start end = try $ - trimInlines . mconcat <$> enclosed start end inline + trimInlinesF . mconcat <$> enclosed start end inline enclosedRaw :: OrgParser a -> OrgParser b @@ -843,7 +889,7 @@ notAfterForbiddenBorderChar = do return $ lastFBCPos /= Just pos -- | Read a sub- or superscript expression -subOrSuperExpr :: OrgParser Inlines +subOrSuperExpr :: OrgParser (F Inlines) subOrSuperExpr = try $ choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r") , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r") -- cgit v1.2.3 From 0672f58a445c289c58e42cffbbf32a273e801e39 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 6 Apr 2014 18:43:49 +0200 Subject: Org reader: Support footnotes --- src/Text/Pandoc/Readers/Org.hs | 66 ++++++++++++++++++++++++++++++++++++++++-- tests/Tests/Readers/Org.hs | 4 +++ 2 files changed, 68 insertions(+), 2 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index bdff4869c..17f8a1c9e 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -44,7 +44,7 @@ import Control.Applicative ( Applicative, pure , (<$>), (<$), (<*>), (<*), (*>), (<**>) ) import Control.Arrow ((***)) import Control.Monad (foldM, guard, liftM, liftM2, when) -import Control.Monad.Reader (Reader, runReader) +import Control.Monad.Reader (Reader, runReader, ask, asks) import Data.Char (toLower) import Data.Default import Data.List (isPrefixOf, isSuffixOf) @@ -59,7 +59,7 @@ readOrg opts s = readWith parseOrg def{ orgStateOptions = opts } (s ++ "\n\n") type OrgParser = Parser [Char] OrgParserState -parseOrg:: OrgParser Pandoc +parseOrg :: OrgParser Pandoc parseOrg = do blocks' <- parseBlocks st <- getState @@ -70,6 +70,9 @@ parseOrg = do -- Parser State for Org -- +type OrgNoteRecord = (String, F Blocks) +type OrgNoteTable = [OrgNoteRecord] + -- | Org-mode parser state data OrgParserState = OrgParserState { orgStateOptions :: ReaderOptions @@ -80,6 +83,7 @@ data OrgParserState = OrgParserState , orgStateLastStrPos :: Maybe SourcePos , orgStateMeta :: Meta , orgStateMeta' :: F Meta + , orgStateNotes' :: OrgNoteTable } instance HasReaderOptions OrgParserState where @@ -104,6 +108,7 @@ defaultOrgParserState = OrgParserState , orgStateLastStrPos = Nothing , orgStateMeta = nullMeta , orgStateMeta' = return nullMeta + , orgStateNotes' = [] } updateLastStrPos :: OrgParser () @@ -146,6 +151,11 @@ resetEmphasisNewlines :: OrgParser () resetEmphasisNewlines = updateState $ \s -> s{ orgStateEmphasisNewlines = Nothing } +addToNotesTable :: OrgNoteRecord -> OrgParser () +addToNotesTable note = do + oldnotes <- orgStateNotes' <$> getState + updateState $ \s -> s{ orgStateNotes' = note:oldnotes } + -- -- Adaptions and specializations of parsing utilities @@ -157,6 +167,12 @@ newtype F a = F { unF :: Reader OrgParserState a runF :: F a -> OrgParserState -> a runF = runReader . unF +askF :: F OrgParserState +askF = F ask + +asksF :: (OrgParserState -> a) -> F a +asksF f = F $ asks f + instance Monoid a => Monoid (F a) where mempty = return mempty mappend = liftM2 mappend @@ -191,6 +207,7 @@ block = choice [ mempty <$ blanklines , return <$> hline , list , table + , noteBlock , paraOrPlain ] "block" @@ -500,6 +517,16 @@ setAligns :: [Alignment] -> F OrgTable setAligns aligns t = return $ t{ orgTableAlignments = aligns } +-- +-- Footnote defintions +-- +noteBlock :: OrgParser (F Blocks) +noteBlock = try $ do + ref <- noteMarker + content <- skipSpaces *> paraOrPlain + addToNotesTable (ref, content) + return mempty + -- Paragraphs or Plain text paraOrPlain :: OrgParser (F Blocks) paraOrPlain = try $ @@ -587,6 +614,7 @@ inline :: OrgParser (F Inlines) inline = choice [ whitespace , linebreak + , footnote , linkOrImage , str , endline @@ -632,6 +660,7 @@ endline = try $ do notFollowedBy blankline notFollowedBy' exampleLine notFollowedBy' hline + notFollowedBy' noteMarker notFollowedBy' tableStart notFollowedBy' drawerStart notFollowedBy' headerStart @@ -644,6 +673,39 @@ endline = try $ do updateLastPreCharPos return . return $ B.space +footnote :: OrgParser (F Inlines) +footnote = try $ inlineNote <|> referencedNote + +inlineNote :: OrgParser (F Inlines) +inlineNote = try $ do + string "[fn:" + ref <- many alphaNum + char ':' + note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']') + when (not $ null ref) $ + addToNotesTable ("fn:" ++ ref, note) + return $ B.note <$> note + +referencedNote :: OrgParser (F Inlines) +referencedNote = try $ do + ref <- noteMarker + return $ do + notes <- asksF orgStateNotes' + case lookup ref notes of + Nothing -> return $ B.str $ "[" ++ ref ++ "]" + Just contents -> do + st <- askF + let contents' = runF contents st{ orgStateNotes' = [] } + return $ B.note contents' + +noteMarker :: OrgParser String +noteMarker = try $ do + char '[' + choice [ many1Till digit (char ']') + , (++) <$> string "fn:" + <*> many1Till (noneOf "\n\r\t ") (char ']') + ] + linkOrImage :: OrgParser (F Inlines) linkOrImage = explicitOrImageLink <|> selflinkOrImage "link or image" diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index f39bd7992..7f9c5f1d5 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -98,6 +98,10 @@ tests = "line \\\\ \nbreak" =?> para ("line" <> linebreak <> "break") + , "Inline note" =: + "[fn::Schreib mir eine E-Mail]" =?> + para (note $ para "Schreib mir eine E-Mail") + , "Markup-chars not occuring on word break are symbols" =: unlines [ "this+that+ +so+on" , "seven*eight* nine*" -- cgit v1.2.3 From 6d6724cf2c6ae6bcc0df312c476e45644c972a85 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 17 Apr 2014 18:09:27 +0200 Subject: Org reader: Support more types of '#+BEGIN_' blocks Support for standard org-blocks is improved. The parser now handles "HTML", "LATEX", "ASCII", "EXAMPLE", "QUOTE" and "VERSE" blocks in a sensible fashion. --- src/Text/Pandoc/Readers/Org.hs | 41 +++++++++++++++--- tests/Tests/Readers/Org.hs | 97 ++++++++++++++++++++++++++++++++---------- 2 files changed, 108 insertions(+), 30 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 17f8a1c9e..88e81f5fc 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -37,6 +37,7 @@ import Text.Pandoc.Options import qualified Text.Pandoc.Parsing as P import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF , newline, orderedListMarker + , parseFromString , updateLastStrPos ) import Text.Pandoc.Shared (compactify') @@ -47,7 +48,7 @@ import Control.Monad (foldM, guard, liftM, liftM2, when) import Control.Monad.Reader (Reader, runReader, ask, asks) import Data.Char (toLower) import Data.Default -import Data.List (isPrefixOf, isSuffixOf) +import Data.List (intersperse, isPrefixOf, isSuffixOf) import Data.Maybe (listToMaybe, fromMaybe) import Data.Monoid (Monoid, mconcat, mempty, mappend) @@ -156,6 +157,16 @@ addToNotesTable note = do oldnotes <- orgStateNotes' <$> getState updateState $ \s -> s{ orgStateNotes' = note:oldnotes } +-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts +-- of the state saved and restored. +parseFromString :: OrgParser a -> String -> OrgParser a +parseFromString parser str' = do + oldLastPreCharPos <- orgStateLastPreCharPos <$> getState + updateState $ \s -> s{ orgStateLastPreCharPos = Nothing } + result <- P.parseFromString parser str' + updateState $ \s -> s{ orgStateLastPreCharPos = oldLastPreCharPos } + return result + -- -- Adaptions and specializations of parsing utilities @@ -218,13 +229,27 @@ block = choice [ mempty <$ blanklines orgBlock :: OrgParser (F Blocks) orgBlock = try $ do (indent, blockType, args) <- blockHeader - blockStr <- rawBlockContent indent blockType + content <- rawBlockContent indent blockType + contentBlocks <- parseFromString parseBlocks (content ++ "\n") let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ] case blockType of "comment" -> return mempty - "src" -> return . return $ B.codeBlockWith ("", classArgs, []) blockStr - _ -> fmap (B.divWith ("", [blockType], [])) - <$> parseFromString parseBlocks blockStr + "src" -> returnF $ B.codeBlockWith ("", classArgs, []) content + "html" -> returnF $ B.rawBlock "html" content + "latex" -> returnF $ B.rawBlock "latex" content + "ascii" -> returnF $ B.rawBlock "ascii" content + "example" -> returnF $ exampleCode content + "quote" -> return $ B.blockQuote <$> contentBlocks + "verse" -> parseVerse content + _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks + where + returnF :: a -> OrgParser (F a) + returnF = return . return + + parseVerse :: String -> OrgParser (F Blocks) + parseVerse cs = + fmap B.para . mconcat . intersperse (pure B.linebreak) + <$> mapM (parseFromString parseInlines) (lines cs) blockHeader :: OrgParser (Int, String, [String]) blockHeader = (,,) <$> blockIndent @@ -270,8 +295,10 @@ commaEscaped cs = cs example :: OrgParser (F Blocks) example = try $ do - body <- unlines <$> many1 exampleLine - return . return $ B.codeBlockWith ("", ["example"], []) body + return . return . exampleCode =<< unlines <$> many1 exampleLine + +exampleCode :: String -> Blocks +exampleCode = B.codeBlockWith ("", ["example"], []) exampleLine :: OrgParser String exampleLine = try $ string ": " *> anyLine diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 7f9c5f1d5..7d5bfe650 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -363,29 +363,6 @@ tests = , "#+END_COMMENT"] =?> (mempty::Blocks) - , "Source Block in Text" =: - unlines [ "Low German greeting" - , " #+BEGIN_SRC haskell" - , " main = putStrLn greeting" - , " where greeting = \"moin\"" - , " #+END_SRC" ] =?> - let attr' = ("", ["haskell"], []) - code' = "main = putStrLn greeting\n" ++ - " where greeting = \"moin\"\n" - in mconcat [ para $ spcSep [ "Low", "German", "greeting" ] - , codeBlockWith attr' code' - ] - - , "Source Block" =: - unlines [ " #+BEGIN_SRC haskell" - , " main = putStrLn greeting" - , " where greeting = \"moin\"" - , " #+END_SRC" ] =?> - let attr' = ("", ["haskell"], []) - code' = "main = putStrLn greeting\n" ++ - " where greeting = \"moin\"\n" - in codeBlockWith attr' code' - , "Figure" =: unlines [ "#+caption: A very courageous man." , "#+name: goodguy" @@ -661,4 +638,78 @@ tests = , [ plain "2" , plain mempty , plain mempty ] ] ] + + , testGroup "Blocks" + [ "Source block" =: + unlines [ " #+BEGIN_SRC haskell" + , " main = putStrLn greeting" + , " where greeting = \"moin\"" + , " #+END_SRC" ] =?> + let attr' = ("", ["haskell"], []) + code' = "main = putStrLn greeting\n" ++ + " where greeting = \"moin\"\n" + in codeBlockWith attr' code' + + , "Source block between paragraphs" =: + unlines [ "Low German greeting" + , " #+BEGIN_SRC haskell" + , " main = putStrLn greeting" + , " where greeting = \"Moin!\"" + , " #+END_SRC" ] =?> + let attr' = ("", ["haskell"], []) + code' = "main = putStrLn greeting\n" ++ + " where greeting = \"Moin!\"\n" + in mconcat [ para $ spcSep [ "Low", "German", "greeting" ] + , codeBlockWith attr' code' + ] + + , "Example block" =: + unlines [ "#+begin_example" + , "A chosen representation of" + , "a rule." + , "#+eND_exAMPle" + ] =?> + codeBlockWith ("", ["example"], []) + "A chosen representation of\na rule.\n" + + , "HTML block" =: + unlines [ "#+BEGIN_HTML" + , "" + , "#+END_HTML" + ] =?> + rawBlock "html" "\n" + + , "Quote block" =: + unlines [ "#+BEGIN_QUOTE" + , "/Niemand/ hat die Absicht, eine Mauer zu errichten!" + , "#+END_QUOTE" + ] =?> + blockQuote (para (spcSep [ emph "Niemand", "hat", "die", "Absicht," + , "eine", "Mauer", "zu", "errichten!" + ])) + + , "Verse block" =: + unlines [ "The first lines of Goethe's /Faust/:" + , "#+begin_verse" + , "Habe nun, ach! Philosophie," + , "Juristerei und Medizin," + , "Und leider auch Theologie!" + , "Durchaus studiert, mit heißem Bemühn." + , "#+end_verse" + ] =?> + mconcat + [ para $ spcSep [ "The", "first", "lines", "of" + , "Goethe's", emph "Faust" <> ":"] + , para $ mconcat + [ spcSep [ "Habe", "nun,", "ach!", "Philosophie," ] + , linebreak + , spcSep [ "Juristerei", "und", "Medizin," ] + , linebreak + , spcSep [ "Und", "leider", "auch", "Theologie!" ] + , linebreak + , spcSep [ "Durchaus", "studiert,", "mit", "heißem", "Bemühn." ] + ] + ] + + ] ] -- cgit v1.2.3 From f19d7233d8d3e47912b760fc62a253e5baf8275a Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 18 Apr 2014 08:33:25 +0200 Subject: Org reader: Fix parsing of loose lists Loose lists (i.e. lists with blankline separated items), were parsed as multiple lists, each containing a single item. This patch fixes this issue. --- src/Text/Pandoc/Readers/Org.hs | 11 +++++++---- tests/Tests/Readers/Org.hs | 21 ++++++++++++++++----- 2 files changed, 23 insertions(+), 9 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 88e81f5fc..1fa8d4d5e 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -605,9 +605,10 @@ definitionListItem parseMarkerGetLength = try $ do markerLength <- parseMarkerGetLength term <- manyTill (noneOf "\n\r") (try $ string "::") first <- anyLineNewline + blank <- option "" ("\n" <$ blankline) cont <- concat <$> many (listContinuation markerLength) term' <- parseFromString inline term - contents' <- parseFromString parseBlocks $ first ++ cont + contents' <- parseFromString parseBlocks $ first ++ blank ++ cont return $ (,) <$> term' <*> fmap (:[]) contents' @@ -617,16 +618,18 @@ listItem :: OrgParser Int listItem start = try $ do markerLength <- try start firstLine <- anyLineNewline + blank <- option "" ("\n" <$ blankline) rest <- concat <$> many (listContinuation markerLength) - parseFromString parseBlocks $ firstLine ++ rest + parseFromString parseBlocks $ firstLine ++ blank ++ rest -- continuation of a list item - indented and separated by blankline or endline. -- Note: nested lists are parsed as continuations. listContinuation :: Int -> OrgParser String listContinuation markerLength = try $ - mappend <$> many blankline - <*> (concat <$> many1 listLine) + notFollowedBy' blankline + *> (mappend <$> (concat <$> many1 listLine) + <*> many blankline) where listLine = try $ indentWith markerLength *> anyLineNewline anyLineNewline :: OrgParser String diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 7d5bfe650..572fc501f 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -518,13 +518,24 @@ tests = , ("TTL", [ plain $ "transistor-transistor" <> space <> "logic" ]) , ("PSK", [ mconcat - [ para $ "phase-shift" <> space <> "keying" - , plain $ spcSep [ "a", "digital" - , "modulation", "scheme" ] + [ para $ "phase-shift" <> space <> "keying" + , para $ spcSep [ "a", "digital" + , "modulation", "scheme" ] ] - ] - ) + ]) ] + + , "Loose bullet list" =: + unlines [ "- apple" + , "" + , "- orange" + , "" + , "- peach" + ] =?> + bulletList [ para "apple" + , para "orange" + , para "peach" + ] ] , testGroup "Tables" -- cgit v1.2.3 From 09441b65a83f372410394a88af7808f494c3aa57 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 18 Apr 2014 10:15:58 +0200 Subject: Org reader: Add support for plain LaTeX fragments This adds support for LaTeX fragments like the following: ``` \begin{equation} \int fg \mathrm{d}x \end{equation} ``` --- src/Text/Pandoc/Readers/Org.hs | 41 ++++++++++++++++++++++++++++++++++++++++- tests/Tests/Readers/Org.hs | 20 +++++++++++++++++++- 2 files changed, 59 insertions(+), 2 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 1fa8d4d5e..66cfe720e 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -218,6 +218,7 @@ block = choice [ mempty <$ blanklines , return <$> hline , list , table + , latexFragment , noteBlock , paraOrPlain ] "block" @@ -544,6 +545,41 @@ setAligns :: [Alignment] -> F OrgTable setAligns aligns t = return $ t{ orgTableAlignments = aligns } + +-- +-- LaTeX fragments +-- +latexFragment :: OrgParser (F Blocks) +latexFragment = try $ do + envName <- latexEnvStart + content <- mconcat <$> manyTill anyLineNewline (latexEnd envName) + return . return $ B.rawBlock "latex" (content `inLatexEnv` envName) + where + c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n" + , c + , "\\end{", e, "}\n" + ] + +latexEnvStart :: OrgParser String +latexEnvStart = try $ do + skipSpaces *> string "\\begin{" + *> latexEnvName + <* string "}" + <* blankline + +latexEnd :: String -> OrgParser () +latexEnd envName = try $ + () <$ skipSpaces + <* string ("\\end{" ++ envName ++ "}") + <* blankline + +-- | Parses a LaTeX environment name. +latexEnvName :: OrgParser String +latexEnvName = try $ do + mappend <$> many1 alphaNum + <*> option "" (string "*") + + -- -- Footnote defintions -- @@ -683,7 +719,9 @@ str :: OrgParser (F Inlines) str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ") <* updateLastStrPos --- an endline character that can be treated as a space, not a structural break +-- | An endline character that can be treated as a space, not a structural +-- break. This should reflect the values of the Emacs variable +-- @org-element-pagaraph-separate@. endline :: OrgParser (F Inlines) endline = try $ do newline @@ -695,6 +733,7 @@ endline = try $ do notFollowedBy' drawerStart notFollowedBy' headerStart notFollowedBy' metaLineStart + notFollowedBy' latexEnvStart notFollowedBy' commentLineStart notFollowedBy' bulletListStart notFollowedBy' orderedListStart diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 572fc501f..1ac2c1fd8 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -650,7 +650,7 @@ tests = ] ] - , testGroup "Blocks" + , testGroup "Blocks and fragments" [ "Source block" =: unlines [ " #+BEGIN_SRC haskell" , " main = putStrLn greeting" @@ -722,5 +722,23 @@ tests = ] ] + , "LaTeX fragment" =: + unlines [ "\\begin{equation}" + , "X_i = \\begin{cases}" + , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) = \\alpha(i)\\\\" + , " C_{\\alpha(i)} & \\text{otherwise}" + , " \\end{cases}" + , "\\end{equation}" + ] =?> + rawBlock "latex" + (unlines [ "\\begin{equation}" + , "X_i = \\begin{cases}" + , " G_{\\alpha(i)} & \\text{if }\\alpha(i-1) =" ++ + " \\alpha(i)\\\\" + , " C_{\\alpha(i)} & \\text{otherwise}" + , " \\end{cases}" + , "\\end{equation}" + ]) + ] ] -- cgit v1.2.3 From 6ded3d41d94c1e90d1d30a1f99ddad62e62d9ce6 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 18 Apr 2014 20:47:50 +0200 Subject: Org reader: Apply captions to code blocks and tables The `Table` blocktype already takes the caption as an argument, while code blocks are wrapped in a `Div` block together with a labelling `Span`. --- src/Text/Pandoc/Readers/Org.hs | 134 +++++++++++++++++++++++++++++------------ tests/Tests/Readers/Org.hs | 31 +++++++++- 2 files changed, 124 insertions(+), 41 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 66cfe720e..025158060 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -43,13 +43,13 @@ import Text.Pandoc.Shared (compactify') import Control.Applicative ( Applicative, pure , (<$>), (<$), (<*>), (<*), (*>), (<**>) ) -import Control.Arrow ((***)) import Control.Monad (foldM, guard, liftM, liftM2, when) import Control.Monad.Reader (Reader, runReader, ask, asks) import Data.Char (toLower) import Data.Default import Data.List (intersperse, isPrefixOf, isSuffixOf) -import Data.Maybe (listToMaybe, fromMaybe) +import qualified Data.Map as M +import Data.Maybe (listToMaybe, fromMaybe, isJust) import Data.Monoid (Monoid, mconcat, mempty, mappend) -- | Parse org-mode string and return a Pandoc document. @@ -74,9 +74,12 @@ parseOrg = do type OrgNoteRecord = (String, F Blocks) type OrgNoteTable = [OrgNoteRecord] +type OrgBlockAttributes = M.Map String String + -- | Org-mode parser state data OrgParserState = OrgParserState { orgStateOptions :: ReaderOptions + , orgStateBlockAttributes :: OrgBlockAttributes , orgStateEmphasisCharStack :: [Char] , orgStateEmphasisNewlines :: Maybe Int , orgStateLastForbiddenCharPos :: Maybe SourcePos @@ -102,6 +105,7 @@ instance Default OrgParserState where defaultOrgParserState :: OrgParserState defaultOrgParserState = OrgParserState { orgStateOptions = def + , orgStateBlockAttributes = M.empty , orgStateEmphasisCharStack = [] , orgStateEmphasisNewlines = Nothing , orgStateLastForbiddenCharPos = Nothing @@ -112,6 +116,19 @@ defaultOrgParserState = OrgParserState , orgStateNotes' = [] } +addBlockAttribute :: String -> String -> OrgParser () +addBlockAttribute key val = updateState $ \s -> + let attrs = orgStateBlockAttributes s + in s{ orgStateBlockAttributes = M.insert key val attrs } + +lookupBlockAttribute :: String -> OrgParser (Maybe String) +lookupBlockAttribute key = + M.lookup key . orgStateBlockAttributes <$> getState + +resetBlockAttributes :: OrgParser () +resetBlockAttributes = updateState $ \s -> + s{ orgStateBlockAttributes = orgStateBlockAttributes def } + updateLastStrPos :: OrgParser () updateLastStrPos = getPosition >>= \p -> updateState $ \s -> s{ orgStateLastStrPos = Just p } @@ -125,19 +142,19 @@ updateLastPreCharPos = getPosition >>= \p -> updateState $ \s -> s{ orgStateLastPreCharPos = Just p} pushToInlineCharStack :: Char -> OrgParser () -pushToInlineCharStack c = updateState $ \st -> - st { orgStateEmphasisCharStack = c:orgStateEmphasisCharStack st } +pushToInlineCharStack c = updateState $ \s -> + s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s } popInlineCharStack :: OrgParser () -popInlineCharStack = updateState $ \st -> - st { orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ st } +popInlineCharStack = updateState $ \s -> + s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s } surroundingEmphasisChar :: OrgParser [Char] surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState startEmphasisNewlinesCounting :: Int -> OrgParser () startEmphasisNewlinesCounting maxNewlines = updateState $ \s -> - s { orgStateEmphasisNewlines = Just maxNewlines } + s{ orgStateEmphasisNewlines = Just maxNewlines } decEmphasisNewlinesCount :: OrgParser () decEmphasisNewlinesCount = updateState $ \s -> @@ -209,20 +226,50 @@ parseBlocks = mconcat <$> manyTill block eof block :: OrgParser (F Blocks) block = choice [ mempty <$ blanklines - , orgBlock + , optionalAttributes $ choice + [ orgBlock + , figure + , table + ] , example , drawer - , figure , specialLine , header , return <$> hline , list - , table , latexFragment , noteBlock , paraOrPlain ] "block" +optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks) +optionalAttributes parser = try $ + resetBlockAttributes *> parseBlockAttributes *> parser + +parseBlockAttributes :: OrgParser () +parseBlockAttributes = do + attrs <- many attribute + () <$ mapM (uncurry parseAndAddAttribute) attrs + where + attribute :: OrgParser (String, String) + attribute = try $ do + key <- metaLineStart *> many1Till (noneOf "\n\r") (char ':') + val <- skipSpaces *> anyLine + return (map toLower key, val) + +parseAndAddAttribute :: String -> String -> OrgParser () +parseAndAddAttribute key value = do + let key' = map toLower key + () <$ addBlockAttribute key' value + +lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines)) +lookupInlinesAttr attr = try $ do + val <- lookupBlockAttribute attr + maybe (return Nothing) + (fmap Just . parseFromString parseInlines) + val + + -- -- Org Blocks (#+BEGIN_... / #+END_...) -- @@ -235,13 +282,13 @@ orgBlock = try $ do let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ] case blockType of "comment" -> return mempty - "src" -> returnF $ B.codeBlockWith ("", classArgs, []) content "html" -> returnF $ B.rawBlock "html" content "latex" -> returnF $ B.rawBlock "latex" content "ascii" -> returnF $ B.rawBlock "ascii" content "example" -> returnF $ exampleCode content "quote" -> return $ B.blockQuote <$> contentBlocks "verse" -> parseVerse content + "src" -> codeBlockWithAttr classArgs content _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks where returnF :: a -> OrgParser (F a) @@ -260,6 +307,18 @@ blockHeader = (,,) <$> blockIndent blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter) blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline +codeBlockWithAttr :: [String] -> String -> OrgParser (F Blocks) +codeBlockWithAttr classArgs content = do + identifier <- fromMaybe "" <$> lookupBlockAttribute "name" + caption <- lookupInlinesAttr "caption" + let codeBlck = B.codeBlockWith (identifier, classArgs, []) content + return $ maybe (pure codeBlck) (labelDiv codeBlck) caption + where + labelDiv blk value = + B.divWith nullAttr <$> (mappend <$> labelledBlock value + <*> pure blk) + labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], [])) + rawBlockContent :: Int -> String -> OrgParser String rawBlockContent indent blockType = unlines . map commaEscaped <$> manyTill indentedLine blockEnder @@ -333,38 +392,26 @@ drawerEnd = try $ -- Figures (Image on a line by itself, preceded by name and/or caption) figure :: OrgParser (F Blocks) figure = try $ do - (tit, cap) <- (maybe mempty withFigPrefix *** fromMaybe mempty) - <$> nameAndOrCaption + (cap, nam) <- nameAndCaption src <- skipSpaces *> selfTarget <* skipSpaces <* newline guard (isImageFilename src) return $ do cap' <- cap - return $ B.para $ B.image src tit cap' - where withFigPrefix cs = if "fig:" `isPrefixOf` cs - then cs - else "fig:" ++ cs - -nameAndOrCaption :: OrgParser (Maybe String, Maybe (F Inlines)) -nameAndOrCaption = try $ nameFirst <|> captionFirst + return $ B.para $ B.image src nam cap' where - nameFirst = try $ do - n <- name - c <- optionMaybe caption - return (Just n, c) - captionFirst = try $ do - c <- caption - n <- optionMaybe name - return (n, Just c) - -caption :: OrgParser (F Inlines) -caption = try $ annotation "CAPTION" *> inlinesTillNewline - -name :: OrgParser String -name = try $ annotation "NAME" *> skipSpaces *> manyTill anyChar newline - -annotation :: String -> OrgParser String -annotation ann = try $ metaLineStart *> stringAnyCase ann <* char ':' + nameAndCaption = + do + maybeCap <- lookupInlinesAttr "caption" + maybeNam <- lookupBlockAttribute "name" + guard $ isJust maybeCap || isJust maybeNam + return ( fromMaybe mempty maybeCap + , maybe mempty withFigPrefix maybeNam ) + withFigPrefix cs = + if "fig:" `isPrefixOf` cs + then cs + else "fig:" ++ cs +-- -- Comments, Options and Metadata specialLine :: OrgParser (F Blocks) specialLine = fmap return . try $ metaLine <|> commentLine @@ -400,6 +447,10 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r") <* char ':' <* skipSpaces +-- +-- Headers +-- + -- | Headers header :: OrgParser (F Blocks) header = try $ do @@ -411,6 +462,7 @@ headerStart :: OrgParser Int headerStart = try $ (length <$> many1 (char '*')) <* many1 (char ' ') + -- Don't use (or need) the reader wrapper here, we want hline to be -- @show@able. Otherwise we can't use it with @notFollowedBy'@. @@ -444,12 +496,14 @@ table = try $ do lookAhead tableStart do rows <- tableRows - return $ return . orgToPandocTable . normalizeTable =<< rowsToTable rows + cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption" + return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows orgToPandocTable :: OrgTable + -> Inlines -> Blocks -orgToPandocTable (OrgTable _ aligns heads lns) = - B.table "" (zip aligns $ repeat 0) heads lns +orgToPandocTable (OrgTable _ aligns heads lns) caption = + B.table caption (zip aligns $ repeat 0) heads lns tableStart :: OrgParser Char tableStart = try $ skipSpaces *> char '|' diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 1ac2c1fd8..80a95d36b 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -8,7 +8,7 @@ import Tests.Arbitrary() import Text.Pandoc.Builder import Text.Pandoc import Data.List (intersperse) -import Data.Monoid (mempty, mconcat) +import Data.Monoid (mempty, mappend, mconcat) org :: String -> Pandoc org = readOrg def @@ -648,6 +648,18 @@ tests = [ [ plain "1" , plain "One" , plain "foo" ] , [ plain "2" , plain mempty , plain mempty ] ] + + , "Table with caption" =: + unlines [ "#+CAPTION: Hitchhiker's Multiplication Table" + , "| x | 6 |" + , "| 9 | 42 |" + ] =?> + table "Hitchhiker's Multiplication Table" + [(AlignDefault, 0), (AlignDefault, 0)] + [] + [ [ plain "x", plain "6" ] + , [ plain "9", plain "42" ] + ] ] , testGroup "Blocks and fragments" @@ -740,5 +752,22 @@ tests = , "\\end{equation}" ]) + , "Code block with caption" =: + unlines [ "#+CAPTION: Functor laws in Haskell" + , "#+NAME: functor-laws" + , "#+BEGIN_SRC haskell" + , "fmap id = id" + , "fmap (p . q) = (fmap p) . (fmap q)" + , "#+END_SRC" + ] =?> + divWith + nullAttr + (mappend + (plain $ spanWith ("", ["label"], []) + (spcSep [ "Functor", "laws", "in", "Haskell" ])) + (codeBlockWith ("functor-laws", ["haskell"], []) + (unlines [ "fmap id = id" + , "fmap (p . q) = (fmap p) . (fmap q)" + ]))) ] ] -- cgit v1.2.3 From a69416091ba035ab1661ff306ef3e51fd926488b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 19 Apr 2014 11:25:39 +0200 Subject: Org reader: Fix distinction of images and normal links Fixed a false assumption about the precedence of (&&) vs (||). --- src/Text/Pandoc/Readers/Org.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 025158060..66211b20e 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -860,8 +860,8 @@ linkTarget = enclosed (char '[') (char ']') (noneOf "\n\r]") isImageFilename :: String -> Bool isImageFilename filename = any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions && - any (\x -> (x++":") `isPrefixOf` filename) protocols || - ':' `notElem` filename + (any (\x -> (x++":") `isPrefixOf` filename) protocols || + ':' `notElem` filename) where imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ] protocols = [ "file", "http", "https" ] -- cgit v1.2.3 From 8e91d362a392d1ee90a497f39cfcf90fee8d8da0 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 19 Apr 2014 13:15:47 +0200 Subject: Org reader: Fix parsing of footnotes Footnotes can consist of multiple blocks and end only at a header or at the beginning of another footnote. This fixes the previous behavior, which restricted notes to a single paragraph. --- src/Text/Pandoc/Readers/Org.hs | 8 ++++++-- tests/Tests/Readers/Org.hs | 42 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+), 2 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 66211b20e..0bc0a2668 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -639,10 +639,14 @@ latexEnvName = try $ do -- noteBlock :: OrgParser (F Blocks) noteBlock = try $ do - ref <- noteMarker - content <- skipSpaces *> paraOrPlain + ref <- noteMarker <* skipSpaces + content <- mconcat <$> blocksTillHeaderOrNote addToNotesTable (ref, content) return mempty + where + blocksTillHeaderOrNote = + many1Till block (eof <|> () <$ lookAhead noteMarker + <|> () <$ lookAhead headerStart) -- Paragraphs or Plain text paraOrPlain :: OrgParser (F Blocks) diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 80a95d36b..4cc405c0f 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -383,6 +383,48 @@ tests = ] =?> para (image "the-red-queen.jpg" "fig:redqueen" "Used as a metapher in evolutionary biology.") + + , "Footnote" =: + unlines [ "A footnote[1]" + , "" + , "[1] First paragraph" + , "" + , "second paragraph" + ] =?> + para (mconcat + [ "A", space, "footnote" + , note $ mconcat [ para ("First" <> space <> "paragraph") + , para ("second" <> space <> "paragraph") + ] + ]) + + , "Two footnotes" =: + unlines [ "Footnotes[fn:1][fn:2]" + , "" + , "[fn:1] First note." + , "" + , "[fn:2] Second note." + ] =?> + para (mconcat + [ "Footnotes" + , note $ para ("First" <> space <> "note.") + , note $ para ("Second" <> space <> "note.") + ]) + + , "Footnote followed by header" =: + unlines [ "Another note[fn:yay]" + , "" + , "[fn:yay] This is great!" + , "" + , "** Headline" + ] =?> + mconcat + [ para (mconcat + [ "Another", space, "note" + , note $ para ("This" <> space <> "is" <> space <> "great!") + ]) + , header 2 "Headline" + ] ] , testGroup "Lists" $ -- cgit v1.2.3 From efebade38b3aef30b5fbf04e60f1fc2bd76e6c6c Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 19 Apr 2014 14:48:35 +0200 Subject: Move `compactify'DL` from Markdown reader into Shared The function `compactify'DL`, used to change the final definition item of a definition list into a `Plain` iff all other items are `Plain`s as well, is useful in many parsers and hence moved into Text.Pandoc.Shared. --- src/Text/Pandoc/Readers/Markdown.hs | 17 ----------------- src/Text/Pandoc/Shared.hs | 20 +++++++++++++++++--- 2 files changed, 17 insertions(+), 20 deletions(-) diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 57e1ca560..053385d20 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -861,22 +861,6 @@ definitionList = do items <- fmap sequence $ many1 definitionListItem return $ B.definitionList <$> fmap compactify'DL items -compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])] -compactify'DL items = - let defs = concatMap snd items - defBlocks = reverse $ concatMap B.toList defs - isPara (Para _) = True - isPara _ = False - in case defBlocks of - (Para x:_) -> if not $ any isPara (drop 1 defBlocks) - then let (t,ds) = last items - lastDef = B.toList $ last ds - ds' = init ds ++ - [B.fromList $ init lastDef ++ [Plain x]] - in init items ++ [(t, ds')] - else items - _ -> items - -- -- paragraph block -- @@ -1892,4 +1876,3 @@ doubleQuoted = try $ do (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return (fmap B.doubleQuoted . trimInlinesF $ contents)) <|> (return $ return (B.str "\8220") <> contents) - diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 3835629db..687355701 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -56,6 +56,7 @@ module Text.Pandoc.Shared ( stringify, compactify, compactify', + compactify'DL, Element (..), hierarchicalize, uniqueIdent, @@ -82,7 +83,7 @@ module Text.Pandoc.Shared ( import Text.Pandoc.Definition import Text.Pandoc.Walk import Text.Pandoc.Generic -import Text.Pandoc.Builder (Blocks, ToMetaValue(..)) +import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..)) import qualified Text.Pandoc.Builder as B import qualified Text.Pandoc.UTF8 as UTF8 import System.Environment (getProgName) @@ -435,6 +436,21 @@ compactify' items = _ -> items _ -> items +-- | Like @compactify'@, but akts on items of definition lists. +compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])] +compactify'DL items = + let defs = concatMap snd items + defBlocks = reverse $ concatMap B.toList defs + in case defBlocks of + (Para x:_) -> if not $ any isPara (drop 1 defBlocks) + then let (t,ds) = last items + lastDef = B.toList $ last ds + ds' = init ds ++ + [B.fromList $ init lastDef ++ [Plain x]] + in init items ++ [(t, ds')] + else items + _ -> items + isPara :: Block -> Bool isPara (Para _) = True isPara _ = False @@ -698,5 +714,3 @@ safeRead s = case reads s of (d,x):_ | all isSpace x -> return d _ -> fail $ "Could not read `" ++ s ++ "'" - - -- cgit v1.2.3 From 8276449520ba85c78f0b4e919fbc9bcf893a74f0 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 19 Apr 2014 15:05:03 +0200 Subject: Org reader: Allow for compact definition lists Use `Text.Pandoc.Shared.compactify'DL` to allow for compact definition lists. --- src/Text/Pandoc/Readers/Org.hs | 4 ++-- tests/Tests/Readers/Org.hs | 12 ++++++++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 0bc0a2668..c71cc24be 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -39,7 +39,7 @@ import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF , newline, orderedListMarker , parseFromString , updateLastStrPos ) -import Text.Pandoc.Shared (compactify') +import Text.Pandoc.Shared (compactify', compactify'DL) import Control.Applicative ( Applicative, pure , (<$>), (<$), (<*>), (<*), (*>), (<**>) ) @@ -665,7 +665,7 @@ list :: OrgParser (F Blocks) list = choice [ definitionList, bulletList, orderedList ] "list" definitionList :: OrgParser (F Blocks) -definitionList = fmap B.definitionList . sequence +definitionList = fmap B.definitionList . fmap compactify'DL . sequence <$> many1 (definitionListItem bulletListStart) bulletList :: OrgParser (F Blocks) diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 4cc405c0f..f62b73ce4 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -567,6 +567,18 @@ tests = ]) ] + , "Compact definition list" =: + unlines [ "- ATP :: adenosine 5' triphosphate" + , "- DNA :: deoxyribonucleic acid" + , "- PCR :: polymerase chain reaction" + , "" + ] =?> + definitionList + [ ("ATP", [ plain $ spcSep [ "adenosine", "5'", "triphosphate" ] ]) + , ("DNA", [ plain $ spcSep [ "deoxyribonucleic", "acid" ] ]) + , ("PCR", [ plain $ spcSep [ "polymerase", "chain", "reaction" ] ]) + ] + , "Loose bullet list" =: unlines [ "- apple" , "" -- cgit v1.2.3 From d44815c79bda5a547fb787af42c019564880bf19 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 19 Apr 2014 15:25:34 +0200 Subject: Add license statement for org reader files This adds a brief note to the COPYRIGHT file, declaring the code in the org-reader files to be licensed under the GPL. --- COPYRIGHT | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/COPYRIGHT b/COPYRIGHT index 8bf62135e..cfec5a4bf 100644 --- a/COPYRIGHT +++ b/COPYRIGHT @@ -55,6 +55,13 @@ Copyright (C) 2010 Paul Rivier Released under the GPL. +---------------------------------------------------------------------- +src/Text/Pandoc/Readers/Org.hs +tests/Tests/Readers/Org.hs +Copyright (C) 2014 Albert Krewinkel + +Released under the GPL. + ---------------------------------------------------------------------- src/Text/Pandoc/Biblio.hs Copyright (C) 2008-2010 Andrea Rossato -- cgit v1.2.3