cca9e8f · typeable/pandoc

git.iko.soy/typeable/pandoc

MIME cleanup.

* Create a type synonym for MIME type (instead of `String`). * Add `getMimeTypeDef` function. * Avoid recreating MIME type `Map`s every time. * Move “Formula-...” case handling into `getMimeType`.

commitcca9e8feb4b8c0638147e330cd7151bddb150c70 authorArtyom Kazak <yom@artyom.me> dateSun 17 Aug 2014, 20:42 (12 years ago) parent9d52ecd

7 files changed+59−42

compare with master

unifiedsplit

src/Text/Pandoc/MIME.hs+30−10 src/Text/Pandoc/MediaBag.hs+10−10 src/Text/Pandoc/SelfContained.hs+3−2 src/Text/Pandoc/Shared.hs+4−4 src/Text/Pandoc/Writers/Docx.hs+8−8 src/Text/Pandoc/Writers/EPUB.hs+2−2 src/Text/Pandoc/Writers/ODT.hs+2−6

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

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

2727

2828Mime type lookup for ODT writer.

2929-}

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

31−where

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

31+ extensionFromMimeType )where

3232import System.FilePath

3333import Data.Char ( toLower )

34+import Data.List (isPrefixOf, isSuffixOf)

35+import Data.Maybe (fromMaybe)

3436import qualified Data.Map as M

3537

38+type MimeType = String

39+

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

37−getMimeType :: FilePath -> Maybe String

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

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

40− where mimeTypes = M.fromList mimeTypesList

41+getMimeType :: FilePath -> Maybe MimeType

42+getMimeType fp

43+ -- ODT

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

45+ Just "application/binary"

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

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

48+ -- generic

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

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

4155

42−extensionFromMimeType :: String -> Maybe String

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

56+extensionFromMimeType :: MimeType -> Maybe String

57+extensionFromMimeType mimetype =

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

4459 -- 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

4660

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

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+

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

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

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

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

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

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

4242import qualified Data.ByteString.Lazy as BL

4343import Data.Monoid (Monoid)

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

45−import Text.Pandoc.MIME (getMimeType)

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

4646import qualified Text.Pandoc.UTF8 as UTF8

4747import Data.Maybe (fromMaybe)

4848import System.IO (stderr)

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

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

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

5353-- two 'MediaBag's.

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

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

5555 deriving (Monoid)

5656

5757instance Show MediaBag where

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

5959

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

6161-- value with the same name.

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

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

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

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

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

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

6565 -> MediaBag

6666 -> MediaBag

6767insertMedia fp mbMime contents (MediaBag mediamap) =

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

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

69+ where mime = fromMaybe fallback mbMime

7070 fallback = case takeExtension fp of

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

72− _ -> getMimeType fp

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

72+ _ -> getMimeTypeDef fp

7373

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

7575lookupMedia :: FilePath

7676 -> MediaBag

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

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

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

7979

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

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

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

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

8383mediaDirectory (MediaBag mediamap) =

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

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

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

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

4242import qualified Data.ByteString.Lazy as L

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

4444import Text.Pandoc.MediaBag (MediaBag)

45+import Text.Pandoc.MIME (MimeType)

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

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

4748

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

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

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

100101

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

102− -> IO (ByteString, String)

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

103+ -> IO (ByteString, MimeType)

103104getRaw media sourceURL mimetype src = do

104105 let ext = map toLower $ takeExtension src

105106 fetchResult <- fetchItem' media sourceURL src

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

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

107107import qualified Data.Set as Set

108108import System.Directory

109109import System.FilePath (joinPath, splitDirectories)

110−import Text.Pandoc.MIME (getMimeType)

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

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

112112import Data.Generics (Typeable, Data)

113113import qualified Control.Monad.State as S

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

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

780780-- Returns raw content and maybe mime type.

781781fetchItem :: Maybe String -> String

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

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

783783fetchItem sourceURL s =

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

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

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

800800

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

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

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

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

804804fetchItem' media sourceURL s = do

805805 case lookupMedia s media of

806806 Nothing -> fetchItem sourceURL s

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

808808

809809-- | 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))

811811openURL u

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

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

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

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

5757import System.Random (randomRIO)

5858import Text.Printf (printf)

5959import qualified Control.Exception as E

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

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

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

61+ extensionFromMimeType)

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

6263import Data.Maybe (mapMaybe)

6364

6465data ListMarker = NoMarker

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

9192 , stFootnotes :: [Element]

9293 , stSectionIds :: [String]

9394 , 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)

9596 , stListLevel :: Int

9697 , stListNumId :: Int

9798 , stLists :: [ListMarker]

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

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

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

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

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

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

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

191− fromMaybe "application/octet-stream"

192− $ getMimeType imgpath)

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

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

191+ let mkMediaOverride imgpath =

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

193193 let overrides = map mkOverrideNode (

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

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

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

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

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

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

6767import Network.URI ( unEscapeString )

68−import Text.Pandoc.MIME (getMimeType)

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

6969import qualified Control.Exception as E

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

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

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

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

852852 unEntity (x:xs) = x : unEntity xs

853853

854−mediaTypeOf :: FilePath -> Maybe String

854+mediaTypeOf :: FilePath -> Maybe MimeType

855855mediaTypeOf x =

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

857857 case getMimeType x of

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

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

3030-}

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

3232import Data.IORef

33−import Data.List ( isPrefixOf, isSuffixOf )

33+import Data.List ( isPrefixOf )

3434import Data.Maybe ( fromMaybe )

3535import Text.XML.Light.Output

3636import Text.TeXMath

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

7777 $ contentEntry : picEntries

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

7979 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

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

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

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