diff --git a/epub-metadata.cabal b/epub-metadata.cabal --- a/epub-metadata.cabal +++ b/epub-metadata.cabal @@ -1,5 +1,5 @@ name: epub-metadata -version: 2.3.2 +version: 3.0 cabal-version: >= 1.8 build-type: Simple license: BSD3 @@ -9,41 +9,46 @@ maintainer: Dino Morelli stability: stable homepage: http://ui3.info/d/proj/epub-metadata.html -synopsis: Library for parsing and manipulating ePub files and OPF package data -description: Library for parsing and manipulating ePub files and OPF package data. An attempt has been made here to very thoroughly implement the OPF Package Document specification. +synopsis: Library for parsing and manipulating EPUB files and OPF package data +description: Library for parsing and manipulating EPUB files and OPF package data. An attempt has been made here to thoroughly implement the OPF Package Document specification. category: Codec, Text -tested-with: GHC >= 7.6.1 -extra-source-files: testsuite/*.epub, testsuite/*.hs, testsuite/*.opf +tested-with: GHC >= 7.6.2 +extra-source-files: testsuite/*.epub, + testsuite/*.hs, + testsuite/*.opf, + testsuite/bookfiles/mimetype, + testsuite/bookfiles/foo, + testsuite/bookfiles/content/bar source-repository head type: darcs location: http://ui3.info/darcs/epub-metadata/ library - exposed-modules: Codec.Epub.Archive - Codec.Epub.IO, - Codec.Epub.Opf.Common, - Codec.Epub.Opf.Format.Guide, - Codec.Epub.Opf.Format.Manifest, - Codec.Epub.Opf.Format.Metadata, - Codec.Epub.Opf.Format.Package, - Codec.Epub.Opf.Format.Spine, - Codec.Epub.Opf.Format.Util, - Codec.Epub.Opf.Package, - Codec.Epub.Opf.Package.Guide, - Codec.Epub.Opf.Package.Manifest, - Codec.Epub.Opf.Package.Metadata, - Codec.Epub.Opf.Package.Spine, - Codec.Epub.Opf.Parse + exposed-modules: Codec.Epub2.Archive + Codec.Epub2.IO, + Codec.Epub2.Opf.Common, + Codec.Epub2.Opf.Format.Guide, + Codec.Epub2.Opf.Format.Manifest, + Codec.Epub2.Opf.Format.Metadata, + Codec.Epub2.Opf.Format.Package, + Codec.Epub2.Opf.Format.Spine, + Codec.Epub2.Opf.Format.Util, + Codec.Epub2.Opf.Package, + Codec.Epub2.Opf.Package.Guide, + Codec.Epub2.Opf.Package.Manifest, + Codec.Epub2.Opf.Package.Metadata, + Codec.Epub2.Opf.Package.Spine, + Codec.Epub2.Opf.Parse build-depends: base >= 3 && < 5, bytestring, containers, directory, filepath, hxt >= 9, mtl, regex-compat, zip-archive hs-source-dirs: src ghc-options: -Wall -test-suite opf-parse +test-suite test-epub-metadata type: exitcode-stdio-1.0 - main-is: opf-parse.hs + main-is: test-main.hs build-depends: base >= 3 && < 5, bytestring, directory, filepath, HUnit, hxt >= 9, mtl, regex-compat, zip-archive hs-source-dirs: src testsuite diff --git a/src/Codec/Epub/Archive.hs b/src/Codec/Epub/Archive.hs deleted file mode 100644 --- a/src/Codec/Epub/Archive.hs +++ /dev/null @@ -1,58 +0,0 @@ --- Copyright: 2011-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module Codec.Epub.Archive - ( mkEpubArchive - , readArchive - , writeArchive - ) - where - -import Codec.Archive.Zip -import Control.Monad -import qualified Data.ByteString.Lazy as B -import Data.List -import System.Directory -import System.FilePath - - -{- Recursively get a list of all files starting with the supplied - parent directory. Excluding the directories themselves and ANY - dotfiles. --} -getRecursiveContents :: FilePath -> IO [FilePath] -getRecursiveContents parent = do - fullContents <- getDirectoryContents parent - let contents = filter (not . isPrefixOf ".") fullContents - paths <- forM contents $ \name -> do - let path = parent name - isDirectory <- doesDirectoryExist path - if isDirectory - then getRecursiveContents path - else return [path] - return $ concat paths - - -{- | Construct a zip Archive containing epub book data from the - specified directory --} -mkEpubArchive :: FilePath -> IO Archive -mkEpubArchive rootDir = do - setCurrentDirectory rootDir - - allFiles <- getRecursiveContents "." - - flip (addFilesToArchive []) ["mimetype"] >=> - flip (addFilesToArchive [OptRecursive]) allFiles - $ emptyArchive - - --- | Read a zip Archive from disk -readArchive :: FilePath -> IO Archive -readArchive = fmap toArchive . B.readFile - - --- | Write a zip Archive to disk using the specified filename -writeArchive :: FilePath -> Archive -> IO () -writeArchive zipPath = (B.writeFile zipPath) . fromArchive diff --git a/src/Codec/Epub/IO.hs b/src/Codec/Epub/IO.hs deleted file mode 100644 --- a/src/Codec/Epub/IO.hs +++ /dev/null @@ -1,135 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - -{- | Functions for doing some disk IO with ePub documents --} -module Codec.Epub.IO - ( opfContentsFromZip - , opfContentsFromBS - , opfContentsFromDir - , removeIllegalStartChars - , removeEncoding - , removeDoctype - ) - where - -import Codec.Archive.Zip -import Control.Arrow.ListArrows ( (>>>), deep ) -import Control.Exception -import Control.Monad.Error -import qualified Data.ByteString.Char8 as BS -import Data.ByteString.Lazy ( fromChunks ) -import qualified Data.ByteString.Lazy.Char8 as BL -import System.Directory -import System.FilePath -import Text.Regex -import Text.XML.HXT.Arrow.XmlArrow ( getAttrValue, hasName, isElem ) -import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) -import Text.XML.HXT.Arrow.ReadDocument ( readString ) - - --- | An evil hack to remove *ILLEGAL* characters before the XML --- | declaration. Why do people write software that does this? --- | Can't they follow directions? -removeIllegalStartChars :: String -> String -removeIllegalStartChars = dropWhile (/= '<') - - --- | An evil hack to remove encoding from the document -removeEncoding :: String -> String -removeEncoding = flip (subRegex - (mkRegexWithOpts " +encoding=\"UTF-8\"" False False)) "" - - --- | An evil hack to remove any from the document -removeDoctype :: String -> String -removeDoctype = flip (subRegex - (mkRegexWithOpts "]*>" False True)) "" - - -locateRootFile :: (MonadIO m, MonadError String m) => - FilePath -> String -> m FilePath -locateRootFile containerPath containerDoc = do - result <- liftIO $ runX ( - readString [withValidate no] containerDoc - >>> deep (isElem >>> hasName "rootfile") - >>> getAttrValue "full-path" - ) - - case result of - (p : []) -> return p - _ -> throwError $ - "ERROR: rootfile full-path missing from " ++ containerPath - - --- | Extract a file from a zip archive throwing an error on failure -fileFromArchive :: MonadError String m => - FilePath -> Archive -> m String -fileFromArchive filePath archive = do - let mbEntry = findEntryByPath filePath archive - maybe - (throwError $ "Unable to locate file " ++ filePath) - (return . BL.unpack . fromEntry) mbEntry - - --- | Get the contents of the OPF Package Document from a ByteString -opfContentsFromBS :: (MonadError String m, MonadIO m) - => BS.ByteString -- ^ contents of the zip file - -> m (FilePath, String) -- ^ path and contents of the OPF Package Document -opfContentsFromBS strictBytes = do - -- Need to turn this strict byte string into a lazy one - let lazyBytes = fromChunks [strictBytes] - result <- liftIO $ ( try $ evaluate - (toArchive lazyBytes) :: IO (Either SomeException Archive) ) - archive <- either (throwError . show) return result - - {- We need to first extract the container.xml file - It's required to have a certain path and name in the epub - and contains the path to what we really want, the .opf file. - -} - let containerPath = "META-INF/container.xml" - containerDoc <- fileFromArchive containerPath archive - - rootPath <- locateRootFile containerPath containerDoc - - -- Now that we have the path to the .opf file, extract it - rootContents <- fileFromArchive rootPath archive - - return (rootPath, rootContents) - - --- | Get the contents of the OPF Package Document from an ePub file -opfContentsFromZip :: (MonadError String m, MonadIO m) - => FilePath -- ^ path to ePub zip file - -> m (FilePath, String) -- ^ path and contents of the OPF Package Document -opfContentsFromZip zipPath = do - {- Strictly read this file into a ByteString, send to - opfContentsFromBS - -} - zipFileBytes <- liftIO $ BS.readFile zipPath - opfContentsFromBS zipFileBytes - - --- | Get the contents of the OPF Package Document from an ePub file -opfContentsFromDir :: (MonadError String m, MonadIO m) - => FilePath -- ^ directory path - -> m (FilePath, String) -- ^ path and contents of the OPF Package Document -opfContentsFromDir dir = do - {- We need to first extract the container.xml file - It's required to have a certain path and name in the epub - and contains the path to what we really want, the .opf file. - -} - liftIO $ setCurrentDirectory dir - - let containerPath = "META-INF/container.xml" - containerDoc <- liftIO $ readFile containerPath - - rootPath <- locateRootFile (dir containerPath) containerDoc - - -- Now that we have the path to the .opf file, load it - rootContents <- liftIO $ readFile rootPath - - return (rootPath, rootContents) diff --git a/src/Codec/Epub/Opf/Common.hs b/src/Codec/Epub/Opf/Common.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Common.hs +++ /dev/null @@ -1,17 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of ePub documents - - These data types were constructed by studying the IDPF OPF - specification for ePub documents found here: - - --} -module Codec.Epub.Opf.Common - where - - --- | Attribute value used to relate things to each other in the OPF data -type MFItemId = String diff --git a/src/Codec/Epub/Opf/Format/Guide.hs b/src/Codec/Epub/Opf/Format/Guide.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Format/Guide.hs +++ /dev/null @@ -1,31 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Module for pretty-printing ePub metadata info -module Codec.Epub.Opf.Format.Guide - where - -import Control.Monad.Writer.Lazy -import Text.Printf - -import Codec.Epub.Opf.Format.Util -import Codec.Epub.Opf.Package.Guide - - -tellGuideRef :: MonadWriter (Seq Char) m => GuideRef -> m () -tellGuideRef (GuideRef grty title href) = - tellSeq $ printf " type: %s%s, href: %s\n" - grty (titleToString title) href - - where - titleToString = maybe "" (printf ", title: %s") - - -tellGuide :: MonadWriter (Seq Char) m => [GuideRef] -> m () -tellGuide [] = return () -tellGuide grs = do - tellSeq "guide items:\n" - mapM_ tellGuideRef grs diff --git a/src/Codec/Epub/Opf/Format/Manifest.hs b/src/Codec/Epub/Opf/Format/Manifest.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Format/Manifest.hs +++ /dev/null @@ -1,27 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Module for pretty-printing ePub metadata info -module Codec.Epub.Opf.Format.Manifest - where - -import Control.Monad.Writer.Lazy -import Text.Printf - -import Codec.Epub.Opf.Format.Util -import Codec.Epub.Opf.Package.Manifest - - -tellManifestItem :: MonadWriter (Seq Char) m => ManifestItem -> m () -tellManifestItem (ManifestItem mfId href mediaType) = - tellSeq $ printf " id: %s, href: %s, media-type: %s\n" - mfId href mediaType - - -tellManifest :: MonadWriter (Seq Char) m => [ManifestItem] -> m () -tellManifest mas = do - tellSeq "manifest items:\n" - mapM_ tellManifestItem mas diff --git a/src/Codec/Epub/Opf/Format/Metadata.hs b/src/Codec/Epub/Opf/Format/Metadata.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Format/Metadata.hs +++ /dev/null @@ -1,120 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Module for pretty-printing ePub metadata info -module Codec.Epub.Opf.Format.Metadata - where - -import Control.Monad.Writer.Lazy -import Text.Printf - -import Codec.Epub.Opf.Format.Util -import Codec.Epub.Opf.Package.Metadata - - -tellTitle :: MonadWriter (Seq Char) m => MetaTitle -> m () -tellTitle (MetaTitle Nothing title) = tellSeq $ printf "title: %s\n" title -tellTitle (MetaTitle lang title) = - tellSeq $ printf "title\n%s%s" (formatSubline "lang" lang) - (formatSubline "text" (Just title)) - - -tellCreator :: MonadWriter (Seq Char) m => MetaCreator -> m () -tellCreator (MetaCreator Nothing Nothing creator) = - tellSeq $ printf "creator: %s\n" creator -tellCreator (MetaCreator role fileAs creator) = - tellSeq $ printf "creator\n%s%s%s" - (formatSubline "role" role) - (formatSubline "file-as" fileAs) - (formatSubline "text" (Just creator)) - - -tellContributor :: MonadWriter (Seq Char) m => MetaCreator -> m () -tellContributor (MetaCreator Nothing Nothing contributor) = - tellSeq $ printf "contributor: %s\n" contributor -tellContributor (MetaCreator role fileAs contributor) = - tellSeq $ printf "contributor\n%s%s%s" - (formatSubline "role" role) - (formatSubline "file-as" fileAs) - (formatSubline "text" (Just contributor)) - - -tellDate :: MonadWriter (Seq Char) m => MetaDate -> m () -tellDate (MetaDate Nothing date) = - tellSeq $ printf "date: %s\n" date -tellDate (MetaDate event date) = - tellSeq $ printf "date\n%s%s" - (formatSubline "event" event) - (formatSubline "text" (Just date)) - - -tellType :: MonadWriter (Seq Char) m => Maybe String -> m () -tellType = maybe (return ()) (tellSeq . (printf "type: %s\n")) - - -tellFormat :: MonadWriter (Seq Char) m => Maybe String -> m () -tellFormat = maybe (return ()) (tellSeq . (printf "format: %s\n")) - - -tellId :: MonadWriter (Seq Char) m => MetaId -> m () -tellId (MetaId idVal scheme content) = - tellSeq $ printf "identifier\n%s%s%s" - (formatSubline "id" (Just idVal)) - (formatSubline "scheme" scheme) - (formatSubline "text" (Just content)) - - -tellSource :: MonadWriter (Seq Char) m => Maybe String -> m () -tellSource = maybe (return ()) (tellSeq . (printf "source: %s\n")) - - -tellSubject :: MonadWriter (Seq Char) m => String -> m () -tellSubject = tellSeq . (printf "subject: %s\n") - - -tellDescription :: MonadWriter (Seq Char) m => Maybe String -> m () -tellDescription = maybe (return ()) (tellSeq . (printf "description: %s\n")) - - -tellPublisher :: MonadWriter (Seq Char) m => Maybe String -> m () -tellPublisher = maybe (return ()) (tellSeq . (printf "publisher: %s\n")) - - -tellLang :: MonadWriter (Seq Char) m => String -> m () -tellLang = tellSeq . (printf "language: %s\n") - - -tellRelation :: MonadWriter (Seq Char) m => Maybe String -> m () -tellRelation = maybe (return ()) (tellSeq . (printf "relation: %s\n")) - - -tellCoverage :: MonadWriter (Seq Char) m => Maybe String -> m () -tellCoverage = maybe (return ()) (tellSeq . (printf "coverage: %s\n")) - - -tellRights :: MonadWriter (Seq Char) m => Maybe String -> m () -tellRights = maybe (return ()) (tellSeq . (printf "rights: %s\n")) - - -tellMetadata :: MonadWriter (Seq Char) m => Metadata -> m () -tellMetadata (Metadata titles creators contributors subjects desc - publisher dates mType format ids source langs relation - coverage rights) = do - mapM_ tellTitle titles - mapM_ tellCreator creators - mapM_ tellContributor contributors - mapM_ tellDate dates - tellType mType - tellFormat format - mapM_ tellId ids - tellSource source - mapM_ tellSubject subjects - tellDescription desc - tellPublisher publisher - mapM_ tellLang langs - tellRelation relation - tellCoverage coverage - tellRights rights diff --git a/src/Codec/Epub/Opf/Format/Package.hs b/src/Codec/Epub/Opf/Format/Package.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Format/Package.hs +++ /dev/null @@ -1,40 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Module for pretty-printing OPF package data -module Codec.Epub.Opf.Format.Package - ( formatPackage - ) - where - -import Control.Monad.Writer.Lazy -import Data.Foldable ( toList ) - -import Codec.Epub.Opf.Format.Guide -import Codec.Epub.Opf.Format.Manifest -import Codec.Epub.Opf.Format.Metadata -import Codec.Epub.Opf.Format.Spine -import Codec.Epub.Opf.Format.Util -import Codec.Epub.Opf.Package - - -tellPackage :: MonadWriter (Seq Char) m => (String, String) -> m () -tellPackage (version, uniqueId) = do - tellSeq "package\n" - tellSeq $ formatSubline "version" (Just version) - tellSeq $ formatSubline "unique-identifier" (Just uniqueId) - - -formatPackage :: Bool -> Package -> String -formatPackage showAll (Package v u meta ma sp gu) = - toList . execWriter $ do - tellPackage (v, u) - tellMetadata meta - - when showAll $ do - tellManifest ma - tellSpine sp - tellGuide gu diff --git a/src/Codec/Epub/Opf/Format/Spine.hs b/src/Codec/Epub/Opf/Format/Spine.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Format/Spine.hs +++ /dev/null @@ -1,33 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Module for pretty-printing ePub metadata info -module Codec.Epub.Opf.Format.Spine - where - -import Control.Monad.Writer.Lazy -import Text.Printf - -import Codec.Epub.Opf.Format.Util -import Codec.Epub.Opf.Package.Spine - - -tellSpineItemref :: MonadWriter (Seq Char) m => SpineItemref -> m () -tellSpineItemref (SpineItemref idref linear) = - tellSeq $ printf " idref: %s%s\n" idref (linearToString linear) - - where - boolToYn True = "yes" - boolToYn False = "no" - - linearToString Nothing = "" - linearToString (Just l) = printf ", linear: %s" (boolToYn l) - - -tellSpine :: MonadWriter (Seq Char) m => Spine -> m () -tellSpine (Spine toc itemRefs) = do - tellSeq $ printf "spine toc: %s, itemrefs:\n" toc - mapM_ tellSpineItemref itemRefs diff --git a/src/Codec/Epub/Opf/Format/Util.hs b/src/Codec/Epub/Opf/Format/Util.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Format/Util.hs +++ /dev/null @@ -1,26 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Functions shared by several formatting modules -module Codec.Epub.Opf.Format.Util - ( formatSubline - , tellSeq - , Seq - ) - where - -import Control.Monad.Writer.Lazy -import Data.Sequence ( Seq, fromList ) -import Text.Printf - - -formatSubline :: String -> Maybe String -> String -formatSubline _ Nothing = "" -formatSubline key (Just value) = printf " %s: %s\n" key value - - -tellSeq :: MonadWriter (Seq a) m => [a] -> m () -tellSeq = tell . fromList diff --git a/src/Codec/Epub/Opf/Package.hs b/src/Codec/Epub/Opf/Package.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Package.hs +++ /dev/null @@ -1,43 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of ePub documents - - These data types were constructed by studying the IDPF OPF - specification for ePub documents found here: - - --} -module Codec.Epub.Opf.Package - ( Package (..) - , MetaTitle (..) - , MetaCreator (..) - , MetaDate (..) - , MetaId (..) - , Metadata (..) - , ManifestItem (..) - , SpineItemref (..) - , Spine (..) - , GuideRef (..) - , emptyMetadata - ) - where - -import Codec.Epub.Opf.Package.Guide -import Codec.Epub.Opf.Package.Manifest -import Codec.Epub.Opf.Package.Metadata -import Codec.Epub.Opf.Package.Spine - - -{- | package tag --} -data Package = Package - { opVersion :: String -- ^ version attr - , opUniqueId :: String -- ^ unique-identifier attr - , opMeta :: Metadata -- ^ metadata child element contents - , opManifest :: [ManifestItem] -- ^ manifest child element contents. One required - , opSpine :: Spine -- ^ spine child element contents - , opGuide :: [GuideRef] -- ^ guide child element contents - } - deriving (Eq, Show) diff --git a/src/Codec/Epub/Opf/Package/Guide.hs b/src/Codec/Epub/Opf/Package/Guide.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Package/Guide.hs +++ /dev/null @@ -1,24 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of ePub documents - - These data types were constructed by studying the IDPF OPF - specification for ePub documents found here: - - --} -module Codec.Epub.Opf.Package.Guide - ( GuideRef (..) - ) - where - - --- | package\/guide\/reference tag -data GuideRef = GuideRef - { grType :: String -- ^ type attr. Must follow 13th edition of the Chicago Manual of Style - , grTitle :: Maybe String -- ^ title attr - , grHref :: String -- ^ href attr. Must reference item in manifest - } - deriving (Eq, Show) diff --git a/src/Codec/Epub/Opf/Package/Manifest.hs b/src/Codec/Epub/Opf/Package/Manifest.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Package/Manifest.hs +++ /dev/null @@ -1,31 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of ePub documents - - These data types were constructed by studying the IDPF OPF - specification for ePub documents found here: - - --} -module Codec.Epub.Opf.Package.Manifest - ( ManifestItem (..) - ) - where - -import Codec.Epub.Opf.Common - - --- | manifest attribute values -type MFItemHref = String -type MFItemMediaType = String - - --- | package\/manifest\/item tag -data ManifestItem = ManifestItem - { mfiId :: MFItemId -- ^ id attr - , mfiHref :: MFItemHref -- ^ href attr - , mfiMediaType :: MFItemMediaType -- ^ media-type attr - } - deriving (Eq, Show) diff --git a/src/Codec/Epub/Opf/Package/Metadata.hs b/src/Codec/Epub/Opf/Package/Metadata.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Package/Metadata.hs +++ /dev/null @@ -1,81 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of ePub documents - - These data types were constructed by studying the IDPF OPF - specification for ePub documents found here: - - --} -module Codec.Epub.Opf.Package.Metadata - ( MetaTitle (..) - , MetaCreator (..) - , MetaDate (..) - , MetaId (..) - , Metadata (..) - , emptyMetadata - ) - where - - --- | package\/metadata\/dc:title tag, xml:lang attr, content -data MetaTitle = MetaTitle (Maybe String) String - deriving (Eq, Show) - -{- | package\/metadata\/dc:creator tag, opf:role attr, opf:file-as attr, - content --} -data MetaCreator = MetaCreator (Maybe String) (Maybe String) String - deriving (Eq, Show) - --- | package\/metadata\/dc:date tag, opf:event attr, content -data MetaDate = MetaDate (Maybe String) String - deriving (Eq, Show) - -{- | package\/metadata\/dc:identifier tag, id attr, opf:scheme attr, - content --} -data MetaId = MetaId String (Maybe String) String - deriving (Eq, Show) - --- | package\/metadata tag -data Metadata = Metadata - { metaTitles :: [MetaTitle] -- ^ at least one required - , metaCreators :: [MetaCreator] - , metaContributors :: [MetaCreator] - , metaSubjects :: [String] -- ^ dc:subject tags - , metaDescription :: Maybe String -- ^ dc:description tags - , metaPublisher :: Maybe String -- ^ dc:publisher tag - , metaDates :: [MetaDate] - , metaType :: Maybe String -- ^ dc:type tag - , metaFormat :: Maybe String -- ^ dc:format tag - , metaIds :: [MetaId] -- ^ at least one required - , metaSource :: Maybe String -- ^ dc:source tag - , metaLangs :: [String] -- ^ dc:language tags, at least one required - , metaRelation :: Maybe String -- ^ dc:relation tag - , metaCoverage :: Maybe String -- ^ dc:coverage tag - , metaRights :: Maybe String -- ^ dc:rights tag - } - deriving (Eq, Show) - --- | Note: This isn't valid as-is, some required values are empty lists! -emptyMetadata :: Metadata -emptyMetadata = Metadata - { metaTitles = [] -- one required - , metaCreators = [] - , metaContributors = [] - , metaSubjects = [] - , metaDescription = Nothing - , metaPublisher = Nothing - , metaDates = [] - , metaType = Nothing - , metaFormat = Nothing - , metaIds = [] -- one required - , metaSource = Nothing - , metaLangs = [] -- one required - , metaRelation = Nothing - , metaCoverage = Nothing - , metaRights = Nothing - } diff --git a/src/Codec/Epub/Opf/Package/Spine.hs b/src/Codec/Epub/Opf/Package/Spine.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Package/Spine.hs +++ /dev/null @@ -1,34 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of ePub documents - - These data types were constructed by studying the IDPF OPF - specification for ePub documents found here: - - --} -module Codec.Epub.Opf.Package.Spine - ( Spine (..) - , SpineItemref (..) - ) - where - -import Codec.Epub.Opf.Common - - --- | package\/spine\/itemref tag -data SpineItemref = SpineItemref - { siIdRef :: MFItemId -- ^ idref attr. Must reference item in manifest - , siLinear :: Maybe Bool -- ^ linear attr - } - deriving (Eq, Show) - - --- | package\/spine tag -data Spine = Spine - { spineToc :: MFItemId -- ^ toc attr. Must reference the NCX in the manifest - , spineItemrefs :: [ SpineItemref ] -- one required - } - deriving (Eq, Show) diff --git a/src/Codec/Epub/Opf/Parse.hs b/src/Codec/Epub/Opf/Parse.hs deleted file mode 100644 --- a/src/Codec/Epub/Opf/Parse.hs +++ /dev/null @@ -1,278 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} -{-# LANGUAGE FlexibleContexts #-} - --- | Module for extracting the metadata from an ePub file -module Codec.Epub.Opf.Parse - ( parseXmlToOpf - , parseEpubOpf - ) - where - -import Control.Applicative -import Control.Arrow.ListArrows -import Control.Monad.Error -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.Namespace ( propagateNamespaces ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) -import Text.XML.HXT.Arrow.ReadDocument ( readString ) -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.IO -import Codec.Epub.Opf.Package - - --- HXT helpers - -{- Not used at this time. But may be used someday -atTag :: (ArrowXml a) => String -> a (NTree XNode) XmlTree -atTag tag = deep (isElem >>> hasName tag) --} - -atQTag :: (ArrowXml a) => QName -> a (NTree XNode) XmlTree -atQTag tag = deep (isElem >>> hasQName tag) - -text :: (ArrowXml a) => a (NTree XNode) String -text = getChildren >>> getText - -notNullA :: (ArrowList a) => a [b] [b] -notNullA = isA $ not . null - - -mbQTagText :: (ArrowXml a) => QName -> a (NTree XNode) (Maybe String) -mbQTagText tag = - ( atQTag tag >>> - text >>> notNullA >>> arr Just ) - `orElse` - (constA Nothing) - - -mbGetAttrValue :: (ArrowXml a) => - String -> a XmlTree (Maybe String) -mbGetAttrValue n = - (getAttrValue n >>> notNullA >>> arr Just) - `orElse` (constA Nothing) - -mbGetQAttrValue :: (ArrowXml a) => - QName -> a XmlTree (Maybe String) -mbGetQAttrValue qn = - (getQAttrValue qn >>> notNullA >>> arr Just) - `orElse` (constA Nothing) - - -{- ePub parsing helpers - - Note that these URIs could conceivably change in the future - Is it ok that they're hardcoded like this? - - Well, ok, the xml namespace URI will probably never change. --} - -dcName, opfName, xmlName :: String -> QName -dcName local = mkQName "dc" local "http://purl.org/dc/elements/1.1/" -opfName local = mkQName "opf" local "http://www.idpf.org/2007/opf" -xmlName local = mkQName "xml" local "http://www.w3.org/XML/1998/namespace" - - -getPackage :: (ArrowXml a) => a (NTree XNode) (String, String) -getPackage = atQTag (opfName "package") >>> - proc x -> do - v <- getAttrValue "version" -< x - u <- getAttrValue "unique-identifier" -< x - returnA -< (v, u) - - -getTitle :: (ArrowXml a) => a (NTree XNode) MetaTitle -getTitle = atQTag (dcName "title") >>> - proc x -> do - l <- mbGetQAttrValue (xmlName "lang") -< x - c <- text -< x - returnA -< MetaTitle l c - - -{- Since creators and contributors have the same exact XML structure, - this arrow is used to get either of them --} -getCreator :: (ArrowXml a) => String -> a (NTree XNode) MetaCreator -getCreator tag = atQTag (dcName tag) >>> ( unwrapArrow $ MetaCreator - <$> (WrapArrow $ mbGetQAttrValue (opfName "role")) - <*> (WrapArrow $ mbGetQAttrValue (opfName "file-as")) - <*> (WrapArrow $ text) - ) - - -getSubject :: (ArrowXml a) => a (NTree XNode) String -getSubject = atQTag (dcName "subject") >>> text - - -getDescription :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getDescription = mbQTagText $ dcName "description" - - -getPublisher :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getPublisher = mbQTagText $ dcName "publisher" - - -getDate :: (ArrowXml a) => a (NTree XNode) MetaDate -getDate = atQTag (dcName "date") >>> - proc x -> do - e <- mbGetQAttrValue (opfName "event") -< x - c <- text -< x - returnA -< MetaDate e c - - -getType :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getType = mbQTagText $ dcName "type" - - -getFormat :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getFormat = mbQTagText $ dcName "format" - - -getId :: (ArrowXml a) => a (NTree XNode) MetaId -getId = atQTag (dcName "identifier") >>> - proc x -> do - mbi <- mbGetAttrValue "id" -< x - s <- mbGetQAttrValue (opfName "scheme") -< x - c <- text -< x - let i = maybe "[WARNING: missing required id attribute]" id mbi - returnA -< MetaId i s c - - -getSource :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getSource = mbQTagText $ dcName "source" - - -getLang :: (ArrowXml a) => a (NTree XNode) String -getLang = atQTag (dcName "language") >>> text - - -getRelation :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getRelation = mbQTagText $ dcName "relation" - - -getCoverage :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getCoverage = mbQTagText $ dcName "coverage" - - -getRights :: (ArrowXml a) => a (NTree XNode) (Maybe String) -getRights = mbQTagText $ dcName "rights" - - -getMeta :: (ArrowXml a) => a (NTree XNode) Metadata -getMeta = atQTag (opfName "metadata") >>> ( unwrapArrow $ Metadata - <$> (WrapArrow $ listA getTitle) - <*> (WrapArrow $ listA $ getCreator "creator") - <*> (WrapArrow $ listA $ getCreator "contributor") - <*> (WrapArrow $ listA getSubject) - <*> (WrapArrow $ getDescription) - <*> (WrapArrow $ getPublisher) - <*> (WrapArrow $ listA getDate) - <*> (WrapArrow $ getType) - <*> (WrapArrow $ getFormat) - <*> (WrapArrow $ listA getId) - <*> (WrapArrow $ getSource) - <*> (WrapArrow $ listA getLang) - <*> (WrapArrow $ getRelation) - <*> (WrapArrow $ getCoverage) - <*> (WrapArrow $ getRights) - ) - - -getManifestItem :: (ArrowXml a) => a (NTree XNode) ManifestItem -getManifestItem = atQTag (opfName "item") >>> - proc x -> do - i <- getAttrValue "id" -< x - h <- getAttrValue "href" -< x - m <- getAttrValue "media-type" -< x - returnA -< ManifestItem i h m - - -getManifest :: (ArrowXml a) => a (NTree XNode) [ManifestItem] -getManifest = atQTag (opfName "manifest") >>> - proc x -> do - l <- listA getManifestItem -< x - returnA -< l - - -getSpineItemref :: (ArrowXml a) => a (NTree XNode) SpineItemref -getSpineItemref = atQTag (opfName "itemref") >>> - proc x -> do - i <- getAttrValue "idref" -< x - ml <- mbGetAttrValue "linear" -< x - let l = maybe Nothing (\v -> if v == "no" then Just False else Just True) ml - returnA -< SpineItemref i l - - -getSpine :: (ArrowXml a) => a (NTree XNode) Spine -getSpine = atQTag (opfName "spine") >>> - proc x -> do - i <- getAttrValue "toc" -< x - l <- listA getSpineItemref -< x - returnA -< (Spine i l) - - -getGuideRef :: (ArrowXml a) => a (NTree XNode) GuideRef -getGuideRef = atQTag (opfName "reference") >>> - proc x -> do - t <- getAttrValue "type" -< x - mt <- mbGetAttrValue "title" -< x - h <- getAttrValue "href" -< x - returnA -< GuideRef t mt h - - -getGuide :: (ArrowXml a) => a (NTree XNode) [GuideRef] -getGuide = atQTag (opfName "guide") >>> - proc x -> do - l <- listA getGuideRef -< x - returnA -< l - - -getBookData :: (ArrowXml a) => a (NTree XNode) Package -getBookData = - proc x -> do - (v, u) <- getPackage -< x - m <- getMeta -< x - mf <- getManifest -< x - sp <- getSpine -< x - gl <- listA getGuide -< x - let g = case gl of - [] -> [] - [e] -> e - _ -> error "ERROR: more than one guide entries" - returnA -< (Package v u m mf sp g) - - -{- | Extract the ePub OPF Package data contained in the supplied - XML string --} -parseXmlToOpf :: (MonadIO m, MonadError String m) => - String -> m Package -parseXmlToOpf contents = do - {- Improper encoding and schema declarations have been causing - havok with this parse, cruelly strip them out. -} - let cleanedContents = removeIllegalStartChars . removeEncoding - . removeDoctype $ contents - - result <- liftIO $ runX ( - readString [withValidate no] cleanedContents - >>> propagateNamespaces - >>> getBookData - ) - - case result of - (p : []) -> return p - _ -> throwError - "ERROR: Parse didn't result in a single document metadata" - - --- | Given the path to an ePub file, extract the OPF Package data -parseEpubOpf :: (MonadIO m, MonadError String m) => - FilePath -> m Package -parseEpubOpf zipPath = do - (_, contents) <- opfContentsFromZip zipPath - parseXmlToOpf contents diff --git a/src/Codec/Epub2/Archive.hs b/src/Codec/Epub2/Archive.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Archive.hs @@ -0,0 +1,60 @@ +-- Copyright: 2011-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Codec.Epub2.Archive + ( mkEpubArchive + , readArchive + , writeArchive + ) + where + +import Codec.Archive.Zip +import Control.Monad +import qualified Data.ByteString.Lazy as B +import Data.List +import System.Directory +import System.FilePath + + +{- Recursively get a list of all files starting with the supplied + parent directory. Excluding the directories themselves and ANY + dotfiles. +-} +getRecursiveContents :: FilePath -> IO [FilePath] +getRecursiveContents parent = do + fullContents <- getDirectoryContents parent + let contents = filter (not . isPrefixOf ".") fullContents + paths <- forM contents $ \name -> do + let path = parent name + isDirectory <- doesDirectoryExist path + if isDirectory + then getRecursiveContents path + else return [path] + return $ concat paths + + +{- | Construct a zip Archive containing epub book data from the + specified directory +-} +mkEpubArchive :: FilePath -> IO Archive +mkEpubArchive rootDir = do + setCurrentDirectory rootDir + + let mimetype = ["mimetype"] + allFiles <- getRecursiveContents "." + let restFiles = allFiles \\ mimetype + + flip (addFilesToArchive [OptRecursive]) restFiles >=> + flip (addFilesToArchive []) ["mimetype"] + $ emptyArchive + + +-- | Read a zip Archive from disk +readArchive :: FilePath -> IO Archive +readArchive = fmap toArchive . B.readFile + + +-- | Write a zip Archive to disk using the specified filename +writeArchive :: FilePath -> Archive -> IO () +writeArchive zipPath = (B.writeFile zipPath) . fromArchive diff --git a/src/Codec/Epub2/IO.hs b/src/Codec/Epub2/IO.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/IO.hs @@ -0,0 +1,141 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +-- | Functions for doing some disk IO with ePub documents + +module Codec.Epub2.IO + ( opfContentsFromZip + , opfContentsFromBS + , opfContentsFromDir + , removeIllegalStartChars + , removeEncoding + , removeDoctype + ) + where + +import Codec.Archive.Zip +import Control.Arrow.ListArrows ( (>>>), deep ) +import Control.Exception +import Control.Monad.Error +import qualified Data.ByteString.Char8 as BS +import Data.ByteString.Lazy ( fromChunks ) +import qualified Data.ByteString.Lazy.Char8 as BL +import System.Directory +import System.FilePath +import Text.Regex +import Text.XML.HXT.Arrow.XmlArrow ( getAttrValue, hasName, isElem ) +import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) +import Text.XML.HXT.Arrow.ReadDocument ( readString ) + + +{- | An evil hack to remove *ILLEGAL* characters before the XML + declaration. Why do people write software that does this? + Can't they follow directions? +-} +removeIllegalStartChars :: String -> String +removeIllegalStartChars = dropWhile (/= '<') + + +-- | An evil hack to remove encoding from the document +removeEncoding :: String -> String +removeEncoding = flip (subRegex + (mkRegexWithOpts " +encoding=\"UTF-8\"" False False)) "" + + +-- | An evil hack to remove any from the document +removeDoctype :: String -> String +removeDoctype = flip (subRegex + (mkRegexWithOpts "]*>" False True)) "" + + +locateRootFile :: (MonadIO m, MonadError String m) => + FilePath -> String -> m FilePath +locateRootFile containerPath containerDoc = do + result <- liftIO $ runX ( + readString [withValidate no] containerDoc + >>> deep (isElem >>> hasName "rootfile") + >>> getAttrValue "full-path" + ) + + case result of + (p : []) -> return p + _ -> throwError $ + "ERROR: rootfile full-path missing from " ++ containerPath + + +-- | Extract a file from a zip archive throwing an error on failure +fileFromArchive :: MonadError String m => + FilePath -> Archive -> m String +fileFromArchive filePath archive = do + let mbEntry = findEntryByPath filePath archive + maybe + (throwError $ "Unable to locate file " ++ filePath) + (return . BL.unpack . fromEntry) mbEntry + + +{- | Get the contents of the OPF Package Document from a ByteString + representing an EPUB (zip) file +-} +opfContentsFromBS :: (MonadError String m, MonadIO m) + => BS.ByteString -- ^ contents of the zip file + -> m (FilePath, String) -- ^ path and contents of the OPF Package Document +opfContentsFromBS strictBytes = do + -- Need to turn this strict byte string into a lazy one + let lazyBytes = fromChunks [strictBytes] + result <- liftIO $ ( try $ evaluate + (toArchive lazyBytes) :: IO (Either SomeException Archive) ) + archive <- either (throwError . show) return result + + {- We need to first extract the container.xml file + It's required to have a certain path and name in the epub + and contains the path to what we really want, the .opf file. + -} + let containerPath = "META-INF/container.xml" + containerDoc <- fileFromArchive containerPath archive + + rootPath <- locateRootFile containerPath containerDoc + + -- Now that we have the path to the .opf file, extract it + rootContents <- fileFromArchive rootPath archive + + return (rootPath, rootContents) + + +-- | Get the contents of the OPF Package Document from an EPUB (zip) file +opfContentsFromZip :: (MonadError String m, MonadIO m) + => FilePath -- ^ path to ePub zip file + -> m (FilePath, String) -- ^ path and contents of the OPF Package Document +opfContentsFromZip zipPath = do + {- Strictly read this file into a ByteString, send to + opfContentsFromBS + -} + zipFileBytes <- liftIO $ BS.readFile zipPath + opfContentsFromBS zipFileBytes + + +{- | Get the contents of the OPF Package Document from a directory + containing the files from an EPUB file (as in: it's been + unzipped into a dir) +-} +opfContentsFromDir :: (MonadError String m, MonadIO m) + => FilePath -- ^ directory path + -> m (FilePath, String) -- ^ path and contents of the OPF Package Document +opfContentsFromDir dir = do + {- We need to first extract the container.xml file + It's required to have a certain path and name in the epub + and contains the path to what we really want, the .opf file. + -} + liftIO $ setCurrentDirectory dir + + let containerPath = "META-INF/container.xml" + containerDoc <- liftIO $ readFile containerPath + + rootPath <- locateRootFile (dir containerPath) containerDoc + + -- Now that we have the path to the .opf file, load it + rootContents <- liftIO $ readFile rootPath + + return (rootPath, rootContents) diff --git a/src/Codec/Epub2/Opf/Common.hs b/src/Codec/Epub2/Opf/Common.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Common.hs @@ -0,0 +1,17 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{- | Data types for working with the metadata of ePub documents + + These data types were constructed by studying the IDPF OPF + specification for ePub documents found here: + + +-} +module Codec.Epub2.Opf.Common + where + + +-- | Attribute value used to relate things to each other in the OPF data +type MFItemId = String diff --git a/src/Codec/Epub2/Opf/Format/Guide.hs b/src/Codec/Epub2/Opf/Format/Guide.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Format/Guide.hs @@ -0,0 +1,31 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +-- | Module for pretty-printing ePub metadata info +module Codec.Epub2.Opf.Format.Guide + where + +import Control.Monad.Writer.Lazy +import Text.Printf + +import Codec.Epub2.Opf.Format.Util +import Codec.Epub2.Opf.Package.Guide + + +tellGuideRef :: MonadWriter (Seq Char) m => GuideRef -> m () +tellGuideRef (GuideRef grty title href) = + tellSeq $ printf " type: %s%s, href: %s\n" + grty (titleToString title) href + + where + titleToString = maybe "" (printf ", title: %s") + + +tellGuide :: MonadWriter (Seq Char) m => [GuideRef] -> m () +tellGuide [] = return () +tellGuide grs = do + tellSeq "guide items:\n" + mapM_ tellGuideRef grs diff --git a/src/Codec/Epub2/Opf/Format/Manifest.hs b/src/Codec/Epub2/Opf/Format/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Format/Manifest.hs @@ -0,0 +1,27 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +-- | Module for pretty-printing ePub metadata info +module Codec.Epub2.Opf.Format.Manifest + where + +import Control.Monad.Writer.Lazy +import Text.Printf + +import Codec.Epub2.Opf.Format.Util +import Codec.Epub2.Opf.Package.Manifest + + +tellManifestItem :: MonadWriter (Seq Char) m => ManifestItem -> m () +tellManifestItem (ManifestItem mfId href mediaType) = + tellSeq $ printf " id: %s, href: %s, media-type: %s\n" + mfId href mediaType + + +tellManifest :: MonadWriter (Seq Char) m => [ManifestItem] -> m () +tellManifest mas = do + tellSeq "manifest items:\n" + mapM_ tellManifestItem mas diff --git a/src/Codec/Epub2/Opf/Format/Metadata.hs b/src/Codec/Epub2/Opf/Format/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Format/Metadata.hs @@ -0,0 +1,93 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +-- | Module for pretty-printing ePub metadata info +module Codec.Epub2.Opf.Format.Metadata + where + +import Control.Monad.Writer.Lazy +import Text.Printf + +import Codec.Epub2.Opf.Format.Util +import Codec.Epub2.Opf.Package.Metadata + + +tellTitle :: MonadWriter (Seq Char) m => Title -> m () +tellTitle (Title Nothing title) = tellSeq $ printf "title: %s\n" title +tellTitle (Title lang title) = + tellSeq $ printf "title\n%s%s" (formatSubline "lang" lang) + (formatSubline "text" (Just title)) + + +tellCreator :: MonadWriter (Seq Char) m => Creator -> m () +tellCreator (Creator Nothing Nothing creator) = + tellSeq $ printf "creator: %s\n" creator +tellCreator (Creator role fileAs creator) = + tellSeq $ printf "creator\n%s%s%s" + (formatSubline "role" role) + (formatSubline "file-as" fileAs) + (formatSubline "text" (Just creator)) + + +tellContributor :: MonadWriter (Seq Char) m => Creator -> m () +tellContributor (Creator Nothing Nothing contributor) = + tellSeq $ printf "contributor: %s\n" contributor +tellContributor (Creator role fileAs contributor) = + tellSeq $ printf "contributor\n%s%s%s" + (formatSubline "role" role) + (formatSubline "file-as" fileAs) + (formatSubline "text" (Just contributor)) + + +tellDate :: MonadWriter (Seq Char) m => Date -> m () +tellDate (Date Nothing date) = + tellSeq $ printf "date: %s\n" date +tellDate (Date event date) = + tellSeq $ printf "date\n%s%s" + (formatSubline "event" event) + (formatSubline "text" (Just date)) + + +tellId :: MonadWriter (Seq Char) m => Identifier -> m () +tellId (Identifier idVal scheme content) = + tellSeq $ printf "identifier\n%s%s%s" + (formatSubline "id" (Just idVal)) + (formatSubline "scheme" scheme) + (formatSubline "text" (Just content)) + + +tellDescription :: MonadWriter (Seq Char) m => Description -> m () +tellDescription (Description Nothing text) = + tellSeq $ printf "description: %s\n" text +tellDescription (Description lang text) = + tellSeq $ printf "description\n%s%s" + (formatSubline "lang" lang) + (formatSubline "text" (Just text)) + + +tellSimpleString :: MonadWriter (Seq Char) m => String -> String -> m () +tellSimpleString label = tellSeq . (printf "%s: %s\n" label) + + +tellMetadata :: MonadWriter (Seq Char) m => Metadata -> m () +tellMetadata (Metadata titles creators contributors subjects desc + publisher dates mType format ids source langs relation + coverage rights) = do + mapM_ tellTitle titles + mapM_ tellDescription desc + mapM_ tellDate dates + mapM_ tellCreator creators + mapM_ tellContributor contributors + mapM_ (tellSimpleString "publisher") publisher + mapM_ tellId ids + mapM_ (tellSimpleString "language") langs + mapM_ (tellSimpleString "subject") subjects + mapM_ (tellSimpleString "type") mType + mapM_ (tellSimpleString "format") format + mapM_ (tellSimpleString "source") source + mapM_ (tellSimpleString "relation") relation + mapM_ (tellSimpleString "coverage") coverage + mapM_ (tellSimpleString "rights") rights diff --git a/src/Codec/Epub2/Opf/Format/Package.hs b/src/Codec/Epub2/Opf/Format/Package.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Format/Package.hs @@ -0,0 +1,40 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +-- | Module for pretty-printing OPF package data +module Codec.Epub2.Opf.Format.Package + ( formatPackage + ) + where + +import Control.Monad.Writer.Lazy +import Data.Foldable ( toList ) + +import Codec.Epub2.Opf.Format.Guide +import Codec.Epub2.Opf.Format.Manifest +import Codec.Epub2.Opf.Format.Metadata +import Codec.Epub2.Opf.Format.Spine +import Codec.Epub2.Opf.Format.Util +import Codec.Epub2.Opf.Package + + +tellPackage :: MonadWriter (Seq Char) m => (String, String) -> m () +tellPackage (version, uniqueId) = do + tellSeq "package\n" + tellSeq $ formatSubline "version" (Just version) + tellSeq $ formatSubline "unique-identifier" (Just uniqueId) + + +formatPackage :: Bool -> Package -> String +formatPackage showAll (Package v u meta ma sp gu) = + toList . execWriter $ do + tellPackage (v, u) + tellMetadata meta + + when showAll $ do + tellManifest ma + tellSpine sp + tellGuide gu diff --git a/src/Codec/Epub2/Opf/Format/Spine.hs b/src/Codec/Epub2/Opf/Format/Spine.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Format/Spine.hs @@ -0,0 +1,33 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +-- | Module for pretty-printing ePub metadata info +module Codec.Epub2.Opf.Format.Spine + where + +import Control.Monad.Writer.Lazy +import Text.Printf + +import Codec.Epub2.Opf.Format.Util +import Codec.Epub2.Opf.Package.Spine + + +tellSpineItemref :: MonadWriter (Seq Char) m => SpineItemref -> m () +tellSpineItemref (SpineItemref idref linear) = + tellSeq $ printf " idref: %s%s\n" idref (linearToString linear) + + where + boolToYn True = "yes" + boolToYn False = "no" + + linearToString Nothing = "" + linearToString (Just l) = printf ", linear: %s" (boolToYn l) + + +tellSpine :: MonadWriter (Seq Char) m => Spine -> m () +tellSpine (Spine toc itemRefs) = do + tellSeq $ printf "spine toc: %s, itemrefs:\n" toc + mapM_ tellSpineItemref itemRefs diff --git a/src/Codec/Epub2/Opf/Format/Util.hs b/src/Codec/Epub2/Opf/Format/Util.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Format/Util.hs @@ -0,0 +1,26 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +-- | Functions shared by several formatting modules +module Codec.Epub2.Opf.Format.Util + ( formatSubline + , tellSeq + , Seq + ) + where + +import Control.Monad.Writer.Lazy +import Data.Sequence ( Seq, fromList ) +import Text.Printf + + +formatSubline :: String -> Maybe String -> String +formatSubline _ Nothing = "" +formatSubline key (Just value) = printf " %s: %s\n" key value + + +tellSeq :: MonadWriter (Seq a) m => [a] -> m () +tellSeq = tell . fromList diff --git a/src/Codec/Epub2/Opf/Package.hs b/src/Codec/Epub2/Opf/Package.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Package.hs @@ -0,0 +1,44 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{- | Data types for working with the metadata of ePub documents + + These data types were constructed by studying the IDPF OPF + specification for ePub documents found here: + + +-} +module Codec.Epub2.Opf.Package + ( Package (..) + , Creator (..) + , Date (..) + , Description (..) + , Identifier (..) + , Metadata (..) + , Title (..) + , ManifestItem (..) + , SpineItemref (..) + , Spine (..) + , GuideRef (..) + , emptyMetadata + ) + where + +import Codec.Epub2.Opf.Package.Guide +import Codec.Epub2.Opf.Package.Manifest +import Codec.Epub2.Opf.Package.Metadata +import Codec.Epub2.Opf.Package.Spine + + +{- | package tag +-} +data Package = Package + { opVersion :: String -- ^ version attr + , opUniqueId :: String -- ^ unique-identifier attr + , opMeta :: Metadata -- ^ metadata child element contents + , opManifest :: [ManifestItem] -- ^ manifest child element contents. One required + , opSpine :: Spine -- ^ spine child element contents + , opGuide :: [GuideRef] -- ^ guide child element contents + } + deriving (Eq, Show) diff --git a/src/Codec/Epub2/Opf/Package/Guide.hs b/src/Codec/Epub2/Opf/Package/Guide.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Package/Guide.hs @@ -0,0 +1,24 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{- | Data types for working with the metadata of ePub documents + + These data types were constructed by studying the IDPF OPF + specification for ePub documents found here: + + +-} +module Codec.Epub2.Opf.Package.Guide + ( GuideRef (..) + ) + where + + +-- | package\/guide\/reference tag +data GuideRef = GuideRef + { grType :: String -- ^ type attr. Must follow 13th edition of the Chicago Manual of Style + , grTitle :: Maybe String -- ^ title attr + , grHref :: String -- ^ href attr. Must reference item in manifest + } + deriving (Eq, Show) diff --git a/src/Codec/Epub2/Opf/Package/Manifest.hs b/src/Codec/Epub2/Opf/Package/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Package/Manifest.hs @@ -0,0 +1,31 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{- | Data types for working with the metadata of ePub documents + + These data types were constructed by studying the IDPF OPF + specification for ePub documents found here: + + +-} +module Codec.Epub2.Opf.Package.Manifest + ( ManifestItem (..) + ) + where + +import Codec.Epub2.Opf.Common + + +-- | manifest attribute values +type MFItemHref = String +type MFItemMediaType = String + + +-- | package\/manifest\/item tag +data ManifestItem = ManifestItem + { mfiId :: MFItemId -- ^ id attr + , mfiHref :: MFItemHref -- ^ href attr + , mfiMediaType :: MFItemMediaType -- ^ media-type attr + } + deriving (Eq, Show) diff --git a/src/Codec/Epub2/Opf/Package/Metadata.hs b/src/Codec/Epub2/Opf/Package/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Package/Metadata.hs @@ -0,0 +1,86 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{- | Data types for working with the metadata of ePub documents + + These data types were constructed by studying the IDPF OPF + specification for ePub documents found here: + + +-} +module Codec.Epub2.Opf.Package.Metadata + ( Creator (..) + , Date (..) + , Description (..) + , Identifier (..) + , Metadata (..) + , Title (..) + , emptyMetadata + ) + where + + +{- | package\/metadata\/dc:creator tag, opf:role attr, opf:file-as attr, + content +-} +data Creator = Creator (Maybe String) (Maybe String) String + deriving (Eq, Show) + +-- | package\/metadata\/dc:date tag, opf:event attr, content +data Date = Date (Maybe String) String + deriving (Eq, Show) + +-- | package\/metadata\/dc:description tag, xml:lang attr, content +data Description = Description (Maybe String) String + deriving (Eq, Show) + +{- | package\/metadata\/dc:identifier tag, id attr, opf:scheme attr, + content +-} +data Identifier = Identifier String (Maybe String) String + deriving (Eq, Show) + +-- | package\/metadata\/dc:title tag, xml:lang attr, content +data Title = Title (Maybe String) String + deriving (Eq, Show) + +-- | package\/metadata tag +data Metadata = Metadata + { metaTitles :: [Title] -- ^ at least one required + , metaCreators :: [Creator] + , metaContributors :: [Creator] + , metaSubjects :: [String] -- ^ dc:subject tags + , metaDescriptions :: [Description] + , metaPublishers :: [String] -- ^ dc:publisher tags + , metaDates :: [Date] + , metaTypes :: [String] -- ^ dc:type tags + , metaFormats :: [String] -- ^ dc:format tags + , metaIds :: [Identifier] -- ^ at least one required + , metaSources :: [String] -- ^ dc:source tags + , metaLangs :: [String] -- ^ dc:language tags, at least one required + , metaRelations :: [String] -- ^ dc:relation tags + , metaCoverages :: [String] -- ^ dc:coverage tags + , metaRights :: [String] -- ^ dc:rights tags + } + deriving (Eq, Show) + +-- | Note: This isn't valid as-is, some required values are empty lists! +emptyMetadata :: Metadata +emptyMetadata = Metadata + { metaTitles = [] -- one required + , metaCreators = [] + , metaContributors = [] + , metaSubjects = [] + , metaDescriptions = [] + , metaPublishers = [] + , metaDates = [] + , metaTypes = [] + , metaFormats = [] + , metaIds = [] -- one required + , metaSources = [] + , metaLangs = [] -- one required + , metaRelations = [] + , metaCoverages = [] + , metaRights = [] + } diff --git a/src/Codec/Epub2/Opf/Package/Spine.hs b/src/Codec/Epub2/Opf/Package/Spine.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Package/Spine.hs @@ -0,0 +1,34 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{- | Data types for working with the metadata of ePub documents + + These data types were constructed by studying the IDPF OPF + specification for ePub documents found here: + + +-} +module Codec.Epub2.Opf.Package.Spine + ( Spine (..) + , SpineItemref (..) + ) + where + +import Codec.Epub2.Opf.Common + + +-- | package\/spine\/itemref tag +data SpineItemref = SpineItemref + { siIdRef :: MFItemId -- ^ idref attr. Must reference item in manifest + , siLinear :: Maybe Bool -- ^ linear attr + } + deriving (Eq, Show) + + +-- | package\/spine tag +data Spine = Spine + { spineToc :: MFItemId -- ^ toc attr. Must reference the NCX in the manifest + , spineItemrefs :: [ SpineItemref ] -- one required + } + deriving (Eq, Show) diff --git a/src/Codec/Epub2/Opf/Parse.hs b/src/Codec/Epub2/Opf/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Codec/Epub2/Opf/Parse.hs @@ -0,0 +1,287 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE Arrows #-} +{-# LANGUAGE FlexibleContexts #-} + +-- | Module for extracting the metadata from an ePub file +module Codec.Epub2.Opf.Parse + ( parseXmlToOpf + , parseEpub2Opf + ) + where + +import Control.Applicative +import Control.Arrow.ListArrows +import Control.Monad.Error +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.Namespace ( propagateNamespaces ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) +import Text.XML.HXT.Arrow.ReadDocument ( readString ) +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub2.IO +import Codec.Epub2.Opf.Package + + +-- HXT helpers + +{- Not used at this time. But may be used someday + +atTag :: (ArrowXml a) => String -> a (NTree XNode) XmlTree +atTag tag = deep (isElem >>> hasName tag) +-} + +atQTag :: (ArrowXml a) => QName -> a (NTree XNode) XmlTree +atQTag tag = deep (isElem >>> hasQName tag) + +text :: (ArrowXml a) => a (NTree XNode) String +text = getChildren >>> getText + +notNullA :: (ArrowList a) => a [b] [b] +notNullA = isA $ not . null + + +{- Not used at this time, we don't have any single but optional + tags any longer + +mbQTagText :: (ArrowXml a) => QName -> a (NTree XNode) (Maybe String) +mbQTagText tag = + ( atQTag tag >>> + text >>> notNullA >>> arr Just ) + `orElse` + (constA Nothing) +-} + + +mbGetAttrValue :: (ArrowXml a) => + String -> a XmlTree (Maybe String) +mbGetAttrValue n = + (getAttrValue n >>> notNullA >>> arr Just) + `orElse` (constA Nothing) + +mbGetQAttrValue :: (ArrowXml a) => + QName -> a XmlTree (Maybe String) +mbGetQAttrValue qn = + (getQAttrValue qn >>> notNullA >>> arr Just) + `orElse` (constA Nothing) + + +{- ePub parsing helpers + + Note that these URIs could conceivably change in the future + Is it ok that they're hardcoded like this? + + Well, ok, the xml namespace URI will probably never change. +-} + +dcName, opfName, xmlName :: String -> QName +dcName local = mkQName "dc" local "http://purl.org/dc/elements/1.1/" +opfName local = mkQName "opf" local "http://www.idpf.org/2007/opf" +xmlName local = mkQName "xml" local "http://www.w3.org/XML/1998/namespace" + + +getPackage :: (ArrowXml a) => a (NTree XNode) (String, String) +getPackage = atQTag (opfName "package") >>> + proc x -> do + v <- getAttrValue "version" -< x + u <- getAttrValue "unique-identifier" -< x + returnA -< (v, u) + + +getTitle :: (ArrowXml a) => a (NTree XNode) Title +getTitle = atQTag (dcName "title") >>> + proc x -> do + l <- mbGetQAttrValue (xmlName "lang") -< x + c <- text -< x + returnA -< Title l c + + +{- Since creators and contributors have the same exact XML structure, + this arrow is used to get either of them +-} +getCreator :: (ArrowXml a) => String -> a (NTree XNode) Creator +getCreator tag = atQTag (dcName tag) >>> ( unwrapArrow $ Creator + <$> (WrapArrow $ mbGetQAttrValue (opfName "role")) + <*> (WrapArrow $ mbGetQAttrValue (opfName "file-as")) + <*> (WrapArrow $ text) + ) + + +getSubject :: (ArrowXml a) => a (NTree XNode) String +getSubject = atQTag (dcName "subject") >>> text + + +getDescription :: (ArrowXml a) => a (NTree XNode) Description +getDescription = atQTag (dcName "description") >>> + proc x -> do + l <- mbGetQAttrValue (xmlName "lang") -< x + c <- text -< x + returnA -< Description l c + + +getPublisher :: (ArrowXml a) => a (NTree XNode) String +getPublisher = atQTag (dcName "publisher") >>> text + + +getDate :: (ArrowXml a) => a (NTree XNode) Date +getDate = atQTag (dcName "date") >>> + proc x -> do + e <- mbGetQAttrValue (opfName "event") -< x + c <- text -< x + returnA -< Date e c + + +getType :: (ArrowXml a) => a (NTree XNode) String +getType = atQTag (dcName "type") >>> text + + +getFormat :: (ArrowXml a) => a (NTree XNode) String +getFormat = atQTag (dcName "format") >>> text + + +getId :: (ArrowXml a) => a (NTree XNode) Identifier +getId = atQTag (dcName "identifier") >>> + proc x -> do + mbi <- mbGetAttrValue "id" -< x + s <- mbGetQAttrValue (opfName "scheme") -< x + c <- text -< x + let i = maybe "[WARNING: missing required id attribute]" id mbi + returnA -< Identifier i s c + + +getSource :: (ArrowXml a) => a (NTree XNode) String +getSource = atQTag (dcName "source") >>> text + + +getLang :: (ArrowXml a) => a (NTree XNode) String +getLang = atQTag (dcName "language") >>> text + + +getRelation :: (ArrowXml a) => a (NTree XNode) String +getRelation = atQTag (dcName "relation") >>> text + + +getCoverage :: (ArrowXml a) => a (NTree XNode) String +getCoverage = atQTag (dcName "coverage") >>> text + + +getRights :: (ArrowXml a) => a (NTree XNode) String +getRights = atQTag (dcName "rights") >>> text + + +getMeta :: (ArrowXml a) => a (NTree XNode) Metadata +getMeta = atQTag (opfName "metadata") >>> ( unwrapArrow $ Metadata + <$> (WrapArrow $ listA getTitle) + <*> (WrapArrow $ listA $ getCreator "creator") + <*> (WrapArrow $ listA $ getCreator "contributor") + <*> (WrapArrow $ listA getSubject) + <*> (WrapArrow $ listA getDescription) + <*> (WrapArrow $ listA getPublisher) + <*> (WrapArrow $ listA getDate) + <*> (WrapArrow $ listA getType) + <*> (WrapArrow $ listA getFormat) + <*> (WrapArrow $ listA getId) + <*> (WrapArrow $ listA getSource) + <*> (WrapArrow $ listA getLang) + <*> (WrapArrow $ listA getRelation) + <*> (WrapArrow $ listA getCoverage) + <*> (WrapArrow $ listA getRights) + ) + + +getManifestItem :: (ArrowXml a) => a (NTree XNode) ManifestItem +getManifestItem = atQTag (opfName "item") >>> + proc x -> do + i <- getAttrValue "id" -< x + h <- getAttrValue "href" -< x + m <- getAttrValue "media-type" -< x + returnA -< ManifestItem i h m + + +getManifest :: (ArrowXml a) => a (NTree XNode) [ManifestItem] +getManifest = atQTag (opfName "manifest") >>> + proc x -> do + l <- listA getManifestItem -< x + returnA -< l + + +getSpineItemref :: (ArrowXml a) => a (NTree XNode) SpineItemref +getSpineItemref = atQTag (opfName "itemref") >>> + proc x -> do + i <- getAttrValue "idref" -< x + ml <- mbGetAttrValue "linear" -< x + let l = maybe Nothing (\v -> if v == "no" then Just False else Just True) ml + returnA -< SpineItemref i l + + +getSpine :: (ArrowXml a) => a (NTree XNode) Spine +getSpine = atQTag (opfName "spine") >>> + proc x -> do + i <- getAttrValue "toc" -< x + l <- listA getSpineItemref -< x + returnA -< (Spine i l) + + +getGuideRef :: (ArrowXml a) => a (NTree XNode) GuideRef +getGuideRef = atQTag (opfName "reference") >>> + proc x -> do + t <- getAttrValue "type" -< x + mt <- mbGetAttrValue "title" -< x + h <- getAttrValue "href" -< x + returnA -< GuideRef t mt h + + +getGuide :: (ArrowXml a) => a (NTree XNode) [GuideRef] +getGuide = atQTag (opfName "guide") >>> + proc x -> do + l <- listA getGuideRef -< x + returnA -< l + + +getBookData :: (ArrowXml a) => a (NTree XNode) Package +getBookData = + proc x -> do + (v, u) <- getPackage -< x + m <- getMeta -< x + mf <- getManifest -< x + sp <- getSpine -< x + gl <- listA getGuide -< x + let g = case gl of + [] -> [] + [e] -> e + _ -> error "ERROR: more than one guide entries" + returnA -< (Package v u m mf sp g) + + +{- | Extract the ePub OPF Package data contained in the supplied + XML string +-} +parseXmlToOpf :: (MonadIO m, MonadError String m) => + String -> m Package +parseXmlToOpf contents = do + {- Improper encoding and schema declarations have been causing + havok with this parse, cruelly strip them out. -} + let cleanedContents = removeIllegalStartChars . removeEncoding + . removeDoctype $ contents + + result <- liftIO $ runX ( + readString [withValidate no] cleanedContents + >>> propagateNamespaces + >>> getBookData + ) + + case result of + (p : []) -> return p + _ -> throwError + "ERROR: Parse didn't result in a single document metadata" + + +-- | Given the path to an ePub file, extract the OPF Package data +parseEpub2Opf :: (MonadIO m, MonadError String m) => + FilePath -> m Package +parseEpub2Opf zipPath = do + (_, contents) <- opfContentsFromZip zipPath + parseXmlToOpf contents diff --git a/testsuite/Archive.hs b/testsuite/Archive.hs new file mode 100644 --- /dev/null +++ b/testsuite/Archive.hs @@ -0,0 +1,32 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Archive + ( tests ) + where + +import Codec.Archive.Zip +import System.Directory +import System.FilePath +import Test.HUnit + +import Codec.Epub2.Archive + + +tests :: Test +tests = TestList + [ testMkArchive + ] + + +{- Test that the mimetype file is the first Entry in archives we create +-} +testMkArchive :: Test +testMkArchive = TestCase $ do + origDir <- getCurrentDirectory + a <- mkEpubArchive $ "testsuite" "bookfiles" + setCurrentDirectory origDir + let (firstFile : _) = filesInArchive a + + assertEqual "mimetype file is FIRST" "mimetype" firstFile diff --git a/testsuite/OpfParse.hs b/testsuite/OpfParse.hs new file mode 100644 --- /dev/null +++ b/testsuite/OpfParse.hs @@ -0,0 +1,264 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module OpfParse + ( tests ) + where + +import Control.Monad.Error +import System.FilePath +import Test.HUnit + +import Codec.Epub2.IO +import Codec.Epub2.Opf.Package +import Codec.Epub2.Opf.Parse + + +tests :: Test +tests = TestList + [ testFull + , testMinimal + , testMissingAll + , testDamagedZip + , testIllegalCharsBeforeDecl + ] + + +{- A fairly comprehensive test containing all possible things + Not complete at this time because the library can't parse it all yet! +-} +testFull :: Test +testFull = TestCase $ do + xmlString <- readFile $ "testsuite" "testFull.opf" + actual <- runErrorT $ parseXmlToOpf xmlString + let expected = + Right Package + { opVersion = "2.0" + , opUniqueId = "isbn" + , opMeta = Metadata + { metaTitles = + [ Title Nothing "Title Of This Book" + , Title (Just "fr") "Titre De Ce Livre" + ] + , metaCreators = + [ Creator + (Just "aut") + (Just "Wiggins, Josephine B.") + "Josephine B. Wiggins" + , Creator + (Just "aut") + Nothing + "Horatio Cromwell" + , Creator + Nothing + Nothing + "Natalia Jenkins" + ] + , metaContributors = + [ Creator + (Just "ill") + (Just "Knickerbocker, Reginald Q.") + "Reginald Q. Knickerbocker" + , Creator + (Just "edt") + Nothing "Beverly Abercrombie" + ] + , metaSubjects = ["Fiction","Science Fiction"] + , metaDescriptions = + [ Description Nothing "This document is a stub used for unit testing. It is missing the rest of the tags that normally occur after metadata." + , Description Nothing "An additional description" + ] + , metaPublishers = + [ "Fictional Books Ltd." + , "An additional publisher" + ] + , metaDates = + [ Date (Just "published") "2010" + , Date (Just "created") "2010-05-07" + , Date (Just "modified") "2010-05-08T10:20:57" + , Date Nothing "2009" + ] + , metaTypes = + [ "test OPF Package Document" + , "an additional type" + ] + , metaFormats = + [ "ePub publication" + , "an additional format" + ] + , metaIds = + [ Identifier "isbn" (Just "ISBN") "1-82057-821-9" + , Identifier "other" Nothing "1386506873266" + ] + , metaSources = + [ "document source" + , "an additional source" + ] + , metaLangs = ["en-US", "en-UK"] + , metaRelations = + [ "document relation" + , "an additional relation" + ] + , metaCoverages = + [ "coverage information" + , "an additional coverage" + ] + , metaRights = + [ "Copyright: 2010 Dino Morelli, License: BSD3" + , "an additional rights" + ] + } + , opManifest = + [ ManifestItem + { mfiId = "ncx" + , mfiHref = "toc.ncx" + , mfiMediaType = "application/x-dtbncx+xml" + } + , ManifestItem + { mfiId = "titlePage" + , mfiHref = "content/titlePage.html" + , mfiMediaType = "application/xhtml+xml" + } + , ManifestItem + { mfiId = "someContent" + , mfiHref = "content/someContent.html" + , mfiMediaType = "application/xhtml+xml" + } + ] + , opSpine = Spine + { spineToc = "ncx" + , spineItemrefs = + [ SpineItemref {siIdRef = "titlePage", siLinear = Nothing} + , SpineItemref {siIdRef = "someContent", siLinear = Nothing} + ] + } + , opGuide = + [ GuideRef + { grType = "title-page" + , grTitle = Just "Title page" + , grHref = "content/titlePage.html" + } + , GuideRef + { grType = "text" + , grTitle = Just "Title Of This Book" + , grHref = "content/someContent.html" + } + ] + } + assertEqual "very full" expected actual + + +{- Test the absolute minimum set of fields allowed while remaining + compliant with the spec +-} +testMinimal :: Test +testMinimal = TestCase $ do + xmlString <- liftIO $ readFile $ "testsuite" "testMinimal.opf" + actual <- runErrorT $ parseXmlToOpf xmlString + let expected = + Right Package + { opVersion = "2.0" + , opUniqueId = "isbn" + , opMeta = Metadata + { metaTitles = [Title Nothing "Title Of This Book"] + , metaCreators = [] + , metaContributors = [] + , metaSubjects = [] + , metaDescriptions = [] + , metaPublishers = [] + , metaDates = [] + , metaTypes = [] + , metaFormats = [] + , metaIds = [Identifier "isbn" (Just "ISBN") "1-82057-821-9"] + , metaSources = [] + , metaLangs = ["en-us"] + , metaRelations = [] + , metaCoverages = [] + , metaRights = [] + } + , opManifest = + [ ManifestItem + { mfiId = "ncx" + , mfiHref = "toc.ncx" + , mfiMediaType = "application/x-dtbncx+xml" + } + ] + , opSpine = Spine {spineToc = "ncx", spineItemrefs = []} + , opGuide = [] + } + assertEqual "minimal" expected actual + + +{- Test data missing everything important: package version and + unique-identifier attributes, title, identifier and language tags +-} +testMissingAll :: Test +testMissingAll = TestCase $ do + xmlString <- readFile $ "testsuite" "testMissingAll.opf" + actual <- runErrorT $ parseXmlToOpf xmlString + let expected = + Right Package + { opVersion = "" + , opUniqueId = "" + , opMeta = emptyMetadata + , opManifest = [] + , opSpine = Spine {spineToc = "", spineItemrefs = []} + , opGuide = [] + } + assertEqual "missing all" expected actual + + +{- Occasionally epub zip files come along that are damaged in this + way. It's not fatal to the UNIX zip utility or to book readers, but had + to be specially handled in the Haskell zip-archive library or it causes + a fatal exception. +-} +testDamagedZip :: Test +testDamagedZip = TestLabel "damaged zip" $ TestCase $ do + actual <- runErrorT $ opfContentsFromZip $ "testsuite" + "damagedZipCentralDir.epub" + actual @?= Left "Did not find end of central directory signature. Failed reading at byte position 138" + + +{- Found books coming from Barnes & Noble (for their NOOK reader) to + contain illegal characters before the XML declaration. This is + strictly not allowed by the XML specification. I am very + disappointed with Barnes & Noble for selling garbage like this. +-} +testIllegalCharsBeforeDecl :: Test +testIllegalCharsBeforeDecl = TestCase $ do + xmlString <- readFile $ + "testsuite" "testIllegalCharsBeforeDecl.opf" + actual <- runErrorT $ parseXmlToOpf xmlString + let expected = + Right Package + { opVersion = "2.0" + , opUniqueId = "uuid_id" + , opMeta = Metadata + { metaTitles = [Title Nothing "Foo Bar Baz"] + , metaCreators = [] + , metaContributors = [] + , metaSubjects = [] + , metaDescriptions = [] + , metaPublishers = [] + , metaDates = [] + , metaTypes = [] + , metaFormats = [] + , metaIds = [Identifier "uuid_id" (Just "uuid") "1122334455"] + , metaSources = [] + , metaLangs = ["en"] + , metaRelations = [] + , metaCoverages = [] + , metaRights = []} + , opManifest = + [ ManifestItem + { mfiId = "ncx" + , mfiHref = "toc.ncx" + , mfiMediaType = "application/x-dtbncx+xml" + } + ] + , opSpine = Spine {spineToc = "ncx", spineItemrefs = []} + , opGuide = [] + } + assertEqual "illegal chars before XML declaration" expected actual diff --git a/testsuite/bookfiles/content/bar b/testsuite/bookfiles/content/bar new file mode 100644 --- /dev/null +++ b/testsuite/bookfiles/content/bar diff --git a/testsuite/bookfiles/foo b/testsuite/bookfiles/foo new file mode 100644 --- /dev/null +++ b/testsuite/bookfiles/foo diff --git a/testsuite/bookfiles/mimetype b/testsuite/bookfiles/mimetype new file mode 100644 --- /dev/null +++ b/testsuite/bookfiles/mimetype diff --git a/testsuite/opf-parse.hs b/testsuite/opf-parse.hs deleted file mode 100644 --- a/testsuite/opf-parse.hs +++ /dev/null @@ -1,252 +0,0 @@ --- Copyright: 2010-2013 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -import Control.Monad.Error -import System.Exit -import System.FilePath -import Test.HUnit hiding ( counts ) - -import Codec.Epub.IO -import Codec.Epub.Opf.Package -import Codec.Epub.Opf.Parse - - -main :: IO () -main = do - counts <- runTestTT tests - exit $ testsPassed counts - - -exit :: Bool -> IO () -exit True = exitWith ExitSuccess -exit False = exitWith $ ExitFailure 1 - - -testsPassed :: Counts -> Bool -testsPassed (Counts _ _ e f) = (e == 0) && (f == 0) - - -tests :: Test -tests = TestList - [ testFull - , testMinimal - , testMissingAll - , testDamagedZip - , testIllegalCharsBeforeDecl - ] - - -{- A fairly comprehensive test containing all possible things - Not complete at this time because the library can't parse it all yet! --} -testFull :: Test -testFull = TestCase $ do - xmlString <- readFile $ "testsuite" "testFull.opf" - actual <- runErrorT $ parseXmlToOpf xmlString - let expected = - Right Package - { opVersion = "2.0" - , opUniqueId = "isbn" - , opMeta = Metadata - { metaTitles = - [ MetaTitle Nothing "Title Of This Book" - , MetaTitle (Just "fr") "Titre De Ce Livre" - ] - , metaCreators = - [ MetaCreator - (Just "aut") - (Just "Wiggins, Josephine B.") - "Josephine B. Wiggins" - , MetaCreator - (Just "aut") - Nothing - "Horatio Cromwell" - , MetaCreator - Nothing - Nothing - "Natalia Jenkins" - ] - , metaContributors = - [ MetaCreator - (Just "ill") - (Just "Knickerbocker, Reginald Q.") - "Reginald Q. Knickerbocker" - , MetaCreator - (Just "edt") - Nothing "Beverly Abercrombie" - ] - , metaSubjects = ["Fiction","Science Fiction"] - , metaDescription = Just "This document is a stub used for unit testing. It is missing the rest of the tags that normally occur after metadata." - , metaPublisher = Just "Fictional Books Ltd." - , metaDates = - [ MetaDate (Just "published") "2010" - , MetaDate (Just "created") "2010-05-07" - , MetaDate (Just "modified") "2010-05-08T10:20:57" - , MetaDate Nothing "2009" - ] - , metaType = Just "test OPF Package Document" - , metaFormat = Just "ePub publication" - , metaIds = - [ MetaId "isbn" (Just "ISBN") "1-82057-821-9" - , MetaId "other" Nothing "1386506873266" - ] - , metaSource = Just "document source" - , metaLangs = ["en-us"] - , metaRelation = Just "document relation" - , metaCoverage = Just "coverage information" - , metaRights = Just "Copyright: 2010 Dino Morelli, License: BSD3" - } - , opManifest = - [ ManifestItem - { mfiId = "ncx" - , mfiHref = "toc.ncx" - , mfiMediaType = "application/x-dtbncx+xml" - } - , ManifestItem - { mfiId = "titlePage" - , mfiHref = "content/titlePage.html" - , mfiMediaType = "application/xhtml+xml" - } - , ManifestItem - { mfiId = "someContent" - , mfiHref = "content/someContent.html" - , mfiMediaType = "application/xhtml+xml" - } - ] - , opSpine = Spine - { spineToc = "ncx" - , spineItemrefs = - [ SpineItemref {siIdRef = "titlePage", siLinear = Nothing} - , SpineItemref {siIdRef = "someContent", siLinear = Nothing} - ] - } - , opGuide = - [ GuideRef - { grType = "title-page" - , grTitle = Just "Title page" - , grHref = "content/titlePage.html" - } - , GuideRef - { grType = "text" - , grTitle = Just "Title Of This Book" - , grHref = "content/someContent.html" - } - ] - } - assertEqual "very full" expected actual - - -{- Test the absolute minimum set of fields allowed while remaining - compliant with the spec --} -testMinimal :: Test -testMinimal = TestCase $ do - xmlString <- liftIO $ readFile $ "testsuite" "testMinimal.opf" - actual <- runErrorT $ parseXmlToOpf xmlString - let expected = - Right Package - { opVersion = "2.0" - , opUniqueId = "isbn" - , opMeta = Metadata - { metaTitles = [MetaTitle Nothing "Title Of This Book"] - , metaCreators = [] - , metaContributors = [] - , metaSubjects = [] - , metaDescription = Nothing - , metaPublisher = Nothing - , metaDates = [] - , metaType = Nothing - , metaFormat = Nothing - , metaIds = [MetaId "isbn" (Just "ISBN") "1-82057-821-9"] - , metaSource = Nothing - , metaLangs = ["en-us"] - , metaRelation = Nothing - , metaCoverage = Nothing - , metaRights = Nothing - } - , opManifest = - [ ManifestItem - { mfiId = "ncx" - , mfiHref = "toc.ncx" - , mfiMediaType = "application/x-dtbncx+xml" - } - ] - , opSpine = Spine {spineToc = "ncx", spineItemrefs = []} - , opGuide = [] - } - assertEqual "minimal" expected actual - - -{- Test data missing everything important: package version and - unique-identifier attributes, title, identifier and language tags --} -testMissingAll :: Test -testMissingAll = TestCase $ do - xmlString <- readFile $ "testsuite" "testMissingAll.opf" - actual <- runErrorT $ parseXmlToOpf xmlString - let expected = - Right Package - { opVersion = "" - , opUniqueId = "" - , opMeta = emptyMetadata - , opManifest = [] - , opSpine = Spine {spineToc = "", spineItemrefs = []} - , opGuide = [] - } - assertEqual "missing all" expected actual - - -{- Occasionally epub zip files come along that are damaged in this - way. It's not fatal to the UNIX zip utility or to book readers, but had - to be specially handled in the Haskell zip-archive library or it causes - a fatal exception. --} -testDamagedZip :: Test -testDamagedZip = TestLabel "damaged zip" $ TestCase $ do - actual <- runErrorT $ opfContentsFromZip $ "testsuite" - "damagedZipCentralDir.epub" - actual @?= Left "Did not find end of central directory signature. Failed reading at byte position 138" - - -{- Found books coming from Barnes & Noble (for their NOOK reader) to - contain illegal characters before the XML declaration. This is - strictly not allowed by the XML specification. I am very - disappointed with Barnes & Noble for selling garbage like this. --} -testIllegalCharsBeforeDecl :: Test -testIllegalCharsBeforeDecl = TestCase $ do - xmlString <- readFile $ - "testsuite" "testIllegalCharsBeforeDecl.opf" - actual <- runErrorT $ parseXmlToOpf xmlString - let expected = - Right Package - { opVersion = "2.0" - , opUniqueId = "uuid_id" - , opMeta = Metadata - { metaTitles = [MetaTitle Nothing "Foo Bar Baz"] - , metaCreators = [] - , metaContributors = [] - , metaSubjects = [] - , metaDescription = Nothing - , metaPublisher = Nothing - , metaDates = [] - , metaType = Nothing - , metaFormat = Nothing - , metaIds = [MetaId "uuid_id" (Just "uuid") "1122334455"] - , metaSource = Nothing - , metaLangs = ["en"] - , metaRelation = Nothing - , metaCoverage = Nothing - , metaRights = Nothing} - , opManifest = - [ ManifestItem - { mfiId = "ncx" - , mfiHref = "toc.ncx" - , mfiMediaType = "application/x-dtbncx+xml" - } - ] - , opSpine = Spine {spineToc = "ncx", spineItemrefs = []} - , opGuide = [] - } - assertEqual "illegal chars before XML declaration" expected actual diff --git a/testsuite/test-main.hs b/testsuite/test-main.hs new file mode 100644 --- /dev/null +++ b/testsuite/test-main.hs @@ -0,0 +1,31 @@ +-- Copyright: 2010-2013 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +import System.Exit +import Test.HUnit hiding ( counts ) + +import qualified Archive +import qualified OpfParse + + +main :: IO () +main = do + counts <- runTestTT tests + exit $ testsPassed counts + + +exit :: Bool -> IO () +exit True = exitWith ExitSuccess +exit False = exitWith $ ExitFailure 1 + + +testsPassed :: Counts -> Bool +testsPassed (Counts _ _ e f) = (e == 0) && (f == 0) + + +tests :: Test +tests = TestList + [ Archive.tests + , OpfParse.tests + ] diff --git a/testsuite/testFull.opf b/testsuite/testFull.opf --- a/testsuite/testFull.opf +++ b/testsuite/testFull.opf @@ -15,22 +15,31 @@ Reginald Q. Knickerbocker Beverly Abercrombie This document is a stub used for unit testing. It is missing the rest of the tags that normally occur after metadata. + An additional description 1-82057-821-9 2010 2010-05-07 2010-05-08T10:20:57 2009 - en-us + en-US + en-UK Fictional Books Ltd. + An additional publisher 1386506873266 Fiction Science Fiction test OPF Package Document + an additional type ePub publication + an additional format document source + an additional source document relation + an additional relation coverage information + an additional coverage Copyright: 2010 Dino Morelli, License: BSD3 + an additional rights