ba5b426 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Org reader: ensure image sources are proper links

ba5b426Albert Krewinkel10 years ago

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

compare with master

unifiedsplit

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

39import Text.Pandoc.Readers.Org.ParserState

40import Text.Pandoc.Readers.Org.Parsing

41import Text.Pandoc.Readers.Org.Shared

42− ( isImageFilename, rundocBlockClass, toRundocAttrib

42+ ( cleanLinkString, isImageFilename, rundocBlockClass

43− , translateLang )

43+ , toRundocAttrib, translateLang )

45import qualified Text.Pandoc.Builder as B

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

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

571figure = try $ do

572 figAttrs <- blockAttributes

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

574+ case cleanLinkString src of

575+ Nothing -> mzero

576+ Just imgSrc -> do

574− guard . not . isNothing . blockAttrCaption $ figAttrs

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

575− guard (isImageFilename src)

578+ guard (isImageFilename imgSrc)

576− let figName = fromMaybe mempty $ blockAttrName figAttrs

579+ return $ figureBlock figAttrs imgSrc

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)

582 where

580 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+

583 withFigPrefix :: String -> String

595 withFigPrefix :: String -> String

584 withFigPrefix cs =

596 withFigPrefix cs =

585 if "fig:" `isPrefixOf` cs

597 if "fig:" `isPrefixOf` cs

586 then cs

598 then cs

587 else "fig:" ++ cs

599 else "fig:" ++ cs

588

600

589− selfTarget :: OrgParser String

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

591

601

592--

602--

593-- Examples

603-- Examples

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

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

37import Text.Pandoc.Readers.Org.ParserState

38import Text.Pandoc.Readers.Org.Parsing

39import Text.Pandoc.Readers.Org.Shared

40− ( isImageFilename, rundocBlockClass, toRundocAttrib

40+ ( cleanLinkString, isImageFilename, rundocBlockClass

41− , translateLang )

41+ , toRundocAttrib, translateLang )

43import qualified Text.Pandoc.Builder as B

44import Text.Pandoc.Builder ( Inlines )

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

52import Prelude hiding (sequence)

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

54import Data.Char ( isAlphaNum, isSpace )

55−import Data.List ( intersperse, isPrefixOf )

55+import Data.List ( intersperse )

56import Data.Maybe ( fromMaybe )

57import qualified Data.Map as M

58import Data.Traversable (sequence)

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

435 char ']'

436 return $ do

437 src <- srcF

438+ case cleanLinkString title of

438− if isImageFilename title

439+ Just imgSrc | isImageFilename imgSrc ->

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

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

441+ _ ->

440− else linkToInlinesF src =<< title'

442+ linkToInlinesF src =<< title'

441

443

442selflinkOrImage :: OrgParser (F Inlines)

444selflinkOrImage :: OrgParser (F Inlines)

443selflinkOrImage = try $ do

445selflinkOrImage = try $ do

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

482 else pure . B.link cleanedLink ""

484 else pure . B.link cleanedLink ""

483 Nothing -> internalLink linkStr -- other internal link

485 Nothing -> internalLink linkStr -- other internal link

484

486

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−

504internalLink :: String -> Inlines -> F Inlines

487internalLink :: String -> Inlines -> F Inlines

505internalLink link title = do

488internalLink link title = do

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

489 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

27Utility functions used in other Pandoc Org modules.

28-}

29module Text.Pandoc.Readers.Org.Shared

30+ ( cleanLinkString

30− ( isImageFilename

31+ , isImageFilename

31 , rundocBlockClass

32 , rundocBlockClass

32 , toRundocAttrib

33 , toRundocAttrib

33 , translateLang

34 , translateLang

34 ) where

35 ) where

36import Control.Arrow ( first )

37import Control.Arrow ( first )

38+import Data.Char ( isAlphaNum )

37import Data.List ( isPrefixOf, isSuffixOf )

39import Data.List ( isPrefixOf, isSuffixOf )

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

41isImageFilename :: String -> Bool

43isImageFilename :: String -> Bool

42isImageFilename filename =

44isImageFilename filename =

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

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

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

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

45 ':' `notElem` filename)

47 ':' `notElem` filename)

46 where

48 where

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

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

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

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

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+

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

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

51rundocPrefix :: String

72rundocPrefix :: String

52rundocPrefix = "rundoc-"

73rundocPrefix = "rundoc-"

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

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

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

220

221 , "Image link" =:

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

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

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

224

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

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

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

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

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

228

229 , "Plain link" =:

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

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

810 [ "Figure" =:

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

812 , "#+name: goodguy"

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

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

814 ] =?>

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

816

817 , "Figure with no name" =:

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

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

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

820 ] =?>

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

822

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

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

825 , "#+name: fig:redqueen"

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

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

827 ] =?>

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

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

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

830

831 , "Figure with HTML attributes" =:

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

833 , "#+NAME: lambdacat"

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

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

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

836 ] =?>

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

838 name = "fig:lambdacat"

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

842 , "Labelled figure" =:

843 unlines [ "#+CAPTION: My figure"

844 , "#+LABEL: fig:myfig"

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

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

846 ] =?>

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

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