From b2385d0e9bf13f2fc152a3983893c47f2ab5d4c0 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 16 Jul 2013 22:04:59 -0700 Subject: Text.Pandoc.ImageSize: Handle EPS. Closes #903. This change will make EPS images properly sized on conversion to Word. --- src/Text/Pandoc/ImageSize.hs | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 273a1a428..9b0850efb 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -34,11 +34,12 @@ import Data.ByteString (ByteString, unpack) import qualified Data.ByteString.Char8 as B import Control.Monad import Data.Bits +import Text.Pandoc.Shared (safeRead) -- quick and dirty functions to get image sizes -- algorithms borrowed from wwwis.pl -data ImageType = Png | Gif | Jpeg | Pdf deriving Show +data ImageType = Png | Gif | Jpeg | Pdf | Eps deriving Show data ImageSize = ImageSize{ pxX :: Integer @@ -54,6 +55,9 @@ imageType img = case B.take 4 img of "\x47\x49\x46\x38" -> return Gif "\xff\xd8\xff\xe0" -> return Jpeg "%PDF" -> return Pdf + "%!PS" + | (B.take 4 $ B.drop 1 $ B.dropWhile (/=' ') img) == "EPSF" + -> return Eps _ -> fail "Unknown image type" imageSize :: ByteString -> Maybe ImageSize @@ -63,6 +67,7 @@ imageSize img = do Png -> pngSize img Gif -> gifSize img Jpeg -> jpegSize img + Eps -> epsSize img Pdf -> Nothing -- TODO sizeInPixels :: ImageSize -> (Integer, Integer) @@ -71,6 +76,23 @@ sizeInPixels s = (pxX s, pxY s) sizeInPoints :: ImageSize -> (Integer, Integer) sizeInPoints s = (pxX s * 72 `div` dpiX s, pxY s * 72 `div` dpiY s) +epsSize :: ByteString -> Maybe ImageSize +epsSize img = do + let ls = takeWhile ("%" `B.isPrefixOf`) $ B.lines img + let ls' = dropWhile (not . ("%%BoundingBox:" `B.isPrefixOf`)) ls + case ls' of + [] -> mzero + (x:_) -> case B.words x of + (_:_:_:ux:uy:[]) -> do + ux' <- safeRead $ B.unpack ux + uy' <- safeRead $ B.unpack uy + return ImageSize{ + pxX = ux' + , pxY = uy' + , dpiX = 72 + , dpiY = 72 } + _ -> mzero + pngSize :: ByteString -> Maybe ImageSize pngSize img = do let (h, rest) = B.splitAt 8 img -- cgit v1.2.3 From 3bf8012bf6e6965a68de76d5bb46782086393da7 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 8 Jan 2014 19:33:14 -0800 Subject: Text.Pandoc.ImageSize: Parse EXIF format JPGs. Note: For now we just assign them all 72 dpi. It wasn't clear to me how to extract the resolution information. At least the aspect ratio will be right, and 72 dpi is the most common setting. Closes #976. --- src/Text/Pandoc/ImageSize.hs | 34 ++++++++++++++++++++++++++++------ 1 file changed, 28 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 9b0850efb..e2a8b8283 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -53,7 +53,8 @@ imageType :: ByteString -> Maybe ImageType imageType img = case B.take 4 img of "\x89\x50\x4e\x47" -> return Png "\x47\x49\x46\x38" -> return Gif - "\xff\xd8\xff\xe0" -> return Jpeg + "\xff\xd8\xff\xe0" -> return Jpeg -- JFIF + "\xff\xd8\xff\xe1" -> return Jpeg -- Exif "%PDF" -> return Pdf "%!PS" | (B.take 4 $ B.drop 1 $ B.dropWhile (/=' ') img) == "EPSF" @@ -139,8 +140,14 @@ gifSize img = do jpegSize :: ByteString -> Maybe ImageSize jpegSize img = do let (hdr, rest) = B.splitAt 4 img - guard $ hdr == "\xff\xd8\xff\xe0" guard $ B.length rest >= 14 + case hdr of + "\xff\xd8\xff\xe0" -> jfifSize rest + "\xff\xd8\xff\xe1" -> exifSize rest + _ -> mzero + +jfifSize :: ByteString -> Maybe ImageSize +jfifSize rest = do let [dpiDensity,dpix1,dpix2,dpiy1,dpiy2] = map fromIntegral $ unpack $ B.take 5 $ B.drop 9 $ rest let factor = case dpiDensity of @@ -149,11 +156,11 @@ jpegSize img = do _ -> const 72 let dpix = factor (shift dpix1 8 + dpix2) let dpiy = factor (shift dpiy1 8 + dpiy2) - (w,h) <- findJpegSize rest + (w,h) <- findJfifSize rest return $ ImageSize { pxX = w, pxY = h, dpiX = dpix, dpiY = dpiy } -findJpegSize :: ByteString -> Maybe (Integer,Integer) -findJpegSize bs = do +findJfifSize :: ByteString -> Maybe (Integer,Integer) +findJfifSize bs = do let bs' = B.dropWhile (=='\xff') $ B.dropWhile (/='\xff') bs case B.uncons bs' of Just (c,bs'') | c >= '\xc0' && c <= '\xc3' -> do @@ -165,8 +172,23 @@ findJpegSize bs = do [c1,c2] -> do let len = shift c1 8 + c2 -- skip variables - findJpegSize $ B.drop len bs'' + findJfifSize $ B.drop len bs'' _ -> fail "JPEG parse error" Nothing -> fail "Did not find length record" +exifSize :: ByteString -> Maybe ImageSize +exifSize rest = do + let bs' = B.takeWhile (/='\xff') $ B.drop 8 rest -- exif data + let (_,bs'') = B.breakSubstring "\xa0\x02" bs' -- width + let rawWidth = B.take 2 $ B.drop 10 bs'' + let (_,bs''') = B.breakSubstring "\xa0\x03" bs' -- height + let rawHeight = B.take 2 $ B.drop 10 bs''' + let tonum bs = case map fromIntegral $ unpack bs of + [x,y] -> Just $ shift x 8 + y + _ -> Nothing + case (tonum rawWidth, tonum rawHeight) of + (Just w, Just h) -> + return $ ImageSize { pxX = w, pxY = h, dpiX = 72, dpiY = 72 } + _ -> fail "Could not determine exif image size" + -- some day, figure out how to parse dpi from exif -- cgit v1.2.3 From 5c8c380a7997156964a5402974f6f464233aab9b Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 9 Jan 2014 11:16:17 -0800 Subject: Better exif parsing, including image resolution. This introduces a dependency on binary >= 0.6, but we depend on binary >= 0.5 via zip-archive anyway. Closes #976. --- pandoc.cabal | 3 +- src/Text/Pandoc/ImageSize.hs | 225 ++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 212 insertions(+), 16 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/pandoc.cabal b/pandoc.cabal index a1a4c9b40..94d382c4f 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -232,7 +232,8 @@ Library attoparsec >= 0.10 && < 0.11, yaml >= 0.8.3 && < 0.9, vector >= 0.10 && < 0.11, - hslua >= 0.3 && < 0.4 + hslua >= 0.3 && < 0.4, + binary >= 0.6 && < 0.8 Build-Tools: alex, happy if flag(http-conduit) Build-Depends: http-conduit >= 1.9 && < 2.1, diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index e2a8b8283..467205220 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -32,9 +32,14 @@ module Text.Pandoc.ImageSize ( ImageType(..), imageType, imageSize, sizeInPixels, sizeInPoints ) where import Data.ByteString (ByteString, unpack) import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as BL +import Control.Applicative import Control.Monad import Data.Bits +import Data.Binary +import Data.Binary.Get import Text.Pandoc.Shared (safeRead) +import qualified Data.Map as M -- quick and dirty functions to get image sizes -- algorithms borrowed from wwwis.pl @@ -143,7 +148,7 @@ jpegSize img = do guard $ B.length rest >= 14 case hdr of "\xff\xd8\xff\xe0" -> jfifSize rest - "\xff\xd8\xff\xe1" -> exifSize rest + "\xff\xd8\xff\xe1" -> exifSize $ B.takeWhile (/= '\xff') rest _ -> mzero jfifSize :: ByteString -> Maybe ImageSize @@ -177,18 +182,208 @@ findJfifSize bs = do Nothing -> fail "Did not find length record" exifSize :: ByteString -> Maybe ImageSize -exifSize rest = do - let bs' = B.takeWhile (/='\xff') $ B.drop 8 rest -- exif data - let (_,bs'') = B.breakSubstring "\xa0\x02" bs' -- width - let rawWidth = B.take 2 $ B.drop 10 bs'' - let (_,bs''') = B.breakSubstring "\xa0\x03" bs' -- height - let rawHeight = B.take 2 $ B.drop 10 bs''' - let tonum bs = case map fromIntegral $ unpack bs of - [x,y] -> Just $ shift x 8 + y - _ -> Nothing - case (tonum rawWidth, tonum rawHeight) of - (Just w, Just h) -> - return $ ImageSize { pxX = w, pxY = h, dpiX = 72, dpiY = 72 } - _ -> fail "Could not determine exif image size" - -- some day, figure out how to parse dpi from exif +exifSize = -- runGet ((Just <$> exifHeader) `mplus` return Nothing) . + runGet (Just <$> exifHeader) . + BL.fromChunks . (:[]) +exifHeader :: Get ImageSize +exifHeader = do + _app1DataSize <- getWord16be + exifHdr <- getWord32be + unless (exifHdr == 0x45786966) $ fail "Did not find exif header" + zeros <- getWord16be + unless (zeros == 0) $ fail "Expected zeros after exif header" + -- beginning of tiff header -- we read whole thing to use + -- in getting data from offsets: + tiffHeader <- lookAhead getRemainingLazyByteString + byteAlign <- getWord16be + let bigEndian = byteAlign == 0x4d4d + let (getWord16, getWord32, getWord64) = + if bigEndian + then (getWord16be, getWord32be, getWord64be) + else (getWord16le, getWord32le, getWord64le) + let getRational = do + num <- getWord32 + den <- getWord32 + return $ fromIntegral num / fromIntegral den + tagmark <- getWord16 + unless (tagmark == 0x002a) $ fail "Failed alignment sanity check" + ifdOffset <- getWord32 + skip (fromIntegral ifdOffset - 8) -- skip to IDF + numentries <- getWord16 + let ifdEntry = do + tag <- getWord16 >>= \t -> + maybe (fail $ "Unknown tag type " ++ show t) return + (M.lookup t tagTypeTable) + dataFormat <- getWord16 + numComponents <- getWord32 + (fmt, bytesPerComponent) <- + case dataFormat of + 1 -> return (UnsignedByte . runGet getWord8, 1) + 2 -> return (AsciiString, 1) + 3 -> return (UnsignedShort . runGet getWord16, 2) + 4 -> return (UnsignedLong . runGet getWord32, 4) + 5 -> return (UnsignedRational . runGet getRational, 8) + 6 -> return (SignedByte . runGet getWord8, 1) + 7 -> return (Undefined . runGet getWord8, 1) + 8 -> return (SignedShort . runGet getWord16, 2) + 9 -> return (SignedLong . runGet getWord32, 4) + 10 -> return (SignedRational . runGet getRational, 8) + 11 -> return (SingleFloat . runGet getWord32 {- TODO -}, 4) + 12 -> return (DoubleFloat . runGet getWord64 {- TODO -}, 8) + _ -> fail $ "Unknown data format " ++ show dataFormat + let totalBytes = fromIntegral $ numComponents * bytesPerComponent + payload <- if totalBytes <= 4 -- data is right here + then (fmt . BL.fromChunks . (:[])) <$> + (getByteString totalBytes <* + skip (4 - totalBytes)) + else do -- get data from offset + offs <- getWord32 + return $ fmt $ BL.take (fromIntegral totalBytes) $ + BL.drop (fromIntegral offs) tiffHeader + return (tag, payload) + entries <- sequence $ replicate (fromIntegral numentries) ifdEntry + subentries <- case lookup ExifOffset entries of + Just (UnsignedLong offset) -> do + pos <- bytesRead + skip (fromIntegral offset - (fromIntegral pos - 8)) + numsubentries <- getWord16 + sequence $ + replicate (fromIntegral numsubentries) ifdEntry + _ -> return [] + let allentries = entries ++ subentries + (width, height) <- case (lookup ExifImageWidth allentries, + lookup ExifImageHeight allentries) of + (Just (UnsignedLong w), Just (UnsignedLong h)) -> + return (fromIntegral w, fromIntegral h) + _ -> fail "Could not determine image width, height" + let resfactor = case lookup ResolutionUnit allentries of + Just (UnsignedShort 1) -> (100 / 254) + _ -> 1 + let xres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor) + $ lookup XResolution allentries + let yres = maybe 72 (\(UnsignedRational x) -> floor $ x * resfactor) + $ lookup YResolution allentries + return $ ImageSize{ + pxX = width + , pxY = height + , dpiX = xres + , dpiY = yres } + +data DataFormat = UnsignedByte Word8 + | AsciiString BL.ByteString + | UnsignedShort Word16 + | UnsignedLong Word32 + | UnsignedRational Rational + | SignedByte Word8 + | Undefined Word8 + | SignedShort Word16 + | SignedLong Word32 + | SignedRational Rational + | SingleFloat Word32 + | DoubleFloat Word64 + deriving (Show) + +data TagType = ImageDescription + | Make + | Model + | Orientation + | XResolution + | YResolution + | ResolutionUnit + | Software + | DateTime + | WhitePoint + | PrimaryChromaticities + | YCbCrCoefficients + | YCbCrPositioning + | ReferenceBlackWhite + | Copyright + | ExifOffset + | ExposureTime + | FNumber + | ExposureProgram + | ISOSpeedRatings + | ExifVersion + | DateTimeOriginal + | DateTimeDigitized + | ComponentConfiguration + | CompressedBitsPerPixel + | ShutterSpeedValue + | ApertureValue + | BrightnessValue + | ExposureBiasValue + | MaxApertureValue + | SubjectDistance + | MeteringMode + | LightSource + | Flash + | FocalLength + | MakerNote + | UserComment + | FlashPixVersion + | ColorSpace + | ExifImageWidth + | ExifImageHeight + | RelatedSoundFile + | ExifInteroperabilityOffset + | FocalPlaneXResolution + | FocalPlaneYResolution + | FocalPlaneResolutionUnit + | SensingMethod + | FileSource + | SceneType + deriving (Show, Eq, Ord) + +tagTypeTable :: M.Map Word16 TagType +tagTypeTable = M.fromList + [ (0x010e, ImageDescription) + , (0x010f, Make) + , (0x0110, Model) + , (0x0112, Orientation) + , (0x011a, XResolution) + , (0x011b, YResolution) + , (0x0128, ResolutionUnit) + , (0x0131, Software) + , (0x0132, DateTime) + , (0x013e, WhitePoint) + , (0x013f, PrimaryChromaticities) + , (0x0211, YCbCrCoefficients) + , (0x0213, YCbCrPositioning) + , (0x0214, ReferenceBlackWhite) + , (0x8298, Copyright) + , (0x8769, ExifOffset) + , (0x829a, ExposureTime) + , (0x829d, FNumber) + , (0x8822, ExposureProgram) + , (0x8827, ISOSpeedRatings) + , (0x9000, ExifVersion) + , (0x9003, DateTimeOriginal) + , (0x9004, DateTimeDigitized) + , (0x9101, ComponentConfiguration) + , (0x9102, CompressedBitsPerPixel) + , (0x9201, ShutterSpeedValue) + , (0x9202, ApertureValue) + , (0x9203, BrightnessValue) + , (0x9204, ExposureBiasValue) + , (0x9205, MaxApertureValue) + , (0x9206, SubjectDistance) + , (0x9207, MeteringMode) + , (0x9208, LightSource) + , (0x9209, Flash) + , (0x920a, FocalLength) + , (0x927c, MakerNote) + , (0x9286, UserComment) + , (0xa000, FlashPixVersion) + , (0xa001, ColorSpace) + , (0xa002, ExifImageWidth) + , (0xa003, ExifImageHeight) + , (0xa004, RelatedSoundFile) + , (0xa005, ExifInteroperabilityOffset) + , (0xa20e, FocalPlaneXResolution) + , (0xa20f, FocalPlaneYResolution) + , (0xa210, FocalPlaneResolutionUnit) + , (0xa217, SensingMethod) + , (0xa300, FileSource) + , (0xa301, SceneType) + ] -- cgit v1.2.3 From b4b16d57865b1d951be79f04f8ad41fb70544077 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 9 Jan 2014 22:50:51 -0800 Subject: Minor improvement to exif parser. --- src/Text/Pandoc/ImageSize.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 467205220..d1aacff1c 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -234,8 +234,8 @@ exifHeader = do _ -> fail $ "Unknown data format " ++ show dataFormat let totalBytes = fromIntegral $ numComponents * bytesPerComponent payload <- if totalBytes <= 4 -- data is right here - then (fmt . BL.fromChunks . (:[])) <$> - (getByteString totalBytes <* + then fmt <$> + (getLazyByteString (fromIntegral totalBytes) <* skip (4 - totalBytes)) else do -- get data from offset offs <- getWord32 -- cgit v1.2.3 From a1abb3eeea2321654a8450725ff6c0d1a18ee0c7 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 14 Jan 2014 10:12:33 -0800 Subject: Allow binary 0.5. Version bump to 1.12.3.1. --- changelog | 4 ++++ pandoc.cabal | 4 ++-- src/Text/Pandoc/ImageSize.hs | 9 ++++++--- 3 files changed, 12 insertions(+), 5 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/changelog b/changelog index 4cbc60388..fde6873ec 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +pandoc (1.12.3.1) + + * Relaxed version constraint on binary, allowing the use of binary 0.5. + pandoc (1.12.3) * The `--bibliography` option now sets the `biblio-files` variable. diff --git a/pandoc.cabal b/pandoc.cabal index c8ff9738a..0199996be 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -1,5 +1,5 @@ Name: pandoc -Version: 1.12.3 +Version: 1.12.3.1 Cabal-Version: >= 1.10 Build-Type: Custom License: GPL @@ -233,7 +233,7 @@ Library yaml >= 0.8.3 && < 0.9, vector >= 0.10 && < 0.11, hslua >= 0.3 && < 0.4, - binary >= 0.6 && < 0.8 + binary >= 0.5 && < 0.8 Build-Tools: alex, happy if flag(http-conduit) Build-Depends: http-conduit >= 1.9 && < 2.1, diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index d1aacff1c..14575244d 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -182,9 +182,12 @@ findJfifSize bs = do Nothing -> fail "Did not find length record" exifSize :: ByteString -> Maybe ImageSize -exifSize = -- runGet ((Just <$> exifHeader) `mplus` return Nothing) . - runGet (Just <$> exifHeader) . - BL.fromChunks . (:[]) +exifSize = runGet (Just <$> exifHeader) . BL.fromChunks . (:[]) +-- NOTE: It would be nicer to do +-- runGet ((Just <$> exifHeader) <|> return Nothing) +-- which would prevent pandoc from raising an error when an exif header can't +-- be parsed. But we only get an Alternative instance for Get in binary 0.6, +-- and binary 0.5 ships with ghc 7.6. exifHeader :: Get ImageSize exifHeader = do -- cgit v1.2.3 From a333d9788e0f510f681ae1b5f0f246434ee15d62 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 24 Jan 2014 16:00:02 -0800 Subject: ImageSize: Avoid use of lookAhead, which is not in binary >= 0.6. Closes #1124. --- src/Text/Pandoc/ImageSize.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 14575244d..3c9623b3c 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -182,15 +182,16 @@ findJfifSize bs = do Nothing -> fail "Did not find length record" exifSize :: ByteString -> Maybe ImageSize -exifSize = runGet (Just <$> exifHeader) . BL.fromChunks . (:[]) +exifSize bs = runGet (Just <$> exifHeader bl) bl + where bl = BL.fromChunks [bs] -- NOTE: It would be nicer to do -- runGet ((Just <$> exifHeader) <|> return Nothing) -- which would prevent pandoc from raising an error when an exif header can't -- be parsed. But we only get an Alternative instance for Get in binary 0.6, -- and binary 0.5 ships with ghc 7.6. -exifHeader :: Get ImageSize -exifHeader = do +exifHeader :: BL.ByteString -> Get ImageSize +exifHeader hdr = do _app1DataSize <- getWord16be exifHdr <- getWord32be unless (exifHdr == 0x45786966) $ fail "Did not find exif header" @@ -198,7 +199,7 @@ exifHeader = do unless (zeros == 0) $ fail "Expected zeros after exif header" -- beginning of tiff header -- we read whole thing to use -- in getting data from offsets: - tiffHeader <- lookAhead getRemainingLazyByteString + let tiffHeader = BL.drop 8 hdr byteAlign <- getWord16be let bigEndian = byteAlign == 0x4d4d let (getWord16, getWord32, getWord64) = -- cgit v1.2.3 From 8fdbef841d0ef77dcc2e30cfa475e92a0f3de6cf Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 8 May 2014 21:50:20 +0200 Subject: Update copyright notices for 2014, add missing notices --- COPYRIGHT | 10 +++++----- Setup.hs | 17 +++++++++++++++++ benchmark/benchmark-pandoc.hs | 18 +++++++++++++++++- pandoc.cabal | 2 +- pandoc.hs | 6 +++--- src/Text/Pandoc.hs | 4 ++-- src/Text/Pandoc/Asciify.hs | 4 ++-- src/Text/Pandoc/Highlighting.hs | 4 ++-- src/Text/Pandoc/ImageSize.hs | 4 ++-- src/Text/Pandoc/MIME.hs | 4 ++-- src/Text/Pandoc/Options.hs | 4 ++-- src/Text/Pandoc/PDF.hs | 4 ++-- src/Text/Pandoc/Parsing.hs | 4 ++-- src/Text/Pandoc/Pretty.hs | 4 ++-- src/Text/Pandoc/Process.hs | 4 ++-- src/Text/Pandoc/Readers/HTML.hs | 4 ++-- src/Text/Pandoc/Readers/LaTeX.hs | 4 ++-- src/Text/Pandoc/Readers/Markdown.hs | 4 ++-- src/Text/Pandoc/Readers/MediaWiki.hs | 4 ++-- src/Text/Pandoc/Readers/Native.hs | 4 ++-- src/Text/Pandoc/Readers/RST.hs | 4 ++-- src/Text/Pandoc/Readers/TeXMath.hs | 4 ++-- src/Text/Pandoc/Readers/Textile.hs | 5 +++-- src/Text/Pandoc/SelfContained.hs | 4 ++-- src/Text/Pandoc/Shared.hs | 4 ++-- src/Text/Pandoc/Slides.hs | 4 ++-- src/Text/Pandoc/Templates.hs | 4 ++-- src/Text/Pandoc/UTF8.hs | 4 ++-- src/Text/Pandoc/UUID.hs | 4 ++-- src/Text/Pandoc/Writers/AsciiDoc.hs | 4 ++-- src/Text/Pandoc/Writers/ConTeXt.hs | 4 ++-- src/Text/Pandoc/Writers/Custom.hs | 4 ++-- src/Text/Pandoc/Writers/Docbook.hs | 4 ++-- src/Text/Pandoc/Writers/Docx.hs | 4 ++-- src/Text/Pandoc/Writers/EPUB.hs | 4 ++-- src/Text/Pandoc/Writers/HTML.hs | 4 ++-- src/Text/Pandoc/Writers/LaTeX.hs | 4 ++-- src/Text/Pandoc/Writers/Man.hs | 4 ++-- src/Text/Pandoc/Writers/Markdown.hs | 4 ++-- src/Text/Pandoc/Writers/MediaWiki.hs | 4 ++-- src/Text/Pandoc/Writers/Native.hs | 4 ++-- src/Text/Pandoc/Writers/ODT.hs | 4 ++-- src/Text/Pandoc/Writers/OPML.hs | 4 ++-- src/Text/Pandoc/Writers/OpenDocument.hs | 6 +++--- src/Text/Pandoc/Writers/Org.hs | 5 +++-- src/Text/Pandoc/Writers/RST.hs | 4 ++-- src/Text/Pandoc/Writers/RTF.hs | 4 ++-- src/Text/Pandoc/Writers/Shared.hs | 4 ++-- src/Text/Pandoc/Writers/Texinfo.hs | 4 ++-- src/Text/Pandoc/Writers/Textile.hs | 4 ++-- src/Text/Pandoc/XML.hs | 4 ++-- 51 files changed, 138 insertions(+), 103 deletions(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/COPYRIGHT b/COPYRIGHT index cd5adb1be..065090018 100644 --- a/COPYRIGHT +++ b/COPYRIGHT @@ -1,5 +1,5 @@ Pandoc -Copyright (C) 2006-2013 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This code is released under the [GPL], version 2 or later: @@ -33,25 +33,25 @@ licenses. ---------------------------------------------------------------------- src/Text/Pandoc/Writers/Texinfo.hs -Copyright (C) 2008-2010 John MacFarlane and Peter Wang +Copyright (C) 2008-2014 John MacFarlane and Peter Wang Released under the GNU General Public License version 2 or later. ---------------------------------------------------------------------- src/Text/Pandoc/Writers/OpenDocument.hs -Copyright (C) 2008-2010 Andrea Rossato and John MacFarlane +Copyright (C) 2008-2014 Andrea Rossato and John MacFarlane Released under the GNU General Public License version 2 or later. ---------------------------------------------------------------------- src/Text/Pandoc/Writers/Org.hs -Copyright (C) 2010 Puneeth Chaganti +Copyright (C) 2010-2014 Puneeth Chaganti and JohnMacFarlane Released under the GNU General Public License version 2 or later. ---------------------------------------------------------------------- src/Text/Pandoc/Readers/Textile.hs -Copyright (C) 2010 Paul Rivier +Copyright (C) 2010-2014 Paul Rivier and John MacFarlane Released under the GNU General Public License version 2 or later. diff --git a/Setup.hs b/Setup.hs index 89d03ee7a..f5d18eee4 100644 --- a/Setup.hs +++ b/Setup.hs @@ -1,4 +1,21 @@ {-# LANGUAGE CPP #-} +{- +Copyright (C) 2006-2014 John MacFarlane + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} import Distribution.Simple import Distribution.Simple.PreProcess diff --git a/benchmark/benchmark-pandoc.hs b/benchmark/benchmark-pandoc.hs index 2eaaf91a1..9238b09d7 100644 --- a/benchmark/benchmark-pandoc.hs +++ b/benchmark/benchmark-pandoc.hs @@ -1,3 +1,20 @@ +{- +Copyright (C) 2012-2014 John MacFarlane + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} import Text.Pandoc import Criterion.Main import Criterion.Config @@ -36,4 +53,3 @@ main = do let writers' = [(n,w) | (n, PureStringWriter w) <- writers] defaultMainWith conf (return ()) $ map (writerBench doc) writers' ++ readerBs - diff --git a/pandoc.cabal b/pandoc.cabal index ea0aa71ba..63c748a47 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -4,7 +4,7 @@ Cabal-Version: >= 1.10 Build-Type: Custom License: GPL License-File: COPYING -Copyright: (c) 2006-2013 John MacFarlane +Copyright: (c) 2006-2014 John MacFarlane Author: John MacFarlane Maintainer: John MacFarlane Bug-Reports: https://github.com/jgm/pandoc/issues diff --git a/pandoc.hs b/pandoc.hs index 959605625..5dd0e6899 100644 --- a/pandoc.hs +++ b/pandoc.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {- -Copyright (C) 2006-2013 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Main - Copyright : Copyright (C) 2006-2013 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane @@ -69,7 +69,7 @@ import qualified Data.Yaml as Yaml import qualified Data.Text as T copyrightMessage :: String -copyrightMessage = "\nCopyright (C) 2006-2013 John MacFarlane\n" ++ +copyrightMessage = "\nCopyright (C) 2006-2014 John MacFarlane\n" ++ "Web: http://johnmacfarlane.net/pandoc\n" ++ "This is free software; see the source for copying conditions. There is no\n" ++ "warranty, not even for merchantability or fitness for a particular purpose." diff --git a/src/Text/Pandoc.hs b/src/Text/Pandoc.hs index a37c98814..dd5bc18f6 100644 --- a/src/Text/Pandoc.hs +++ b/src/Text/Pandoc.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Asciify.hs b/src/Text/Pandoc/Asciify.hs index 1c177da90..8a5ccec5c 100644 --- a/src/Text/Pandoc/Asciify.hs +++ b/src/Text/Pandoc/Asciify.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2013 John MacFarlane +Copyright (C) 2013-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.SelfContained - Copyright : Copyright (C) 2013 John MacFarlane + Copyright : Copyright (C) 2013-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index 11d608db6..2e7a9f648 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2008 John MacFarlane +Copyright (C) 2008-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Highlighting - Copyright : Copyright (C) 2008 John MacFarlane + Copyright : Copyright (C) 2008-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 3c9623b3c..a6d076fa9 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} {- - Copyright (C) 2011 John MacFarlane + Copyright (C) 2011-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ {- | Module : Text.Pandoc.ImageSize -Copyright : Copyright (C) 2011 John MacFarlane +Copyright : Copyright (C) 2011-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/MIME.hs b/src/Text/Pandoc/MIME.hs index 977cb576b..6e6284b25 100644 --- a/src/Text/Pandoc/MIME.hs +++ b/src/Text/Pandoc/MIME.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2011 John MacFarlane +Copyright (C) 2011-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.MIME - Copyright : Copyright (C) 2011 John MacFarlane + Copyright : Copyright (C) 2011-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 38220f542..611a6bb06 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2012 John MacFarlane +Copyright (C) 2012-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Options - Copyright : Copyright (C) 2012 John MacFarlane + Copyright : Copyright (C) 2012-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/PDF.hs b/src/Text/Pandoc/PDF.hs index abc5c41b7..e4e06e6c9 100644 --- a/src/Text/Pandoc/PDF.hs +++ b/src/Text/Pandoc/PDF.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings, CPP #-} {- -Copyright (C) 2012 John MacFarlane +Copyright (C) 2012-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.PDF - Copyright : Copyright (C) 2012 John MacFarlane + Copyright : Copyright (C) 2012-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 4d0a677da..d1e55cbc4 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances#-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Parsing - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Pretty.hs b/src/Text/Pandoc/Pretty.hs index 5331587ce..d25ba725f 100644 --- a/src/Text/Pandoc/Pretty.hs +++ b/src/Text/Pandoc/Pretty.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-} {- -Copyright (C) 2010 John MacFarlane +Copyright (C) 2010-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111(-1)307 USA {- | Module : Text.Pandoc.Pretty - Copyright : Copyright (C) 2010 John MacFarlane + Copyright : Copyright (C) 2010-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Process.hs b/src/Text/Pandoc/Process.hs index 112c5b974..9c8853366 100644 --- a/src/Text/Pandoc/Process.hs +++ b/src/Text/Pandoc/Process.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2013 John MacFarlane +Copyright (C) 2013-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Process - Copyright : Copyright (C) 2013 John MacFarlane + Copyright : Copyright (C) 2013-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs index c94ee3d6b..905e55b22 100644 --- a/src/Text/Pandoc/Readers/HTML.hs +++ b/src/Text/Pandoc/Readers/HTML.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.HTML - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 79c66b510..bfafea1f6 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} {- -Copyright (C) 2006-2012 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.LaTeX - Copyright : Copyright (C) 2006-2012 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index aac87f363..d1637b701 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -1,6 +1,6 @@ {-# LANGUAGE RelaxedPolyRec #-} -- needed for inlinesBetween on GHC < 7 {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Markdown - Copyright : Copyright (C) 2006-2013 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs index feaedb7c2..e4fabc898 100644 --- a/src/Text/Pandoc/Readers/MediaWiki.hs +++ b/src/Text/Pandoc/Readers/MediaWiki.hs @@ -1,7 +1,7 @@ {-# LANGUAGE RelaxedPolyRec, FlexibleInstances, TypeSynonymInstances #-} -- RelaxedPolyRec needed for inlinesBetween on GHC < 7 {- - Copyright (C) 2012 John MacFarlane + Copyright (C) 2012-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.MediaWiki - Copyright : Copyright (C) 2012 John MacFarlane + Copyright : Copyright (C) 2012-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/Native.hs b/src/Text/Pandoc/Readers/Native.hs index c5d4cb98a..f4dfa62c1 100644 --- a/src/Text/Pandoc/Readers/Native.hs +++ b/src/Text/Pandoc/Readers/Native.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2011 John MacFarlane +Copyright (C) 2011-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Native - Copyright : Copyright (C) 2011 John MacFarlane + Copyright : Copyright (C) 2011-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 54b6fa34a..fa8438e70 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.RST - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/TeXMath.hs b/src/Text/Pandoc/Readers/TeXMath.hs index 6bd617f7e..f03eae044 100644 --- a/src/Text/Pandoc/Readers/TeXMath.hs +++ b/src/Text/Pandoc/Readers/TeXMath.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2007-2010 John MacFarlane +Copyright (C) 2007-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.TeXMath - Copyright : Copyright (C) 2007-2010 John MacFarlane + Copyright : Copyright (C) 2007-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs index 9ee34caa5..6d839ec1d 100644 --- a/src/Text/Pandoc/Readers/Textile.hs +++ b/src/Text/Pandoc/Readers/Textile.hs @@ -1,5 +1,6 @@ {- -Copyright (C) 2010 Paul Rivier | tr '*#' '.@' +Copyright (C) 2010-2014 Paul Rivier | tr '*#' '.@' + and John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Textile - Copyright : Copyright (C) 2010-2012 Paul Rivier and John MacFarlane + Copyright : Copyright (C) 2010-2014 Paul Rivier and John MacFarlane License : GNU GPL, version 2 or above Maintainer : Paul Rivier diff --git a/src/Text/Pandoc/SelfContained.hs b/src/Text/Pandoc/SelfContained.hs index 7fc9c2966..2a2f56281 100644 --- a/src/Text/Pandoc/SelfContained.hs +++ b/src/Text/Pandoc/SelfContained.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2011 John MacFarlane +Copyright (C) 2011-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.SelfContained - Copyright : Copyright (C) 2011 John MacFarlane + Copyright : Copyright (C) 2011-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 6f0629ea2..31c490af6 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable, CPP, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-} {- -Copyright (C) 2006-2013 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Shared - Copyright : Copyright (C) 2006-2013 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index 50c46d17f..2b863c780 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2012 John MacFarlane +Copyright (C) 2012-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Slides - Copyright : Copyright (C) 2012 John MacFarlane + Copyright : Copyright (C) 2012-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index 52625abf6..551db6483 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP, OverloadedStrings, GeneralizedNewtypeDeriving #-} {- -Copyright (C) 2009-2013 John MacFarlane +Copyright (C) 2009-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Templates - Copyright : Copyright (C) 2009-2013 John MacFarlane + Copyright : Copyright (C) 2009-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/UTF8.hs b/src/Text/Pandoc/UTF8.hs index 229442543..33c9ec1c5 100644 --- a/src/Text/Pandoc/UTF8.hs +++ b/src/Text/Pandoc/UTF8.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {- -Copyright (C) 2010 John MacFarlane +Copyright (C) 2010-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.UTF8 - Copyright : Copyright (C) 2010 John MacFarlane + Copyright : Copyright (C) 2010-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/UUID.hs b/src/Text/Pandoc/UUID.hs index 082644eea..eebfe09d2 100644 --- a/src/Text/Pandoc/UUID.hs +++ b/src/Text/Pandoc/UUID.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2010 John MacFarlane +Copyright (C) 2010-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.UUID - Copyright : Copyright (C) 2010 John MacFarlane + Copyright : Copyright (C) 2010-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs index 15579cba2..19112d8f5 100644 --- a/src/Text/Pandoc/Writers/AsciiDoc.hs +++ b/src/Text/Pandoc/Writers/AsciiDoc.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.AsciiDoc - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index cec420dcf..3b321cc19 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2007-2010 John MacFarlane +Copyright (C) 2007-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.ConTeXt - Copyright : Copyright (C) 2007-2010 John MacFarlane + Copyright : Copyright (C) 2007-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Custom.hs b/src/Text/Pandoc/Writers/Custom.hs index 0b30287f5..88f590c43 100644 --- a/src/Text/Pandoc/Writers/Custom.hs +++ b/src/Text/Pandoc/Writers/Custom.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverlappingInstances, FlexibleInstances, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{- Copyright (C) 2012 John MacFarlane +{- Copyright (C) 2012-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Custom - Copyright : Copyright (C) 2012 John MacFarlane + Copyright : Copyright (C) 2012-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs index 1a8e58354..ba6a92a08 100644 --- a/src/Text/Pandoc/Writers/Docbook.hs +++ b/src/Text/Pandoc/Writers/Docbook.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Docbook - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index fcb73a427..551d97855 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {- -Copyright (C) 2012 John MacFarlane +Copyright (C) 2012-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Docx - Copyright : Copyright (C) 2012 John MacFarlane + Copyright : Copyright (C) 2012-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index c39a7798d..893ec3be9 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -1,6 +1,6 @@ {-# LANGUAGE PatternGuards, CPP, ScopedTypeVariables #-} {- -Copyright (C) 2010 John MacFarlane +Copyright (C) 2010-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.EPUB - Copyright : Copyright (C) 2010 John MacFarlane + Copyright : Copyright (C) 2010-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 1de4345f9..9a26cf2ac 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings, CPP #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.HTML - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index c17e041b5..c221b318e 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.LaTeX - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs index 680bfef44..41eb3e5be 100644 --- a/src/Text/Pandoc/Writers/Man.hs +++ b/src/Text/Pandoc/Writers/Man.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2007-2010 John MacFarlane +Copyright (C) 2007-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Man - Copyright : Copyright (C) 2007-2010 John MacFarlane + Copyright : Copyright (C) 2007-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index 95082add6..f42a1b54c 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings, TupleSections, ScopedTypeVariables #-} {- -Copyright (C) 2006-2013 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Markdown - Copyright : Copyright (C) 2006-2013 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/MediaWiki.hs b/src/Text/Pandoc/Writers/MediaWiki.hs index 83fefaa29..3b987ba2b 100644 --- a/src/Text/Pandoc/Writers/MediaWiki.hs +++ b/src/Text/Pandoc/Writers/MediaWiki.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2008-2010 John MacFarlane +Copyright (C) 2008-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.MediaWiki - Copyright : Copyright (C) 2008-2010 John MacFarlane + Copyright : Copyright (C) 2008-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Native.hs b/src/Text/Pandoc/Writers/Native.hs index 090b97433..cb821e40b 100644 --- a/src/Text/Pandoc/Writers/Native.hs +++ b/src/Text/Pandoc/Writers/Native.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Native - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs index c3652d65d..15f7c8be8 100644 --- a/src/Text/Pandoc/Writers/ODT.hs +++ b/src/Text/Pandoc/Writers/ODT.hs @@ -1,6 +1,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {- -Copyright (C) 2008-2010 John MacFarlane +Copyright (C) 2008-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.ODT - Copyright : Copyright (C) 2008-2010 John MacFarlane + Copyright : Copyright (C) 2008-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/OPML.hs b/src/Text/Pandoc/Writers/OPML.hs index f6926c1dc..dd359f3f5 100644 --- a/src/Text/Pandoc/Writers/OPML.hs +++ b/src/Text/Pandoc/Writers/OPML.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2013 John MacFarlane +Copyright (C) 2013-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.OPML - Copyright : Copyright (C) 2013 John MacFarlane + Copyright : Copyright (C) 2013-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 0029c3296..b6da2694c 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards, OverloadedStrings #-} {- -Copyright (C) 2008-2010 Andrea Rossato -and John MacFarlane. +Copyright (C) 2008-2014 Andrea Rossato + and John MacFarlane. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.OpenDocument - Copyright : Copyright (C) 2008-2010 Andrea Rossato and John MacFarlane + Copyright : Copyright (C) 2008-2014 Andrea Rossato and John MacFarlane License : GNU GPL, version 2 or above Maintainer : Andrea Rossato diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs index 58a5729e7..87046537c 100644 --- a/src/Text/Pandoc/Writers/Org.hs +++ b/src/Text/Pandoc/Writers/Org.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2006-2010 Puneeth Chaganti +Copyright (C) 2010-2014 Puneeth Chaganti + and John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Org - Copyright : Copyright (C) 2010 Puneeth Chaganti + Copyright : Copyright (C) 2010-2014 Puneeth Chaganti and John MacFarlane License : GNU GPL, version 2 or above Maintainer : Puneeth Chaganti diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 1e7596b21..31c97349b 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.RST - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs index 3e0bd9976..e0428aaa8 100644 --- a/src/Text/Pandoc/Writers/RTF.hs +++ b/src/Text/Pandoc/Writers/RTF.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.RTF - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index 604aac1c9..800e741a4 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2013 John MacFarlane +Copyright (C) 2013-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Shared - Copyright : Copyright (C) 2013 John MacFarlane + Copyright : Copyright (C) 2013-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index bf3df8035..8ac717bab 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {- -Copyright (C) 2008-2010 John MacFarlane and Peter Wang +Copyright (C) 2008-2014 John MacFarlane and Peter Wang This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Texinfo - Copyright : Copyright (C) 2008-2010 John MacFarlane and Peter Wang + Copyright : Copyright (C) 2008-2014 John MacFarlane and Peter Wang License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/Writers/Textile.hs b/src/Text/Pandoc/Writers/Textile.hs index 95aedf780..3a6982a01 100644 --- a/src/Text/Pandoc/Writers/Textile.hs +++ b/src/Text/Pandoc/Writers/Textile.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2010 John MacFarlane +Copyright (C) 2010-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Writers.Textile - Copyright : Copyright (C) 2010 John MacFarlane + Copyright : Copyright (C) 2010-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane diff --git a/src/Text/Pandoc/XML.hs b/src/Text/Pandoc/XML.hs index c11af9a19..8000368aa 100644 --- a/src/Text/Pandoc/XML.hs +++ b/src/Text/Pandoc/XML.hs @@ -1,5 +1,5 @@ {- -Copyright (C) 2006-2010 John MacFarlane +Copyright (C) 2006-2014 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.XML - Copyright : Copyright (C) 2006-2010 John MacFarlane + Copyright : Copyright (C) 2006-2014 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane -- cgit v1.2.3 From 5cb53a48d541b97b5f60968715a5969133196d70 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Thu, 19 Jun 2014 14:30:03 -0700 Subject: ImageSize: ignore unknown exif header tag rather than crashing. Some images seem to have tag type of 256, which was causing a runtime error. --- src/Text/Pandoc/ImageSize.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index a6d076fa9..9e6b457c0 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -217,7 +217,7 @@ exifHeader hdr = do numentries <- getWord16 let ifdEntry = do tag <- getWord16 >>= \t -> - maybe (fail $ "Unknown tag type " ++ show t) return + maybe (return UnknownTagType) return (M.lookup t tagTypeTable) dataFormat <- getWord16 numComponents <- getWord32 @@ -337,6 +337,7 @@ data TagType = ImageDescription | SensingMethod | FileSource | SceneType + | UnknownTagType deriving (Show, Eq, Ord) tagTypeTable :: M.Map Word16 TagType -- cgit v1.2.3 From 2eadc7805392c165f7286bd9a337b310b41c897d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 20 Jun 2014 10:58:26 -0700 Subject: ImageSize: Use default instead of failing if image size not found in exif header. Closes #1358. --- src/Text/Pandoc/ImageSize.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/ImageSize.hs') diff --git a/src/Text/Pandoc/ImageSize.hs b/src/Text/Pandoc/ImageSize.hs index 9e6b457c0..68b34dcf3 100644 --- a/src/Text/Pandoc/ImageSize.hs +++ b/src/Text/Pandoc/ImageSize.hs @@ -76,6 +76,9 @@ imageSize img = do Eps -> epsSize img Pdf -> Nothing -- TODO +defaultSize :: (Integer, Integer) +defaultSize = (72, 72) + sizeInPixels :: ImageSize -> (Integer, Integer) sizeInPixels s = (pxX s, pxY s) @@ -260,7 +263,9 @@ exifHeader hdr = do lookup ExifImageHeight allentries) of (Just (UnsignedLong w), Just (UnsignedLong h)) -> return (fromIntegral w, fromIntegral h) - _ -> fail "Could not determine image width, height" + _ -> return defaultSize + -- we return a default width and height when + -- the exif header doesn't contain these let resfactor = case lookup ResolutionUnit allentries of Just (UnsignedShort 1) -> (100 / 254) _ -> 1 -- cgit v1.2.3