@@ -29,16 +29,17 @@ Conversion of Org-Mode to 'Pandoc' document.
2929module Text.Pandoc.Readers.Org ( readOrg ) where
3030
3131import qualified Text.Pandoc.Builder as B
32−import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))
32+import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>), HasMeta(..))
3333import Text.Pandoc.Definition
3434import Text.Pandoc.Options
35−import Text.Pandoc.Parsing hiding (orderedListMarker)
35+import Text.Pandoc.Parsing hiding (orderedListMarker, updateLastStrPos)
3636import Text.Pandoc.Shared (compactify')
3737
3838import Control.Applicative (pure, (<$>), (<$), (<*>), (<*), (*>), (<**>))
3939import Control.Monad (guard, mzero)
4040import Data.Char (toLower)
41−import Data.List (foldl')
41+import Data.Default
42+import Data.List (foldl', isPrefixOf, isSuffixOf)
4243import Data.Maybe (listToMaybe, fromMaybe)
4344import Data.Monoid (mconcat, mempty, mappend)
4445
@@ -46,15 +47,48 @@ import Data.Monoid (mconcat, mempty, mappend)
4647readOrg :: ReaderOptions -- ^ Reader options
4748 -> String -- ^ String to parse (assuming @'\n'@ line endings)
4849 -> Pandoc
49−readOrg opts s = (readWith parseOrg) def{ stateOptions = opts } (s ++ "\n\n")
50+readOrg opts s = (readWith parseOrg) def{ orgOptions = opts } (s ++ "\n\n")
51+
52+type OrgParser = Parser [Char] OrgParserState
53+
54+-- | Org-mode parser state
55+data OrgParserState = OrgParserState
56+ { orgOptions :: ReaderOptions
57+ , orgInlineCharStack :: [Char]
58+ , orgLastStrPos :: Maybe SourcePos
59+ , orgMeta :: Meta
60+ } deriving (Show)
61+
62+instance HasReaderOptions OrgParserState where
63+ extractReaderOptions = orgOptions
64+
65+instance HasMeta OrgParserState where
66+ setMeta field val st =
67+ st{ orgMeta = setMeta field val $ orgMeta st }
68+ deleteMeta field st =
69+ st{ orgMeta = deleteMeta field $ orgMeta st }
70+
71+instance Default OrgParserState where
72+ def = defaultOrgParserState
73+
74+defaultOrgParserState :: OrgParserState
75+defaultOrgParserState = OrgParserState
76+ { orgOptions = def
77+ , orgInlineCharStack = []
78+ , orgLastStrPos = Nothing
79+ , orgMeta = nullMeta
80+ }
81+
82+updateLastStrPos :: OrgParser ()
83+updateLastStrPos = getPosition >>= \p ->
84+ updateState $ \s -> s{ orgLastStrPos = Just p }
5085
51−type OrgParser = Parser [Char] ParserState
5286
5387parseOrg:: OrgParser Pandoc
5488parseOrg = do
5589 blocks' <- B.toList <$> parseBlocks
5690 st <- getState
57− let meta = stateMeta st
91+ let meta = orgMeta st
5892 return $ Pandoc meta $ filter (/= Null) blocks'
5993
6094--
@@ -119,7 +153,14 @@ indentWith num = do
119153 , try (char '\t' >> count (num - tabStop) (char ' ')) ]
120154
121155translateLang :: String -> String
122−translateLang "sh" = "bash"
156+translateLang "C" = "c"
157+translateLang "C++" = "cpp"
158+translateLang "emacs-lisp" = "commonlisp" -- emacs lisp is not supported
159+translateLang "js" = "javascript"
160+translateLang "lisp" = "commonlisp"
161+translateLang "R" = "r"
162+translateLang "sh" = "bash"
163+translateLang "sqlite" = "sql"
123164translateLang cs = cs
124165
125166commaEscaped :: String -> String
@@ -177,7 +218,7 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
177218declarationLine :: OrgParser Blocks
178219declarationLine = try $ do
179220 meta' <- B.setMeta <$> metaKey <*> metaValue <*> pure nullMeta
180− updateState $ \st -> st { stateMeta = stateMeta st <> meta' }
221+ updateState $ \st -> st { orgMeta = orgMeta st <> meta' }
181222 return mempty
182223
183224metaValue :: OrgParser MetaValue
@@ -217,13 +258,18 @@ data OrgTableRow = OrgContentRow [Blocks]
217258 | OrgHlineRow
218259 deriving (Eq, Show)
219260
220−type OrgTableContent = (Int, [Alignment], [Double], [Blocks], [[Blocks]])
261+data OrgTable = OrgTable
262+ { orgTableColumns :: Int
263+ , orgTableAlignments :: [Alignment]
264+ , orgTableHeader :: [Blocks]
265+ , orgTableRows :: [[Blocks]]
266+ } deriving (Eq, Show)
221267
222268table :: OrgParser Blocks
223269table = try $ do
224270 lookAhead tableStart
225− (_, aligns, widths, heads, lns) <- normalizeTable . tableContent <$> tableRows
226− return $ B.table "" (zip aligns widths) heads lns
271+ OrgTable _ aligns heads lns <- normalizeTable . rowsToTable <$> tableRows
272+ return $ B.table "" (zip aligns $ repeat 0) heads lns
227273
228274tableStart :: OrgParser Char
229275tableStart = try $ skipSpaces *> char '|'
@@ -237,10 +283,9 @@ tableContentRow = try $
237283
238284tableContentCell :: OrgParser Blocks
239285tableContentCell = try $
240− B.plain . trimInlines . mconcat <$> many1Till inline (try endOfCell)
286+ B.plain . trimInlines . mconcat <$> many1Till inline endOfCell
241287
242288endOfCell :: OrgParser Char
243−-- endOfCell = char '|' <|> newline
244289endOfCell = try $ char '|' <|> lookAhead newline
245290
246291tableAlignRow :: OrgParser OrgTableRow
@@ -269,54 +314,53 @@ tableHline :: OrgParser OrgTableRow
269314tableHline = try $
270315 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)
271316
272−tableContent :: [OrgTableRow]
273− -> OrgTableContent
274−tableContent = foldl' (flip rowToContent) (0, mempty, repeat 0, mempty, mempty)
317+rowsToTable :: [OrgTableRow]
318+ -> OrgTable
319+rowsToTable = foldl' (flip rowToContent) zeroTable
320+ where zeroTable = OrgTable 0 mempty mempty mempty
275321
276−normalizeTable :: OrgTableContent
277− -> OrgTableContent
278−normalizeTable (cols, aligns, widths, heads, lns) =
322+normalizeTable :: OrgTable
323+ -> OrgTable
324+normalizeTable (OrgTable cols aligns heads lns) =
279325 let aligns' = fillColumns aligns AlignDefault
280− widths' = fillColumns widths 0.0
281326 heads' = if heads == mempty
282− then heads
327+ then mempty
283328 else fillColumns heads (B.plain mempty)
284329 lns' = map (flip fillColumns (B.plain mempty)) lns
285330 fillColumns base padding = take cols $ base ++ repeat padding
286− in (cols, aligns', widths', heads', lns')
331+ in OrgTable cols aligns' heads' lns'
287332
288333
289334-- One or more horizontal rules after the first content line mark the previous
290335-- line as a header. All other horizontal lines are discarded.
291336rowToContent :: OrgTableRow
292− -> OrgTableContent
293− -> OrgTableContent
337+ -> OrgTable
338+ -> OrgTable
294339rowToContent OrgHlineRow = maybeBodyToHeader
295340rowToContent (OrgContentRow rs) = setLongestRow rs . appendToBody rs
296341rowToContent (OrgAlignRow as) = setLongestRow as . setAligns as
297342
298343setLongestRow :: [a]
299− -> OrgTableContent
300− -> OrgTableContent
301−setLongestRow r (cols, aligns, widths, heads, lns) =
302− (max cols (length r), aligns, widths, heads, lns)
344+ -> OrgTable
345+ -> OrgTable
346+setLongestRow rs t = t{ orgTableColumns = max (length rs) (orgTableColumns t) }
303347
304−maybeBodyToHeader :: OrgTableContent
305− -> OrgTableContent
306−maybeBodyToHeader (cols, aligns, widths, [], b:[]) = (cols, aligns, widths, b, [])
307−maybeBodyToHeader content = content
348+maybeBodyToHeader :: OrgTable
349+ -> OrgTable
350+maybeBodyToHeader t = case t of
351+ OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->
352+ t{ orgTableHeader = b , orgTableRows = [] }
353+ _ -> t
308354
309355appendToBody :: [Blocks]
310− -> OrgTableContent
311− -> OrgTableContent
312−appendToBody r (cols, aligns, widths, heads, lns) =
313− (cols, aligns, widths, heads, lns ++ [r])
356+ -> OrgTable
357+ -> OrgTable
358+appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }
314359
315360setAligns :: [Alignment]
316− -> OrgTableContent
317− -> OrgTableContent
318−setAligns aligns (cols, _, widths, heads, lns) =
319− (cols, aligns, widths, heads, lns)
361+ -> OrgTable
362+ -> OrgTable
363+setAligns aligns t = t{ orgTableAlignments = aligns }
320364
321365-- Paragraphs or Plain text
322366paraOrPlain :: OrgParser Blocks
@@ -440,20 +484,26 @@ endline = try $ do
440484 return B.space
441485
442486link :: OrgParser Inlines
443−link = explicitLink <|> selfLink <?> "link"
487+link = explicitOrImageLink <|> selflinkOrImage <?> "link"
444488
445−explicitLink :: OrgParser Inlines
446−explicitLink = try $ do
489+explicitOrImageLink :: OrgParser Inlines
490+explicitOrImageLink = try $ do
447491 char '['
448− src <- enclosedRaw (char '[') (char ']')
449− title <- enclosedInlines (char '[') (char ']')
492+ src <- enclosedRaw (char '[') (char ']')
493+ title <- enclosedRaw (char '[') (char ']')
494+ title' <- parseFromString (mconcat . butLast <$> many inline) (title++"\n")
450495 char ']'
451− return $ B.link src "" title
496+ return $ if (isImage src) && (isImage title)
497+ then B.link src "" (B.image title "" "")
498+ else B.link src "" title'
499+ where butLast = reverse . tail . reverse
452500
453−selfLink :: OrgParser Inlines
454−selfLink = try $ do
501+selflinkOrImage :: OrgParser Inlines
502+selflinkOrImage = try $ do
455503 src <- enclosedRaw (string "[[") (string "]]")
456− return $ B.link src "" (B.str src)
504+ return $ if isImage src
505+ then B.image src "" ""
506+ else B.link src "" (B.str src)
457507
458508emph :: OrgParser Inlines
459509emph = B.emph <$> inlinesEnclosedBy '/'
@@ -498,8 +548,15 @@ enclosedInlines start end = try $
498548-- FIXME: This is a hack
499549inlinesEnclosedBy :: Char
500550 -> OrgParser Inlines
501−inlinesEnclosedBy c = enclosedInlines (atStart (char c) <* endsOnThisOrNextLine c)
502− (atEnd $ char c)
551+inlinesEnclosedBy c = try $ do
552+ updateState $ \st -> st { orgInlineCharStack = c:(orgInlineCharStack st) }
553+ res <- enclosedInlines (atStart (char c) <* endsOnThisOrNextLine c)
554+ (atEnd $ char c)
555+ updateState $ \st -> st { orgInlineCharStack = shift . orgInlineCharStack $ st }
556+ return res
557+ where shift xs
558+ | null xs = []
559+ | otherwise = tail xs
503560
504561enclosedRaw :: OrgParser a
505562 -> OrgParser b
@@ -519,16 +576,21 @@ atStart :: OrgParser a -> OrgParser a
519576atStart p = do
520577 pos <- getPosition
521578 st <- getState
522− guard $ stateLastStrPos st /= Just pos
579+ guard $ orgLastStrPos st /= Just pos
523580 p
524581
525582-- | succeeds only if we're at the end of a word
526583atEnd :: OrgParser a -> OrgParser a
527−atEnd p = try $ p <* lookingAtEndOfWord
528− where lookingAtEndOfWord = lookAhead . oneOf $ postWordChars
584+atEnd p = try $ do
585+ p <* lookingAtEndOfWord
586+ where lookingAtEndOfWord = lookAhead . oneOf =<< postWordChars
529587
530−postWordChars :: [Char]
531−postWordChars = "\t\n\r !\"'),-.:?}"
588+postWordChars :: OrgParser [Char]
589+postWordChars = do
590+ st <- getState
591+ return $ "\t\n\r !\"'),-.:?}" ++ (safeSecond . orgInlineCharStack $ st)
592+ where safeSecond (_:x2:_) = [x2]
593+ safeSecond _ = []
532594
533595-- FIXME: These functions are hacks and should be replaced
534596endsOnThisOrNextLine :: Char
@@ -543,10 +605,18 @@ endsOnThisLine :: [Char]
543605 -> ([Char] -> OrgParser ())
544606 -> OrgParser ()
545607endsOnThisLine input c doOnOtherLines = do
608+ postWordChars' <- postWordChars
546609 case break (`elem` c:"\n") input of
547610 (_,'\n':rest) -> doOnOtherLines rest
548− (_,_:rest@(n:_)) -> if n `elem` postWordChars
611+ (_,_:rest@(n:_)) -> if n `elem` postWordChars'
549612 then return ()
550613 else endsOnThisLine rest c doOnOtherLines
551614 _ -> mzero
552615
616+isImage filename =
617+ any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
618+ any (\x -> (x++":") `isPrefixOf` filename) protocols ||
619+ ':' `notElem` filename
620+ where
621+ imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
622+ protocols = [ "file", "http", "https" ]