3a6e15a · typeable/pandoc

git.iko.soy/typeable/pandoc

Merge pull request #3067 from tarleb/org-figure-bugfix

Org reader: ensure image sources are proper links

commit3a6e15a3131f2ced7daf912ed9df16e6a0860a37 authorJohn MacFarlane <jgm@berkeley.edu> dateTue 9 Aug 2016, 21:31 (10 years ago) parent0fbb676 ba5b426

4 files changed+62−48

compare with master

unifiedsplit

src/Text/Pandoc/Readers/Org/Blocks.hs+22−12 src/Text/Pandoc/Readers/Org/Inlines.hs+8−25 src/Text/Pandoc/Readers/Org/Shared.hs+23−2 tests/Tests/Readers/Org.hs+9−9

src/Text/Pandoc/Readers/Org/Blocks.hs+22−12

@@ -39,8 +39,8 @@ import Text.Pandoc.Readers.Org.Inlines

3939import Text.Pandoc.Readers.Org.ParserState

4040import Text.Pandoc.Readers.Org.Parsing

4141import Text.Pandoc.Readers.Org.Shared

42− ( isImageFilename, rundocBlockClass, toRundocAttrib

43− , translateLang )

42+ ( cleanLinkString, isImageFilename, rundocBlockClass

43+ , toRundocAttrib, translateLang )

4444

4545import qualified Text.Pandoc.Builder as B

4646import Text.Pandoc.Builder ( Inlines, Blocks )

@@ -571,23 +571,33 @@ figure :: OrgParser (F Blocks)

571571figure = try $ do

572572 figAttrs <- blockAttributes

573573 src <- skipSpaces *> selfTarget <* skipSpaces <* newline

574− guard . not . isNothing . blockAttrCaption $ figAttrs

575− guard (isImageFilename src)

576− let figName = fromMaybe mempty $ blockAttrName figAttrs

577− let figLabel = fromMaybe mempty $ blockAttrLabel figAttrs

578− let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs

579− let figKeyVals = blockAttrKeyValues figAttrs

580− let attr = (figLabel, mempty, figKeyVals)

581− return $ (B.para . B.imageWith attr src (withFigPrefix figName) <$> figCaption)

574+ case cleanLinkString src of

575+ Nothing -> mzero

576+ Just imgSrc -> do

577+ guard (not . isNothing . blockAttrCaption $ figAttrs)

578+ guard (isImageFilename imgSrc)

579+ return $ figureBlock figAttrs imgSrc

582580 where

581+ selfTarget :: OrgParser String

582+ selfTarget = try $ char '[' *> linkTarget <* char ']'

583+

584+ figureBlock :: BlockAttributes -> String -> (F Blocks)

585+ figureBlock figAttrs imgSrc =

586+ let

587+ figName = fromMaybe mempty $ blockAttrName figAttrs

588+ figLabel = fromMaybe mempty $ blockAttrLabel figAttrs

589+ figCaption = fromMaybe mempty $ blockAttrCaption figAttrs

590+ figKeyVals = blockAttrKeyValues figAttrs

591+ attr = (figLabel, mempty, figKeyVals)

592+ in

593+ B.para . B.imageWith attr imgSrc (withFigPrefix figName) <$> figCaption

594+

583595 withFigPrefix :: String -> String

584596 withFigPrefix cs =

585597 if "fig:" `isPrefixOf` cs

586598 then cs

587599 else "fig:" ++ cs

588600

589− selfTarget :: OrgParser String

590− selfTarget = try $ char '[' *> linkTarget <* char ']'

591601

592602--

593603-- Examples

src/Text/Pandoc/Readers/Org/Inlines.hs+8−25

@@ -37,8 +37,8 @@ import Text.Pandoc.Readers.Org.BlockStarts

3737import Text.Pandoc.Readers.Org.ParserState

3838import Text.Pandoc.Readers.Org.Parsing

3939import Text.Pandoc.Readers.Org.Shared

40− ( isImageFilename, rundocBlockClass, toRundocAttrib

41− , translateLang )

40+ ( cleanLinkString, isImageFilename, rundocBlockClass

41+ , toRundocAttrib, translateLang )

4242

4343import qualified Text.Pandoc.Builder as B

4444import Text.Pandoc.Builder ( Inlines )

@@ -52,7 +52,7 @@ import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

5252import Prelude hiding (sequence)

5353import Control.Monad ( guard, mplus, mzero, when, void )

5454import Data.Char ( isAlphaNum, isSpace )

55−import Data.List ( intersperse, isPrefixOf )

55+import Data.List ( intersperse )

5656import Data.Maybe ( fromMaybe )

5757import qualified Data.Map as M

5858import Data.Traversable (sequence)

@@ -435,9 +435,11 @@ explicitOrImageLink = try $ do

435435 char ']'

436436 return $ do

437437 src <- srcF

438− if isImageFilename title

439− then pure $ B.link src "" $ B.image title mempty mempty

440− else linkToInlinesF src =<< title'

438+ case cleanLinkString title of

439+ Just imgSrc | isImageFilename imgSrc ->

440+ pure $ B.link src "" $ B.image imgSrc mempty mempty

441+ _ ->

442+ linkToInlinesF src =<< title'

441443

442444selflinkOrImage :: OrgParser (F Inlines)

443445selflinkOrImage = try $ do

@@ -482,25 +484,6 @@ linkToInlinesF linkStr =

482484 else pure . B.link cleanedLink ""

483485 Nothing -> internalLink linkStr -- other internal link

484486

485−-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if

486−-- the string does not appear to be a link.

487−cleanLinkString :: String -> Maybe String

488−cleanLinkString s =

489− case s of

490− '/':_ -> Just $ "file://" ++ s -- absolute path

491− '.':'/':_ -> Just s -- relative path

492− '.':'.':'/':_ -> Just s -- relative path

493− -- Relative path or URL (file schema)

494− 'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'

495− _ | isUrl s -> Just s -- URL

496− _ -> Nothing

497− where

498− isUrl :: String -> Bool

499− isUrl cs =

500− let (scheme, path) = break (== ':') cs

501− in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme

502− && not (null path)

503−

504487internalLink :: String -> Inlines -> F Inlines

505488internalLink link title = do

506489 anchorB <- (link `elem`) <$> asksF orgStateAnchorIds

src/Text/Pandoc/Readers/Org/Shared.hs+23−2

@@ -27,13 +27,15 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

2727Utility functions used in other Pandoc Org modules.

2828-}

2929module Text.Pandoc.Readers.Org.Shared

30− ( isImageFilename

30+ ( cleanLinkString

31+ , isImageFilename

3132 , rundocBlockClass

3233 , toRundocAttrib

3334 , translateLang

3435 ) where

3536

3637import Control.Arrow ( first )

38+import Data.Char ( isAlphaNum )

3739import Data.List ( isPrefixOf, isSuffixOf )

3840

3941

@@ -41,12 +43,31 @@ import Data.List ( isPrefixOf, isSuffixOf )

4143isImageFilename :: String -> Bool

4244isImageFilename filename =

4345 any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&

44− (any (\x -> (x++":") `isPrefixOf` filename) protocols ||

46+ (any (\x -> (x ++ "://") `isPrefixOf` filename) protocols ||

4547 ':' `notElem` filename)

4648 where

4749 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

4850 protocols = [ "file", "http", "https" ]

4951

52+-- | Cleanup and canonicalize a string describing a link. Return @Nothing@ if

53+-- the string does not appear to be a link.

54+cleanLinkString :: String -> Maybe String

55+cleanLinkString s =

56+ case s of

57+ '/':_ -> Just $ "file://" ++ s -- absolute path

58+ '.':'/':_ -> Just s -- relative path

59+ '.':'.':'/':_ -> Just s -- relative path

60+ -- Relative path or URL (file schema)

61+ 'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'

62+ _ | isUrl s -> Just s -- URL

63+ _ -> Nothing

64+ where

65+ isUrl :: String -> Bool

66+ isUrl cs =

67+ let (scheme, path) = break (== ':') cs

68+ in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme

69+ && not (null path)

70+

5071-- | Prefix used for Rundoc classes and arguments.

5172rundocPrefix :: String

5273rundocPrefix = "rundoc-"

tests/Tests/Readers/Org.hs+9−9

@@ -219,12 +219,12 @@ tests =

219219 (para $ link "" "" "New Link")

220220

221221 , "Image link" =:

222− "[[sunset.png][dusk.svg]]" =?>

222+ "[[sunset.png][file:dusk.svg]]" =?>

223223 (para $ link "sunset.png" "" (image "dusk.svg" "" ""))

224224

225225 , "Image link with non-image target" =:

226− "[[http://example.com][logo.png]]" =?>

227− (para $ link "http://example.com" "" (image "logo.png" "" ""))

226+ "[[http://example.com][./logo.png]]" =?>

227+ (para $ link "http://example.com" "" (image "./logo.png" "" ""))

228228

229229 , "Plain link" =:

230230 "Posts on http://zeitlens.com/ can be funny at times." =?>

@@ -810,29 +810,29 @@ tests =

810810 [ "Figure" =:

811811 unlines [ "#+caption: A very courageous man."

812812 , "#+name: goodguy"

813− , "[[edward.jpg]]"

813+ , "[[file:edward.jpg]]"

814814 ] =?>

815815 para (image "edward.jpg" "fig:goodguy" "A very courageous man.")

816816

817817 , "Figure with no name" =:

818818 unlines [ "#+caption: I've been through the desert on this"

819− , "[[horse.png]]"

819+ , "[[file:horse.png]]"

820820 ] =?>

821821 para (image "horse.png" "fig:" "I've been through the desert on this")

822822

823823 , "Figure with `fig:` prefix in name" =:

824824 unlines [ "#+caption: Used as a metapher in evolutionary biology."

825825 , "#+name: fig:redqueen"

826− , "[[the-red-queen.jpg]]"

826+ , "[[./the-red-queen.jpg]]"

827827 ] =?>

828− para (image "the-red-queen.jpg" "fig:redqueen"

828+ para (image "./the-red-queen.jpg" "fig:redqueen"

829829 "Used as a metapher in evolutionary biology.")

830830

831831 , "Figure with HTML attributes" =:

832832 unlines [ "#+CAPTION: mah brain just explodid"

833833 , "#+NAME: lambdacat"

834834 , "#+ATTR_HTML: :style color: blue :role button"

835− , "[[lambdacat.jpg]]"

835+ , "[[file:lambdacat.jpg]]"

836836 ] =?>

837837 let kv = [("style", "color: blue"), ("role", "button")]

838838 name = "fig:lambdacat"

@@ -842,7 +842,7 @@ tests =

842842 , "Labelled figure" =:

843843 unlines [ "#+CAPTION: My figure"

844844 , "#+LABEL: fig:myfig"

845− , "[[blub.png]]"

845+ , "[[file:blub.png]]"

846846 ] =?>

847847 let attr = ("fig:myfig", mempty, mempty)

848848 in para (imageWith attr "blub.png" "fig:" "My figure")