cca9e8f · typeable/pandoc

src/Text/Pandoc/MIME.hs+30−10

compare with master

unifiedsplit

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

27

28Mime type lookup for ODT writer.

29-}

30−module Text.Pandoc.MIME ( getMimeType, extensionFromMimeType )

30+module Text.Pandoc.MIME ( MimeType, getMimeType, getMimeTypeDef,

31−where

31+ extensionFromMimeType )where

32import System.FilePath

33import Data.Char ( toLower )

34+import Data.List (isPrefixOf, isSuffixOf)

35+import Data.Maybe (fromMaybe)

34import qualified Data.Map as M

36import qualified Data.Map as M

35

37

38+type MimeType = String

39+

36-- | Determine mime type appropriate for file path.

40-- | Determine mime type appropriate for file path.

37−getMimeType :: FilePath -> Maybe String

41+getMimeType :: FilePath -> Maybe MimeType

42+getMimeType fp

43+ -- ODT

44+ | fp == "layout-cache" =

38−getMimeType "layout-cache" = Just "application/binary" -- in ODT

45+ Just "application/binary"

46+ | "Formula-" `isPrefixOf` fp && "/" `isSuffixOf` fp =

47+ Just "application/vnd.oasis.opendocument.formula"

48+ -- generic

39−getMimeType f = M.lookup (map toLower $ drop 1 $ takeExtension f) mimeTypes

49+ | otherwise = M.lookup (map toLower $ drop 1 $ takeExtension fp) mimeTypes

40− where mimeTypes = M.fromList mimeTypesList

50+

51+-- | Determime mime type appropriate for file path, defaulting to

52+-- “application/octet-stream” if nothing else fits.

53+getMimeTypeDef :: FilePath -> MimeType

54+getMimeTypeDef = fromMaybe "application/octet-stream" . getMimeType

41

55

42−extensionFromMimeType :: String -> Maybe String

56+extensionFromMimeType :: MimeType -> Maybe String

57+extensionFromMimeType mimetype =

43−extensionFromMimeType mimetype = M.lookup (takeWhile (/=';') mimetype) reverseMimeTypes

58+ M.lookup (takeWhile (/=';') mimetype) reverseMimeTypes

44 -- note: we just look up the basic mime type, dropping the content-encoding etc.

59 -- note: we just look up the basic mime type, dropping the content-encoding etc.

45− where reverseMimeTypes = M.fromList $ map (\(k,v) -> (v,k)) mimeTypesList

46

60

61+reverseMimeTypes :: M.Map MimeType String

62+reverseMimeTypes = M.fromList $ map (\(k,v) -> (v,k)) mimeTypesList

63+

64+mimeTypes :: M.Map String MimeType

65+mimeTypes = M.fromList mimeTypesList

66+

47−mimeTypesList :: [(String, String)]

67+mimeTypesList :: [(String, MimeType)]

48mimeTypesList = -- List borrowed from happstack-server.

68mimeTypesList = -- List borrowed from happstack-server.

49 [("gz","application/x-gzip")

69 [("gz","application/x-gzip")

50 ,("cabal","application/x-cabal")

70 ,("cabal","application/x-cabal")

src/Text/Pandoc/MediaBag.hs+10−10

@@ -42,7 +42,7 @@ import qualified Data.Map as M

42import qualified Data.ByteString.Lazy as BL

43import Data.Monoid (Monoid)

44import Control.Monad (when, MonadPlus(..))

45−import Text.Pandoc.MIME (getMimeType)

45+import Text.Pandoc.MIME (MimeType, getMimeTypeDef)

46import qualified Text.Pandoc.UTF8 as UTF8

47import Data.Maybe (fromMaybe)

48import System.IO (stderr)

@@ -51,7 +51,7 @@ import System.IO (stderr)

51-- mime types. Note that a 'MediaBag' is a Monoid, so 'mempty'

52-- can be used for an empty 'MediaBag', and '<>' can be used to append

53-- two 'MediaBag's.

54−newtype MediaBag = MediaBag (M.Map String (String, BL.ByteString))

54+newtype MediaBag = MediaBag (M.Map String (MimeType, BL.ByteString))

55 deriving (Monoid)

56

57instance Show MediaBag where

@@ -59,27 +59,27 @@ instance Show MediaBag where

59

60-- | Insert a media item into a 'MediaBag', replacing any existing

61-- value with the same name.

62−insertMedia :: FilePath -- ^ relative path and canonical name of resource

62+insertMedia :: FilePath -- ^ relative path and canonical name of resource

63− -> Maybe String -- ^ mime type (Nothing = determine from extension)

63+ -> Maybe MimeType -- ^ mime type (Nothing = determine from extension)

64− -> BL.ByteString -- ^ contents of resource

64+ -> BL.ByteString -- ^ contents of resource

65 -> MediaBag

66 -> MediaBag

67insertMedia fp mbMime contents (MediaBag mediamap) =

68 MediaBag (M.insert fp (mime, contents) mediamap)

69− where mime = fromMaybe "application/octet-stream" (mbMime `mplus` fallback)

69+ where mime = fromMaybe fallback mbMime

70 fallback = case takeExtension fp of

71− ".gz" -> getMimeType $ dropExtension fp

71+ ".gz" -> getMimeTypeDef $ dropExtension fp

72− _ -> getMimeType fp

72+ _ -> getMimeTypeDef fp

73

74-- | Lookup a media item in a 'MediaBag', returning mime type and contents.

75lookupMedia :: FilePath

76 -> MediaBag

77− -> Maybe (String, BL.ByteString)

77+ -> Maybe (MimeType, BL.ByteString)

78lookupMedia fp (MediaBag mediamap) = M.lookup fp mediamap

79

80-- | Get a list of the file paths stored in a 'MediaBag', with

81-- their corresponding mime types and the lengths in bytes of the contents.

82−mediaDirectory :: MediaBag -> [(String, String, Int)]

82+mediaDirectory :: MediaBag -> [(String, MimeType, Int)]

83mediaDirectory (MediaBag mediamap) =

84 M.foldWithKey (\fp (mime,contents) ->

85 ((fp, mime, fromIntegral $ BL.length contents):)) [] mediamap

src/Text/Pandoc/SelfContained.hs+3−2

@@ -42,6 +42,7 @@ import Codec.Compression.GZip as Gzip

42import qualified Data.ByteString.Lazy as L

43import Text.Pandoc.Shared (renderTags', err, fetchItem')

44import Text.Pandoc.MediaBag (MediaBag)

45+import Text.Pandoc.MIME (MimeType)

45import Text.Pandoc.UTF8 (toString, fromString)

46import Text.Pandoc.UTF8 (toString, fromString)

46import Text.Pandoc.Options (WriterOptions(..))

47import Text.Pandoc.Options (WriterOptions(..))

47

48

@@ -98,8 +99,8 @@ cssURLs media sourceURL d orig =

98 ";base64," `B.append` (encode raw)

99 ";base64," `B.append` (encode raw)

99 return $ x `B.append` "url(" `B.append` enc `B.append` rest

100 return $ x `B.append` "url(" `B.append` enc `B.append` rest

100

101

101−getRaw :: MediaBag -> Maybe String -> String -> String

102+getRaw :: MediaBag -> Maybe String -> MimeType -> String

102− -> IO (ByteString, String)

103+ -> IO (ByteString, MimeType)

103getRaw media sourceURL mimetype src = do

104getRaw media sourceURL mimetype src = do

104 let ext = map toLower $ takeExtension src

105 let ext = map toLower $ takeExtension src

105 fetchResult <- fetchItem' media sourceURL src

106 fetchResult <- fetchItem' media sourceURL src

src/Text/Pandoc/Shared.hs+4−4

@@ -107,7 +107,7 @@ import Network.URI ( escapeURIString, isURI, nonStrictRelativeTo,

107import qualified Data.Set as Set

108import System.Directory

109import System.FilePath (joinPath, splitDirectories)

110−import Text.Pandoc.MIME (getMimeType)

110+import Text.Pandoc.MIME (MimeType, getMimeType)

111import System.FilePath ( (</>), takeExtension, dropExtension)

112import Data.Generics (Typeable, Data)

113import qualified Control.Monad.State as S

@@ -779,7 +779,7 @@ readDataFileUTF8 userDir fname =

779-- | Fetch an image or other item from the local filesystem or the net.

780-- Returns raw content and maybe mime type.

781fetchItem :: Maybe String -> String

782− -> IO (Either E.SomeException (BS.ByteString, Maybe String))

782+ -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType))

783fetchItem sourceURL s =

784 case (sourceURL >>= parseURIReference . ensureEscaped, ensureEscaped s) of

785 (_, s') | isURI s' -> openURL s'

@@ -800,14 +800,14 @@ fetchItem sourceURL s =

800

801-- | Like 'fetchItem', but also looks for items in a 'MediaBag'.

802fetchItem' :: MediaBag -> Maybe String -> String

803− -> IO (Either E.SomeException (BS.ByteString, Maybe String))

803+ -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType))

804fetchItem' media sourceURL s = do

805 case lookupMedia s media of

806 Nothing -> fetchItem sourceURL s

807 Just (mime, bs) -> return $ Right (BS.concat $ toChunks bs, Just mime)

808

809-- | Read from a URL and return raw data and maybe mime type.

810−openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe String))

810+openURL :: String -> IO (Either E.SomeException (BS.ByteString, Maybe MimeType))

811openURL u

812 | Just u' <- stripPrefix "data:" u =

813 let mime = takeWhile (/=',') u'

src/Text/Pandoc/Writers/Docx.hs+8−8

@@ -57,8 +57,9 @@ import Data.Unique (hashUnique, newUnique)

57import System.Random (randomRIO)

58import Text.Printf (printf)

59import qualified Control.Exception as E

60−import Text.Pandoc.MIME (getMimeType, extensionFromMimeType)

60+import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,

61+ extensionFromMimeType)

61−import Control.Applicative ((<|>), (<$>))

62+import Control.Applicative ((<$>), (<|>))

62import Data.Maybe (mapMaybe)

63import Data.Maybe (mapMaybe)

63

64

64data ListMarker = NoMarker

65data ListMarker = NoMarker

@@ -91,7 +92,7 @@ data WriterState = WriterState{

91 , stFootnotes :: [Element]

92 , stFootnotes :: [Element]

92 , stSectionIds :: [String]

93 , stSectionIds :: [String]

93 , stExternalLinks :: M.Map String String

94 , stExternalLinks :: M.Map String String

94− , stImages :: M.Map FilePath (String, String, Maybe String, Element, B.ByteString)

95+ , stImages :: M.Map FilePath (String, String, Maybe MimeType, Element, B.ByteString)

95 , stListLevel :: Int

96 , stListLevel :: Int

96 , stListNumId :: Int

97 , stListNumId :: Int

97 , stLists :: [ListMarker]

98 , stLists :: [ListMarker]

@@ -185,11 +186,10 @@ writeDocx opts doc@(Pandoc meta _) = do

185 let mkOverrideNode (part', contentType') = mknode "Override"

186 let mkOverrideNode (part', contentType') = mknode "Override"

186 [("PartName",part'),("ContentType",contentType')] ()

187 [("PartName",part'),("ContentType",contentType')] ()

187 let mkImageOverride (_, imgpath, mbMimeType, _, _) =

188 let mkImageOverride (_, imgpath, mbMimeType, _, _) =

188− mkOverrideNode ("/word/" ++ imgpath,

189+ mkOverrideNode ("/word/" ++ imgpath,

189− fromMaybe "application/octet-stream" mbMimeType)

190+ fromMaybe "application/octet-stream" mbMimeType)

190− let mkMediaOverride imgpath = mkOverrideNode ('/':imgpath,

191+ let mkMediaOverride imgpath =

191− fromMaybe "application/octet-stream"

192+ mkOverrideNode ('/':imgpath, getMimeTypeDef imgpath)

192− $ getMimeType imgpath)

193 let overrides = map mkOverrideNode (

194 [("/word/webSettings.xml",

195 "application/vnd.openxmlformats-officedocument.wordprocessingml.webSettings+xml")

src/Text/Pandoc/Writers/EPUB.hs+2−2

@@ -65,7 +65,7 @@ import Text.Pandoc.UUID (getRandomUUID)

65import Text.Pandoc.Writers.HTML (writeHtmlString, writeHtml)

66import Data.Char ( toLower, isDigit, isAlphaNum )

67import Network.URI ( unEscapeString )

68−import Text.Pandoc.MIME (getMimeType)

68+import Text.Pandoc.MIME (MimeType, getMimeType)

69import qualified Control.Exception as E

70import Text.Blaze.Html.Renderer.Utf8 (renderHtml)

71import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)

@@ -851,7 +851,7 @@ ppTopElement = ("<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++) . unEntity .

851 Nothing -> '&':'#':unEntity xs

852 unEntity (x:xs) = x : unEntity xs

853

854−mediaTypeOf :: FilePath -> Maybe String

854+mediaTypeOf :: FilePath -> Maybe MimeType

855mediaTypeOf x =

856 let mediaPrefixes = ["image", "video", "audio"] in

857 case getMimeType x of

src/Text/Pandoc/Writers/ODT.hs+2−6

@@ -30,7 +30,7 @@ Conversion of 'Pandoc' documents to ODT.

30-}

31module Text.Pandoc.Writers.ODT ( writeODT ) where

32import Data.IORef

33−import Data.List ( isPrefixOf, isSuffixOf )

33+import Data.List ( isPrefixOf )

34import Data.Maybe ( fromMaybe )

35import Text.XML.Light.Output

36import Text.TeXMath

@@ -77,11 +77,7 @@ writeODT opts doc@(Pandoc meta _) = do

77 $ contentEntry : picEntries

78 -- construct META-INF/manifest.xml based on archive

79 let toFileEntry fp = case getMimeType fp of

80− Nothing -> if "Formula-" `isPrefixOf` fp && "/" `isSuffixOf` fp

81− then selfClosingTag "manifest:file-entry"

82− [("manifest:media-type","application/vnd.oasis.opendocument.formula")

83− ,("manifest:full-path",fp)]

84− else empty

80+ Nothing -> empty

85 Just m -> selfClosingTag "manifest:file-entry"

81 Just m -> selfClosingTag "manifest:file-entry"

86 [("manifest:media-type", m)

82 [("manifest:media-type", m)

87 ,("manifest:full-path", fp)

83 ,("manifest:full-path", fp)