diff --git a/.gitignore b/.gitignore new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +# stack build artifacts +.stack-work/ + +# Generated by hasktags +tags diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,31 +1,15 @@ -Copyright Dino Morelli 2010-2016 - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Dino Morelli nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. +Copyright (c) 2010, Dino Morelli -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Permission to use, copy, modify, and/or distribute this software +for any purpose with or without fee is hereby granted, provided +that the above copyright notice and this permission notice appear +in all copies. +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL +DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA +OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER +TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR +PERFORMANCE OF THIS SOFTWARE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ Library for parsing and manipulating epub document metadata. Supports epub versions 2 and 3. -This library was constructed by studying the IDPF specifications for epub documents found [here for version 2.x](http://www.idpf.org/epub/20/spec/OPF_2.0.1_draft.htm) and [here for version 3.x](http://www.idpf.org/epub/30/spec/epub30-publications.html) +This library was constructed by studying the IDPF specifications for epub documents found [here for version 2.0.1](http://www.idpf.org/epub/20/spec/OPF_2.0.1_draft.htm) and [here for version 3.0](http://www.idpf.org/epub/30/spec/epub30-publications.html) ### Why was this done? @@ -19,8 +19,8 @@ of missing or incorrect epub metadata in books I have purchased. I started out using the Calibre open source tools for examining this info. Limitations and incomplete implementation of those tools led -me here to build a more complete implementation in the programming -language that I love beyond all others. +me here to build a more complete library in one of the best +programming languages ever created. ### Why didn't I just use existing solutions? @@ -64,8 +64,7 @@ ### Using this library - Please see the [Haddock documentation](http://hackage.haskell.org/package/epub-metadata-4.0/docs/Codec-Epub.html) or source code for - [Codec.Epub](http://hub.darcs.net/dino/epub-metadata/browse/src/Codec/Epub.hs) + Please see the [Haddock documentation](https://hackage.haskell.org/package/epub-metadata) or source code for [Codec.Epub](https://github.com/dino-/epub-metadata/blob/master/src/lib/Codec/Epub.hs) This file has a working example of using this library. @@ -73,16 +72,20 @@ ## Getting source - Download the cabalized source package [from Hackage](http://hackage.haskell.org/package/epub-metadata) -- Get the source with darcs: `$ darcs get http://hub.darcs.net/dino/epub-metadata` +- Get the source with git: `$ git clone https://github.com/dino-/epub-metadata.git` - Get the source with cabal-install: `$ cabal get epub-metadata` - Get the source with stack: `$ stack unpack epub-metadata` -- If you're just looking, [browse the source](http://hub.darcs.net/dino/epub-metadata) +- If you're just looking, [browse the source](https://github.com/dino-/epub-metadata) And once you have it, building the usual way: $ stack build $ stack test $ stack haddock + +### Generating tags + + $ hasktags --ctags . ## Contact diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,9 +1,2 @@ -#! /usr/bin/env runhaskell - --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - import Distribution.Simple - - main = defaultMain diff --git a/TODO.md b/TODO.md --- a/TODO.md +++ b/TODO.md @@ -1,3 +1,48 @@ +## 2023-06-30 + +### Need to support EPUB 3.x date elements + +This from EPUB 2.x + + 2003 + 2023-01-02 + 2023-06-30 + +becomes in EPUB 3.x + + 2003 + 2023-01-02 + 2023-06-30 + +All of this needs to be documented in the usage as well. + +### Use optparse-applicative for epubmeta, the parsing is primitive and shit + +### Support meta tags with their textual values in either the content attribute or between the begin/end meta tags + +### On the subject of dates in epub + +It's kind of ugly to still be storing the flat string date from the XML but +it's unclear how useful it would be to parse these into something like UTCTime. +And in fact there are at least 6(!) shapes of dates depending on what they're +used for.D + +I think there would have been some contextual information in the type + + data Date = Date + { DateYear = UTCTime -- YYYY + , DateDay = UTCTime -- YYYY-MM-DD + , DateTime = ZonedTime -- YYYY-MM-DDTHH:MM:SSZ + , DateTimeStart = ZonedTime -- YYYY-MM-DDTHH:MM:SSZ/ + , DateTimeEnd = ZonedTime -- /YYYY-MM-DDTHH:MM:SSZ + , DateTimeRange ZonedTime ZonedTime -- YYYY-MM-DDTHH:MM:SSZ/YYYY-MM-DDTHH:MM:SSZ + } + +Use of some of these date shapes hasn't been widely observed in books yet. + + +## older notes + - May need to add a special function that will try to locate modified even in the metaDate field (which is what an epub2 might look like) - Need more API docs. Detail the differences between epub2 and diff --git a/app/epub-metadata-example.hs b/app/epub-metadata-example.hs deleted file mode 100644 --- a/app/epub-metadata-example.hs +++ /dev/null @@ -1,50 +0,0 @@ -{- - This is a small app for maintaining the example code that - goes into the Haddock docs for Codec.Epub --} - -import Codec.Epub -import Codec.Epub.Data.Package -import Control.Monad.Except - - -main :: IO () -main = do - -- epub-metadata actions are in MonadIO and MonadError, so we're - -- using ErrorT here - - result <- runExceptT $ do - - -- Use the getPkgXmlFromZip action to extract the Package - -- Document as an XML string. There are also other actions - -- for reading from ByteStringS and directories. - -- - -- See Codec.Epub.IO - - xmlString <- getPkgXmlFromZip "/path/to/book.epub" - - -- Now the sections of meta-information about the book can - -- be extracted from that XML using functions like getPackage, - -- getMetadata, etc. - -- - -- See Codec.Epub.Parse - - pkg <- getPackage xmlString -- :: Codec.Epub.Data.Package - meta <- getMetadata xmlString -- :: Codec.Epub.Data.Metadata - - -- Parts of these data structures can be used from here - -- as needed - -- - -- See Codec.Epub.Data.Package for pkgVersion below - -- and the others in Codec.Epub.Data.* - - liftIO $ putStrLn $ pkgVersion pkg - - -- There is also pretty-print formatting of these data types - -- in Codec.Epub.Data through the Formattable typeclass - -- - -- See Codec.Epub.Format - - liftIO $ putStr $ format meta - - either putStrLn return result diff --git a/epub-metadata.cabal b/epub-metadata.cabal --- a/epub-metadata.cabal +++ b/epub-metadata.cabal @@ -1,125 +1,135 @@ -name: epub-metadata -version: 4.5 -cabal-version: >= 1.10 -build-type: Simple -license: BSD3 -license-file: LICENSE -copyright: 2010-2016 Dino Morelli -author: Dino Morelli -maintainer: Dino Morelli -homepage: http://hub.darcs.net/dino/epub-metadata -synopsis: Library for parsing epub document metadata -description: Library for parsing and manipulating epub document metadata. Supports epub versions 2 and 3. +cabal-version: 2.2 - This library was constructed by studying the IDPF specifications for epub documents found here and here -category: Codec, Text -tested-with: GHC >= 8.0.1 -extra-source-files: changelog.md - doc/dev/notes - doc/hcar/epubmetadata-De.tex - README.md - stack.yaml - testsuite/*.epub - testsuite/*.hs - testsuite/*.opf - testsuite/bookfiles/foo - testsuite/bookfiles/mimetype - testsuite/bookfiles/content/bar - testsuite/Epub2/*.hs - testsuite/Epub3/*.hs - TODO.md - util/gentags.sh - util/prefs/boring - util/show-opf.hs +name: epub-metadata +version: 5.0 +synopsis: Library for parsing epub document metadata +description: Library for parsing and manipulating epub document metadata. Supports epub versions 2 and 3. This library was constructed by studying the IDPF specifications for epub documents found here and here +category: Codec, Text +homepage: https://github.com/dino-/epub-metadata#readme +bug-reports: https://github.com/dino-/epub-metadata/issues +author: Dino Morelli +maintainer: Dino Morelli +copyright: 2010 Dino Morelli +license: ISC +license-file: LICENSE +build-type: Simple +extra-source-files: + changelog.md + doc/dev/notes + doc/hcar/epubmetadata-De.tex + .gitignore + README.md + stack.yaml + stack.yaml.lock + TODO.md + util/resources/bookfiles/content/bar + util/resources/bookfiles/foo + util/resources/bookfiles/mimetype + util/resources/damagedZipCentralDir.epub + util/resources/epub2-full.opf + util/resources/epub2-minimal.opf + util/resources/epub2-missingAll.opf + util/resources/epub3-full.opf + util/resources/testIllegalCharsBeforeDecl.opf + util/show-opf.hs -source-repository head - type: darcs - location: http://hub.darcs.net/dino/epub-metadata +source-repository head + type: git + location: https://github.com/dino-/epub-metadata +common lang + default-language: Haskell2010 + default-extensions: + TupleSections + build-depends: + mtl + ghc-options: + -fwarn-tabs + -Wall + -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints + library - exposed-modules: Codec.Epub - Codec.Epub.Data.Common - Codec.Epub.Data.Guide - Codec.Epub.Data.Manifest - Codec.Epub.Data.Metadata - Codec.Epub.Data.Package - Codec.Epub.Data.Spine - Codec.Epub.Format - Codec.Epub.Format.Guide - Codec.Epub.Format.Manifest - Codec.Epub.Format.Metadata - Codec.Epub.Format.Package - Codec.Epub.Format.Spine - Codec.Epub.Format.Util - Codec.Epub.IO - Codec.Epub.Parse - Codec.Epub.Parse.Guide - Codec.Epub.Parse.Manifest - Codec.Epub.Parse.Metadata - Codec.Epub.Parse.Package - Codec.Epub.Parse.Refinements - Codec.Epub.Parse.Spine - Codec.Epub.Parse.Util - Codec.Epub.Util - build-depends: base >= 3 && < 5, - bytestring, - utf8-string, - containers, - directory, - filepath, - hxt >= 9, - mtl, - regex-compat-tdfa, - zip-archive - hs-source-dirs: src - ghc-options: -Wall - default-language: Haskell2010 + import: lang + exposed-modules: + Codec.Epub + Codec.Epub.Data.Common + Codec.Epub.Data.Guide + Codec.Epub.Data.Manifest + Codec.Epub.Data.Metadata + Codec.Epub.Data.Package + Codec.Epub.Data.Spine + Codec.Epub.Format + Codec.Epub.Format.Guide + Codec.Epub.Format.Manifest + Codec.Epub.Format.Metadata + Codec.Epub.Format.Package + Codec.Epub.Format.Spine + Codec.Epub.Format.Util + Codec.Epub.IO + Codec.Epub.Parse + Codec.Epub.Parse.Guide + Codec.Epub.Parse.Manifest + Codec.Epub.Parse.Metadata + Codec.Epub.Parse.Package + Codec.Epub.Parse.Refinements + Codec.Epub.Parse.Spine + Codec.Epub.Parse.Util + Codec.Epub.Util + other-modules: + Paths_epub_metadata + autogen-modules: + Paths_epub_metadata + hs-source-dirs: + src/lib + build-depends: + base >=4.8 && <5.0 + , bytestring + , containers + , directory + , filepath + , hxt >=9 + , regex-compat + , utf8-string + , zip-archive -test-suite test-epub-metadata - type: exitcode-stdio-1.0 - main-is: test-main.hs - build-depends: base >= 3 && < 5, - bytestring, - utf8-string, - directory, - filepath, - HUnit, - hxt >= 9, - mtl, - regex-compat-tdfa, - zip-archive - hs-source-dirs: src testsuite - other-modules: Archive - Codec.Epub.Data.Common - Codec.Epub.Data.Guide - Codec.Epub.Data.Manifest - Codec.Epub.Data.Metadata - Codec.Epub.Data.Package - Codec.Epub.Data.Spine - Codec.Epub.IO - Codec.Epub.Parse - Codec.Epub.Parse.Guide - Codec.Epub.Parse.Manifest - Codec.Epub.Parse.Metadata - Codec.Epub.Parse.Package - Codec.Epub.Parse.Refinements - Codec.Epub.Parse.Spine - Codec.Epub.Parse.Util - Codec.Epub.Util - Epub2.ParseGuide - Epub2.ParseMetadata - Epub3.ParseMetadata - ParseManifest - ParsePackage - ParseSpine - ghc-options: -Wall - default-language: Haskell2010 +executable epub-metadata-example + import: lang + main-is: epub-metadata-example.hs + other-modules: + Paths_epub_metadata + autogen-modules: + Paths_epub_metadata + hs-source-dirs: + src/app + build-depends: + base >=4.8 && <5.0 + , epub-metadata -executable epub-metadata-example - main-is: epub-metadata-example.hs - build-depends: base >= 3 && < 5, - epub-metadata, - mtl - hs-source-dirs: app - ghc-options: -Wall - default-language: Haskell2010 +test-suite test-epub-metadata + import: lang + type: exitcode-stdio-1.0 + main-is: test-main.hs + other-modules: + Archive + Epub2.ParseGuide + Epub2.ParseMetadata + Epub3.ParseMetadata + ParseManifest + ParsePackage + ParseSpine + Paths_epub_metadata + autogen-modules: + Paths_epub_metadata + hs-source-dirs: + src/tests + build-depends: + base >=4.8 && <5.0 + , containers + , directory + , epub-metadata + , filepath + , HUnit + , zip-archive diff --git a/src/Codec/Epub.hs b/src/Codec/Epub.hs deleted file mode 100644 --- a/src/Codec/Epub.hs +++ /dev/null @@ -1,73 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | - This is a library for parsing and manipulating epub document metadata. Almost all of the data stored in the epub Package Document can be worked with using this API. This includes the most useful block of data, the epub metadata. This library supports epub versions 2 and 3. - - This library was constructed by studying the IDPF specifications for epub documents found here and here - - Consumers of epub-metadata will likely need this module, which re-exports the most useful parts concerning disk IO, parsing of the XML into Codec.Epub.Data.* data structures and formatting these data structures to be pretty-printed. Please also see Codec.Epub.Data.Metadata etc. --} -module Codec.Epub ( - -- * Epub - module Codec.Epub.Format, - module Codec.Epub.IO, - module Codec.Epub.Parse - - -- * Example - -- $example1 - ) - where - -import Codec.Epub.Format -import Codec.Epub.IO -import Codec.Epub.Parse - - -{- $example1 -> import Codec.Epub -> import Codec.Epub.Data.Package -> import Control.Monad.Error -> -> -> main :: IO () -> main = do -> -- epub-metadata actions are in MonadIO and MonadError, so we're -> -- using ErrorT here -> -> result <- runErrorT $ do -> -> -- Use the getPkgXmlFromZip action to extract the Package -> -- Document as an XML string. There are also other actions -> -- for reading from ByteStringS and directories. -> -- -> -- See Codec.Epub.IO -> -> xmlString <- getPkgXmlFromZip "/path/to/book.epub" -> -> -- Now the sections of meta-information about the book can -> -- be extracted from that XML using functions like getPackage, -> -- getMetadata, etc. -> -- -> -- See Codec.Epub.Parse -> -> pkg <- getPackage xmlString -- :: Codec.Epub.Data.Package -> meta <- getMetadata xmlString -- :: Codec.Epub.Data.Metadata -> -> -- Parts of these data structures can be used from here -> -- as needed -> -- -> -- See Codec.Epub.Data.Package for pkgVersion below -> -- and the others in Codec.Epub.Data.* -> -> liftIO $ putStrLn $ pkgVersion pkg -> -> -- There is also pretty-print formatting of these data types -> -- in Codec.Epub.Data through the Formattable typeclass -> -- -> -- See Codec.Epub.Format -> -> liftIO $ putStr $ format meta -> -> either putStrLn return result --} diff --git a/src/Codec/Epub/Data/Common.hs b/src/Codec/Epub/Data/Common.hs deleted file mode 100644 --- a/src/Codec/Epub/Data/Common.hs +++ /dev/null @@ -1,13 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of epub documents - - This module helps to avoid circular imports for definitions needed by two or more other modules in this library. --} -module Codec.Epub.Data.Common - where - - --- | Attribute value used to relate things to each other in the OPF data -type MFItemId = String diff --git a/src/Codec/Epub/Data/Guide.hs b/src/Codec/Epub/Data/Guide.hs deleted file mode 100644 --- a/src/Codec/Epub/Data/Guide.hs +++ /dev/null @@ -1,22 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of epub documents - - This contains the guide section in an epub2 OPF document. It has been deprecated in the epub3 spec and should not be present in epub3 documents. --} -module Codec.Epub.Data.Guide - ( GuideRef (..) - ) - where - -import Codec.Epub.Data.Common - - --- | package\/guide\/reference tag -data GuideRef = GuideRef - { grType :: String -- ^ type attribute. Must follow 13th edition of the Chicago Manual of Style - , grTitle :: Maybe String -- ^ title attribute - , grHref :: MFItemId -- ^ href attribute. Must reference an item in the manifest - } - deriving (Eq, Show) diff --git a/src/Codec/Epub/Data/Manifest.hs b/src/Codec/Epub/Data/Manifest.hs deleted file mode 100644 --- a/src/Codec/Epub/Data/Manifest.hs +++ /dev/null @@ -1,32 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of epub documents - - This contains the manifest information from an epub document. --} -module Codec.Epub.Data.Manifest - ( Manifest (..) - , ManifestItem (..) - ) - where - -import Codec.Epub.Data.Common - - --- | manifest attribute values -type MFItemHref = String -type MFItemMediaType = String - - --- | package\/manifest\/item tag -data ManifestItem = ManifestItem - { mfiId :: MFItemId -- ^ id attribute - , mfiHref :: MFItemHref -- ^ href attribute - , mfiMediaType :: MFItemMediaType -- ^ media-type attribute - } - deriving (Eq, Show) - - -newtype Manifest = Manifest [ManifestItem] - deriving (Eq, Show) diff --git a/src/Codec/Epub/Data/Metadata.hs b/src/Codec/Epub/Data/Metadata.hs deleted file mode 100644 --- a/src/Codec/Epub/Data/Metadata.hs +++ /dev/null @@ -1,211 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of epub documents - - This module defines the Metadata structure which contains most of the taxonomic information about the literary work. Metadata is probably the most important data structure in this library. - - Both commonly-used versions of epub (2.x and 3.x) are supported by these types. --} -module Codec.Epub.Data.Metadata - ( Metadata (..) - , Identifier (..) - , Title (..) - , Creator (..) - , Date (..) - , Description (..) - , Refinement (..) - , emptyMetadata - , refineIdentifier - , refineTitle - , getModified - , refineCreator - ) - where - -import Control.Monad ( mplus ) -import Data.List ( find ) - - -{- | Refinements represent meta tags within the metadata section - that refine other tags. These are used during the parsing phase - and are discarded as their information is slotted into the data - they refine (CreatorS, TitleS, IdentifierS, etc..) - - This is specific to epub3 --} -data Refinement = Refinement - { refId :: String -- ^ id attribute - , refProp :: String -- ^ property attribute - , refScheme :: String -- ^ scheme attribute - , refText :: String -- ^ meta tag text - } - - -{- Used for locating specific meta information in a list of - Refinements. The data from these meta tags is related to other - tags by an XML id attribute. --} -findByIdProp :: String -> String -> [Refinement] -> Maybe Refinement -findByIdProp i prop = find (\r -> refId r == i && refProp r == prop) - - --- | package\/metadata\/dc:identifier tag -data Identifier = Identifier - { idId :: Maybe String -- ^ id attribute - , idType :: Maybe String -- ^ identifier-type property from meta tag - , idScheme :: Maybe String -- ^ scheme from attribute or meta tag - , idText :: String -- ^ identifier tag text - } - deriving (Eq, Show) - - -{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta - tag info into the data gathered from an identifier tag --} -refineIdentifier :: [Refinement] -> Identifier -> Identifier -refineIdentifier refinements ident = assignScheme . assignType $ ident - where - meta = findByIdProp (maybe "" id $ idId ident) - "identifier-type" refinements - - assignType ident' = ident' { idType = refText `fmap` meta } - - assignScheme ident' = - let existingScheme = idScheme ident' - in ident' { idScheme = existingScheme `mplus` - (refScheme `fmap` meta) } - - --- | package\/metadata\/dc:title tag -data Title = Title - { titleLang :: Maybe String -- ^ lang attribute - , titleType :: Maybe String -- ^ title-type property from meta tag - , titleSeq :: Maybe Int -- ^ display-sequence property from meta - , titleText :: String -- ^ title tag text - } - deriving (Eq, Show) - - -{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta - tag info into the data gathered from a title tag --} -refineTitle :: [Refinement] -> (String, Title) -> Title -refineTitle refinements (elid, title) = assignSeq . assignType $ title - where - assignType title' = - let newTy = refText `fmap` - findByIdProp elid "title-type" refinements - in title' { titleType = newTy } - - assignSeq title' = - let sq = maybe Nothing (Just . read . refText) $ - findByIdProp elid "display-seq" refinements - in title' { titleSeq = sq } - - -{- | package\/metadata\/dc:creator or package\/metadata\/dc:contributor - tags - - This structure is used for both contributor and creator as they are exactly the same. --} -data Creator = Creator - { creatorRole :: Maybe String -- ^ role from attribute or meta tag - , creatorFileAs :: Maybe String -- ^ file-as from attribute or meta tag - , creatorSeq :: Maybe Int -- ^ display-sequence property from meta - , creatorText :: String -- ^ creator or contributor tag text - } - deriving (Eq, Show) - - -{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta - tag info into the data gathered from contributor and creator tags --} -refineCreator :: [Refinement] -> (String, Creator) -> Creator -refineCreator refinements (elid, creator) = - assignSeq . assignFileAs . assignRole $ creator - - where - assignRole creator' = - let existingRole = creatorRole creator' - metaRole = maybe Nothing (Just . refText) $ - findByIdProp elid "role" refinements - in creator' { creatorRole = existingRole `mplus` metaRole } - - assignFileAs creator' = - let existingFileAs = creatorFileAs creator' - metaFileAs = maybe Nothing (Just . refText) $ - findByIdProp elid "file-as" refinements - in creator' { creatorFileAs = existingFileAs `mplus` metaFileAs } - - assignSeq creator' = - let sq = maybe Nothing (Just . read . refText) $ - findByIdProp elid "display-seq" refinements - in creator' { creatorSeq = sq } - - --- | package\/metadata\/dc:date tag, opf:event attribute, text -data Date = Date (Maybe String) String - deriving (Eq, Show) - - -{- | Used internally by Codec.Epub.Parse.Metadata to populate the - metadata modified field with data extracted from the epub3 meta - tag with property dcterms:modified --} -getModified :: [Refinement] -> Maybe String -getModified refinements = - refText `fmap` findByIdProp "" "dcterms:modified" refinements - - --- | package\/metadata\/dc:description tag, xml:lang attribute, text -data Description = Description (Maybe String) String - deriving (Eq, Show) - - -{- | package\/metadata tag - - This is perhaps the most useful data structure in this library. It - contains most of the information tools will want to use to - organize epub documents. --} -data Metadata = Metadata - { metaIds :: [Identifier] -- ^ at least one required - , metaTitles :: [Title] -- ^ at least one required - , metaLangs :: [String] -- ^ dc:language tags, at least one required - , metaContributors :: [Creator] - , metaCreators :: [Creator] - , metaDates :: [Date] - , metaModified :: Maybe String -- ^ meta tag with property dcterms:modified, present only in epub3 documents - , metaSource :: Maybe String -- ^ dc:source tags - , metaType :: Maybe String -- ^ dc:type tags - , metaCoverages :: [String] -- ^ dc:coverage tags - , metaDescriptions :: [Description] - , metaFormats :: [String] -- ^ dc:format tags - , metaPublishers :: [String] -- ^ dc:publisher tags - , metaRelations :: [String] -- ^ dc:relation tags - , metaRights :: [String] -- ^ dc:rights tags - , metaSubjects :: [String] -- ^ dc:subject tags - } - deriving (Eq, Show) - --- | Note: This isn't valid as-is, some required values are empty lists! -emptyMetadata :: Metadata -emptyMetadata = Metadata - { metaIds = [] -- one required - , metaTitles = [] -- one required - , metaLangs = [] -- one required - , metaContributors = [] - , metaCreators = [] - , metaDates = [] - , metaModified = Nothing - , metaSource = Nothing - , metaType = Nothing - , metaCoverages = [] - , metaDescriptions = [] - , metaFormats = [] - , metaPublishers = [] - , metaRelations = [] - , metaRights = [] - , metaSubjects = [] - } diff --git a/src/Codec/Epub/Data/Package.hs b/src/Codec/Epub/Data/Package.hs deleted file mode 100644 --- a/src/Codec/Epub/Data/Package.hs +++ /dev/null @@ -1,22 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data type for working with epub package info - - This contains the package section from an epub document. In the - OPF XML document, this tag contains the other tags (metadata, - manifest...) --} -module Codec.Epub.Data.Package - ( Package (..) - ) - where - - -{- | package tag --} -data Package = Package - { pkgVersion :: String -- ^ version attribute. This contains which epub specification version (2.x or 3.x) this document conforms to. - , pkgUniqueId :: String -- ^ unique-identifier attribute. This should relate to one metaIdentifier in the Metadata and is intended to represent this book's unique identifier. - } - deriving (Eq, Show) diff --git a/src/Codec/Epub/Data/Spine.hs b/src/Codec/Epub/Data/Spine.hs deleted file mode 100644 --- a/src/Codec/Epub/Data/Spine.hs +++ /dev/null @@ -1,30 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Data types for working with the metadata of epub documents - - The spine represents a default ordering of items in the manifest. --} -module Codec.Epub.Data.Spine - ( Spine (..) - , SpineItemref (..) - ) - where - -import Codec.Epub.Data.Common - - --- | package\/spine\/itemref tag -data SpineItemref = SpineItemref - { siIdRef :: MFItemId -- ^ idref attribute. Must reference an item in the manifest - , siLinear :: Maybe Bool -- ^ linear attribute - } - deriving (Eq, Show) - - --- | package\/spine tag -data Spine = Spine - { spineToc :: MFItemId -- ^ toc attribute. Must reference the NCX in the manifest - , spineItemrefs :: [SpineItemref] -- ^ at least one required - } - deriving (Eq, Show) diff --git a/src/Codec/Epub/Format.hs b/src/Codec/Epub/Format.hs deleted file mode 100644 --- a/src/Codec/Epub/Format.hs +++ /dev/null @@ -1,46 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleInstances #-} - -{- | Module for pretty-printing epub meta-information - - Defined here is the Formattable typeclass and instances for the - top-level epub data structures. The intention is that consumers - use the format function on any of these otherwise disparate types. --} -module Codec.Epub.Format - ( Formattable (..) - ) - where - -import Codec.Epub.Data.Guide -import Codec.Epub.Data.Manifest -import Codec.Epub.Data.Metadata -import Codec.Epub.Data.Package -import Codec.Epub.Data.Spine -import Codec.Epub.Format.Guide -import Codec.Epub.Format.Manifest -import Codec.Epub.Format.Metadata -import Codec.Epub.Format.Package -import Codec.Epub.Format.Spine - - -class Formattable a where - format :: a -> String - - -instance Formattable [GuideRef] where - format = formatGuide - -instance Formattable Manifest where - format = formatManifest - -instance Formattable Metadata where - format = formatMetadata - -instance Formattable Package where - format = formatPackage - -instance Formattable Spine where - format = formatSpine diff --git a/src/Codec/Epub/Format/Guide.hs b/src/Codec/Epub/Format/Guide.hs deleted file mode 100644 --- a/src/Codec/Epub/Format/Guide.hs +++ /dev/null @@ -1,42 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - -{- | Module for pretty-printing epub guide info - - Used internally by Codec.Epub.Format --} -module Codec.Epub.Format.Guide - ( formatGuide - ) - where - -import Control.Monad.Writer.Lazy -import Data.Foldable ( toList ) -import Text.Printf - -import Codec.Epub.Format.Util -import Codec.Epub.Data.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 - - -{- | Format an epub Guide structure for pretty printing --} -formatGuide :: [GuideRef] -> String -formatGuide guideRefs = toList . execWriter $ tellGuide guideRefs diff --git a/src/Codec/Epub/Format/Manifest.hs b/src/Codec/Epub/Format/Manifest.hs deleted file mode 100644 --- a/src/Codec/Epub/Format/Manifest.hs +++ /dev/null @@ -1,39 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - -{- | Module for pretty-printing epub manifest info - - Used internally by Codec.Epub.Format --} -module Codec.Epub.Format.Manifest - ( formatManifest - ) - where - -import Control.Monad.Writer.Lazy -import Data.Foldable ( toList ) -import Text.Printf - -import Codec.Epub.Format.Util -import Codec.Epub.Data.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 - - -{- | Format an epub Manifest structure for pretty printing --} -formatManifest :: Manifest -> String -formatManifest (Manifest mis) = toList . execWriter - $ tellManifest mis diff --git a/src/Codec/Epub/Format/Metadata.hs b/src/Codec/Epub/Format/Metadata.hs deleted file mode 100644 --- a/src/Codec/Epub/Format/Metadata.hs +++ /dev/null @@ -1,117 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - -{- | Module for pretty-printing epub metadata info - - Used internally by Codec.Epub.Format --} -module Codec.Epub.Format.Metadata - ( formatMetadata - ) - where - -import Control.Monad.Writer.Lazy -import Data.Foldable ( toList ) -import Text.Printf - -import Codec.Epub.Format.Util -import Codec.Epub.Data.Metadata - - -tellTitle :: MonadWriter (Seq Char) m => Title -> m () -tellTitle (Title Nothing Nothing Nothing text) = - tellSeq $ printf "title: %s\n" text -tellTitle title = - tellSeq $ printf "title\n%s%s%s%s" - (formatSubline "text" (Just $ titleText title)) - (formatSubline "lang" (titleLang title)) - (formatSubline "title-type" (titleType title)) - (formatSubline "display-seq" (show `fmap` titleSeq title)) - - -tellCreator :: MonadWriter (Seq Char) m => Creator -> m () -tellCreator (Creator Nothing Nothing Nothing creator) = - tellSeq $ printf "creator: %s\n" creator -tellCreator (Creator role fileAs dseq creator) = - tellSeq $ printf "creator\n%s%s%s%s" - (formatSubline "text" (Just creator)) - (formatSubline "file-as" fileAs) - (formatSubline "role" role) - (formatSubline "display-seq" (show `fmap` dseq)) - - -tellContributor :: MonadWriter (Seq Char) m => Creator -> m () -tellContributor (Creator Nothing Nothing Nothing contributor) = - tellSeq $ printf "contributor: %s\n" contributor -tellContributor (Creator role fileAs dseq contributor) = - tellSeq $ printf "contributor\n%s%s%s%s" - (formatSubline "text" (Just contributor)) - (formatSubline "file-as" fileAs) - (formatSubline "role" role) - (formatSubline "display-seq" (show `fmap` dseq)) - - -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 ident = - tellSeq $ printf "identifier\n%s%s%s%s" - (formatSubline "id" (idId ident)) - (formatSubline "identifier-type" (idType ident)) - (formatSubline "scheme" (idScheme ident)) - (formatSubline "text" (Just . idText $ ident)) - - -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) - - -tellSimpleMbString :: MonadWriter (Seq Char) m => String - -> Maybe String -> m () -tellSimpleMbString _ Nothing = return () -tellSimpleMbString label (Just s) = tellSimpleString label s - - -tellMetadata :: MonadWriter (Seq Char) m => Metadata -> m () -tellMetadata (Metadata ids titles langs contributors creators dates modified source mType coverage desc format publisher relation rights subjects) = do - mapM_ tellId ids - mapM_ tellTitle titles - mapM_ (tellSimpleString "language") langs - mapM_ tellContributor contributors - mapM_ tellCreator creators - mapM_ tellDate dates - tellSimpleMbString "modified" modified - tellSimpleMbString "source" source - tellSimpleMbString "type" mType - mapM_ (tellSimpleString "coverage") coverage - mapM_ tellDescription desc - mapM_ (tellSimpleString "format") format - mapM_ (tellSimpleString "publisher") publisher - mapM_ (tellSimpleString "relation") relation - mapM_ (tellSimpleString "rights") rights - mapM_ (tellSimpleString "subject") subjects - - -{- | Format an epub Metadata structure for pretty printing --} -formatMetadata :: Metadata -> String -formatMetadata meta = toList . execWriter - $ tellMetadata meta diff --git a/src/Codec/Epub/Format/Package.hs b/src/Codec/Epub/Format/Package.hs deleted file mode 100644 --- a/src/Codec/Epub/Format/Package.hs +++ /dev/null @@ -1,33 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - -{- | Module for pretty-printing epub package info - - Used internally by Codec.Epub.Format --} -module Codec.Epub.Format.Package - ( formatPackage - ) - where - -import Control.Monad.Writer.Lazy -import Data.Foldable ( toList ) - -import Codec.Epub.Data.Package -import Codec.Epub.Format.Util - - -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) - - -{- | Format an epub Package structure for pretty printing --} -formatPackage :: Package -> String -formatPackage (Package v u) = toList . execWriter - $ tellPackage (v, u) diff --git a/src/Codec/Epub/Format/Spine.hs b/src/Codec/Epub/Format/Spine.hs deleted file mode 100644 --- a/src/Codec/Epub/Format/Spine.hs +++ /dev/null @@ -1,45 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - -{- | Module for pretty-printing epub spine info - - Used internally by Codec.Epub.Format --} -module Codec.Epub.Format.Spine - ( formatSpine - ) - where - -import Control.Monad.Writer.Lazy -import Data.Foldable ( toList ) -import Text.Printf - -import Codec.Epub.Format.Util -import Codec.Epub.Data.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 - - -{- | Format an epub Spine structure for pretty printing --} -formatSpine :: Spine -> String -formatSpine sp = toList . execWriter - $ tellSpine sp diff --git a/src/Codec/Epub/Format/Util.hs b/src/Codec/Epub/Format/Util.hs deleted file mode 100644 --- a/src/Codec/Epub/Format/Util.hs +++ /dev/null @@ -1,25 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Utility functions shared by several formatting modules -module Codec.Epub.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/IO.hs b/src/Codec/Epub/IO.hs deleted file mode 100644 --- a/src/Codec/Epub/IO.hs +++ /dev/null @@ -1,184 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - --- | Functions for performing some IO operations on epub files - -module Codec.Epub.IO - ( getPkgXmlFromZip - , getPkgPathXmlFromZip - , getPkgPathXmlFromBS - , getPkgPathXmlFromDir - , mkEpubArchive - , readArchive - , writeArchive - ) - where - -import Codec.Archive.Zip -import Control.Arrow.ListArrows ( (>>>), deep ) -import Control.Exception -import Control.Monad.Except -import qualified Data.ByteString.Char8 as BS -import Data.ByteString.Lazy ( fromChunks ) -import qualified Data.ByteString.Lazy as B -import qualified Data.ByteString.Lazy.UTF8 as UTF8 -import Data.List -import System.Directory -import System.FilePath -import Text.XML.HXT.Arrow.ReadDocument ( readString ) -import Text.XML.HXT.Arrow.XmlArrow ( getAttrValue, hasName, isElem ) -import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) - -import Codec.Epub.Util - - -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 . UTF8.toString . fromEntry) mbEntry - - -{- | The static location of the container.xml, as specified by the - epub docs --} -containerPath :: FilePath -containerPath = "META-INF/container.xml" - - -{- | Get the path and contents of the epub Package Document from - a ByteString representing an epub (zip) file --} -getPkgPathXmlFromBS :: (MonadError String m, MonadIO m) - => BS.ByteString -- ^ contents of the zip file - -> m (FilePath, String) -- ^ path (within the epub archive) and contents of the epub Package Document -getPkgPathXmlFromBS 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. - -} - containerDoc <- fileFromArchive containerPath archive - - let cleanedContents = removeIllegalStartChars . removeEncoding - . removeDoctype $ containerDoc - - rootPath <- locateRootFile containerPath cleanedContents - - -- Now that we have the path to the .opf file, extract it - rootContents <- fileFromArchive rootPath archive - - return (rootPath, rootContents) - - -{- | Get the path and contents of the epub Package Document from - an epub (zip) file --} -getPkgPathXmlFromZip :: (MonadError String m, MonadIO m) - => FilePath -- ^ path to epub zip file - -> m (FilePath, String) -- ^ path (within the epub archive) and contents of the epub Package Document -getPkgPathXmlFromZip zipPath = do - {- Strictly read this file into a ByteString, send to - getPkgPathXmlFromBS - -} - zipFileBytes <- liftIO $ BS.readFile zipPath - getPkgPathXmlFromBS zipFileBytes - - --- | Get the contents of the epub Package Document from an epub (zip) file -getPkgXmlFromZip :: (MonadError String m, MonadIO m) - => FilePath -- ^ path to epub zip file - -> m String -- ^ contents of the epub Package Document -getPkgXmlFromZip zipPath = snd `liftM` getPkgPathXmlFromZip zipPath - - -{- | Get the path and contents of the epub Package Document from - a directory containing the files from an epub file (as in: - it's been unzipped into a dir) --} -getPkgPathXmlFromDir :: (MonadError String m, MonadIO m) - => FilePath -- ^ directory path - -> m (FilePath, String) -- ^ path (within the epub archive) and contents of the epub Package Document -getPkgPathXmlFromDir 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 - - 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) - - -{- 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/Epub/Parse.hs b/src/Codec/Epub/Parse.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse.hs +++ /dev/null @@ -1,113 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows, FlexibleContexts #-} - -{- | The main parsing interface, these get* functions are intended - to be used by consumers of this library - - This module is called Parse because it invokes the XML parsing - machinery of this library, but consumers of the library do not - have to interact with HXT, Arrows or XML directly. --} -module Codec.Epub.Parse - ( getGuide - , getManifest - , getMetadata - , getPackage - , getSpine - ) - where - -import Control.Arrow.ListArrows -import Control.Monad.Except -import Text.XML.HXT.Arrow.Namespace ( propagateNamespaces ) -import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) -import Text.XML.HXT.Arrow.XmlState.TypeDefs -import Text.XML.HXT.Arrow.ReadDocument ( readString ) -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.Data.Guide -import Codec.Epub.Data.Manifest -import Codec.Epub.Data.Metadata -import Codec.Epub.Data.Package -import Codec.Epub.Data.Spine -import Codec.Epub.Parse.Guide -import Codec.Epub.Parse.Manifest -import Codec.Epub.Parse.Metadata -import Codec.Epub.Parse.Package -import Codec.Epub.Parse.Refinements -import Codec.Epub.Parse.Spine -import Codec.Epub.Util - - -{- Extract the epub OPF Package data contained in the supplied - XML string --} -performParse :: (MonadIO m, MonadError String m) => - IOSLA (XIOState ()) XmlTree b -> String -> m b -performParse parser 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 - >>> parser - ) - - case result of - (r : []) -> return r - _ -> throwError - "ERROR: FIXME with a better message" - - -{- | Parse epub guide items from a String representing the epub XML - Package Document --} -getGuide :: (MonadIO m, MonadError String m) => - String -> m [GuideRef] -getGuide = performParse guideP - - -{- | Parse epub manifest data from a String representing the epub XML - Package Document --} -getManifest :: (MonadIO m, MonadError String m) => - String -> m Manifest -getManifest = performParse manifestP - - -{- | Parse epub metadata from a String representing the epub XML - Package Document --} -{- Parsing the metadata is a two-pass process - First we need to parse the meta tags only, referred to in this - code as 'refinements.' - Second we parse the metadata tags themselves, passing in the - refinements so their info can be merged during parse --} -getMetadata :: (MonadIO m, MonadError String m) => - String -> m Metadata -getMetadata opfContents = do - refinements <- performParse refinementsP opfContents - rawMd <- performParse (metadataP refinements) opfContents - return rawMd - - -{- | Parse epub package info from a String representing the epub XML - Package Document --} -getPackage :: (MonadIO m, MonadError String m) => - String -> m Package -getPackage = performParse packageP - - -{- | Parse epub spine info from a String representing the epub XML - Package Document --} -getSpine :: (MonadIO m, MonadError String m) => - String -> m Spine -getSpine = performParse spineP diff --git a/src/Codec/Epub/Parse/Guide.hs b/src/Codec/Epub/Parse/Guide.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse/Guide.hs +++ /dev/null @@ -1,32 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} - --- | Parsing for the guide section of the OPF Package XML Document -module Codec.Epub.Parse.Guide - ( guideP - ) - where - -import Control.Arrow.ListArrows -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.Data.Guide -import Codec.Epub.Parse.Util - - -guideRefP :: (ArrowXml a) => a (NTree XNode) GuideRef -guideRefP = atQTag (opfName "reference") >>> - proc x -> do - t <- getAttrValue "type" -< x - mt <- mbGetAttrValue "title" -< x - h <- getAttrValue "href" -< x - returnA -< GuideRef t mt h - - -guideP :: (ArrowXml a) => a (NTree XNode) [GuideRef] -guideP = (atQTag (opfName "guide") >>> listA guideRefP) - `orElse` constA [] diff --git a/src/Codec/Epub/Parse/Manifest.hs b/src/Codec/Epub/Parse/Manifest.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse/Manifest.hs +++ /dev/null @@ -1,34 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} - --- | Parsing for the manifest section of the OPF Package XML Document -module Codec.Epub.Parse.Manifest - ( manifestP - ) - where - -import Control.Arrow.ListArrows -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.Data.Manifest -import Codec.Epub.Parse.Util - - -manifestItemP :: (ArrowXml a) => a (NTree XNode) ManifestItem -manifestItemP= atQTag (opfName "item") >>> - proc x -> do - i <- getAttrValue "id" -< x - h <- getAttrValue "href" -< x - m <- getAttrValue "media-type" -< x - returnA -< ManifestItem i h m - - -manifestP :: (ArrowXml a) => a (NTree XNode) Manifest -manifestP = atQTag (opfName "manifest") >>> - proc x -> do - l <- listA manifestItemP -< x - returnA -< Manifest l diff --git a/src/Codec/Epub/Parse/Metadata.hs b/src/Codec/Epub/Parse/Metadata.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse/Metadata.hs +++ /dev/null @@ -1,126 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} - --- | Parsing for the metadata section of the OPF Package XML Document -module Codec.Epub.Parse.Metadata - ( metadataP - ) - where - -import Control.Applicative -import Control.Arrow.ListArrows -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.Data.Metadata -import Codec.Epub.Parse.Util - - -idP :: (ArrowXml a) => a (NTree XNode) Identifier -idP = atQTag (dcName "identifier") >>> ( unwrapArrow $ Identifier - <$> (WrapArrow $ mbGetAttrValue "id") - <*> (WrapArrow $ constA Nothing) - <*> (WrapArrow $ mbGetQAttrValue (opfName "scheme")) -- An attr in epub2 - <*> (WrapArrow $ text) - ) - - -titleP :: (ArrowXml a) => a (NTree XNode) (String, Title) -titleP = atQTag (dcName "title") >>> - proc x -> do - i <- mbGetAttrValue "id" -< x - l <- mbGetQAttrValue (xmlName "lang") -< x - c <- text -< x - returnA -< ((maybe "" id i), Title l Nothing Nothing c) - - -langP :: (ArrowXml a) => a (NTree XNode) String -langP = atQTag (dcName "language") >>> text - - -{- Since creators and contributors have the same exact XML structure, - this arrow is used to get either of them --} -creatorP :: (ArrowXml a) => String -> a (NTree XNode) (String, Creator) -creatorP tag = atQTag (dcName tag) >>> - proc x -> do - i <- mbGetAttrValue "id" -< x - r <- mbGetQAttrValue (opfName "role") -< x - f <- mbGetQAttrValue (opfName "file-as") -< x - t <- text -< x - returnA -< ((maybe "" id i), Creator r f Nothing t) - - -dateP :: (ArrowXml a) => a (NTree XNode) Date -dateP = atQTag (dcName "date") >>> - proc x -> do - e <- mbGetQAttrValue (opfName "event") -< x - c <- text -< x - returnA -< Date e c - - -sourceP :: (ArrowXml a) => a (NTree XNode) (Maybe String) -sourceP = mbQTagText $ dcName "source" - - -typeP :: (ArrowXml a) => a (NTree XNode) (Maybe String) -typeP = mbQTagText $ dcName "type" - - -coverageP :: (ArrowXml a) => a (NTree XNode) String -coverageP = atQTag (dcName "coverage") >>> text - - -descriptionP :: (ArrowXml a) => a (NTree XNode) Description -descriptionP = atQTag (dcName "description") >>> - proc x -> do - l <- mbGetQAttrValue (xmlName "lang") -< x - c <- text -< x - returnA -< Description l c - - -formatP :: (ArrowXml a) => a (NTree XNode) String -formatP = atQTag (dcName "format") >>> text - - -publisherP :: (ArrowXml a) => a (NTree XNode) String -publisherP = atQTag (dcName "publisher") >>> text - - -relationP :: (ArrowXml a) => a (NTree XNode) String -relationP = atQTag (dcName "relation") >>> text - - -rightsP :: (ArrowXml a) => a (NTree XNode) String -rightsP = atQTag (dcName "rights") >>> text - - -subjectP :: (ArrowXml a) => a (NTree XNode) String -subjectP = atQTag (dcName "subject") >>> text - - -metadataP :: (ArrowXml a) => [Refinement] -> a (NTree XNode) Metadata -metadataP refinements = - atQTag (opfName "metadata") >>> ( unwrapArrow $ Metadata - <$> (WrapArrow $ listA $ idP >>. map (refineIdentifier refinements)) - <*> (WrapArrow $ listA $ titleP >>. map (refineTitle refinements)) - <*> (WrapArrow $ listA langP) - <*> (WrapArrow $ listA $ creatorP "contributor" >>. - map (refineCreator refinements)) - <*> (WrapArrow $ listA $ creatorP "creator" >>. - map (refineCreator refinements)) - <*> (WrapArrow $ listA dateP) - <*> (WrapArrow $ constA $ getModified refinements) - <*> (WrapArrow sourceP) - <*> (WrapArrow typeP) - <*> (WrapArrow $ listA coverageP) - <*> (WrapArrow $ listA descriptionP) - <*> (WrapArrow $ listA formatP) - <*> (WrapArrow $ listA publisherP) - <*> (WrapArrow $ listA relationP) - <*> (WrapArrow $ listA rightsP) - <*> (WrapArrow $ listA subjectP) - ) diff --git a/src/Codec/Epub/Parse/Package.hs b/src/Codec/Epub/Parse/Package.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse/Package.hs +++ /dev/null @@ -1,26 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} - --- | Parsing for the package section of the OPF Package XML Document -module Codec.Epub.Parse.Package - ( packageP - ) - where - -import Control.Arrow.ListArrows -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.Data.Package -import Codec.Epub.Parse.Util - - -packageP :: (ArrowXml a) => a (NTree XNode) Package -packageP = atQTag (opfName "package") >>> - proc x -> do - v <- getAttrValue "version" -< x - u <- getAttrValue "unique-identifier" -< x - returnA -< (Package v u) diff --git a/src/Codec/Epub/Parse/Refinements.hs b/src/Codec/Epub/Parse/Refinements.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse/Refinements.hs +++ /dev/null @@ -1,39 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} - -{- | Parsing for meta tags in the metadata section of the OPF - Package XML Document --} -module Codec.Epub.Parse.Refinements - ( refinementsP - ) - where - -import Control.Applicative -import Control.Arrow.ListArrows -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.Data.Metadata -import Codec.Epub.Parse.Util - - -removeHash :: String -> String -removeHash ('#' : cs) = cs -removeHash s = s - - -refinementP :: (ArrowXml a) => a (NTree XNode) Refinement -refinementP = atQTag (opfName "meta") >>> ( unwrapArrow $ Refinement - <$> (WrapArrow $ mbGetAttrValue "refines" >>^ maybe "" removeHash) - <*> (WrapArrow $ mbGetAttrValue "property" >>^ maybe "" id) - <*> (WrapArrow $ mbGetAttrValue "scheme" >>^ maybe "" id) - <*> (WrapArrow $ text) - ) - - -refinementsP :: (ArrowXml a) => a (NTree XNode) [Refinement] -refinementsP = atQTag (opfName "metadata") >>> listA refinementP diff --git a/src/Codec/Epub/Parse/Spine.hs b/src/Codec/Epub/Parse/Spine.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse/Spine.hs +++ /dev/null @@ -1,35 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} - --- | Parsing for the spine section of the OPF Package XML Document -module Codec.Epub.Parse.Spine - ( spineP - ) - where - -import Control.Arrow.ListArrows -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs - -import Codec.Epub.Data.Spine -import Codec.Epub.Parse.Util - - -spineItemrefP :: (ArrowXml a) => a (NTree XNode) SpineItemref -spineItemrefP = 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 - - -spineP :: (ArrowXml a) => a (NTree XNode) Spine -spineP = atQTag (opfName "spine") >>> - proc x -> do - i <- getAttrValue "toc" -< x - l <- listA spineItemrefP -< x - returnA -< (Spine i l) diff --git a/src/Codec/Epub/Parse/Util.hs b/src/Codec/Epub/Parse/Util.hs deleted file mode 100644 --- a/src/Codec/Epub/Parse/Util.hs +++ /dev/null @@ -1,95 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE Arrows #-} - --- | Helper functions used by the other parsing modules -module Codec.Epub.Parse.Util - ( atQTag - , mbQTagText - , mbGetAttrValue - , mbGetQAttrValue - , notNullA - , text - , dcName - , opfName - , xmlName - ) - where - -import Control.Arrow.ListArrows -import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs - - --- 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) --} - - -{- | Shortcut arrow to drill down to a specific namespaced child - element --} -atQTag :: (ArrowXml a) => QName -> a (NTree XNode) XmlTree -atQTag tag = deep (isElem >>> hasQName tag) - - --- | Shortcut arrow to gather up the text part of all child nodes -text :: (ArrowXml a) => a (NTree XNode) String -text = getChildren >>> getText - - --- | Arrow that succeeds if the input is not the empty list -notNullA :: (ArrowList a) => a [b] [b] -notNullA = isA $ not . null - - -{- | Shortcut arrow to retrieve the contents of a namespaced element - as a Maybe String --} -mbQTagText :: (ArrowXml a) => QName -> a (NTree XNode) (Maybe String) -mbQTagText tag = - ( atQTag tag >>> - text >>> notNullA >>^ Just ) - `orElse` - (constA Nothing) - - -{- | Shortcut arrow to retrieve an attribute of an element as a - Maybe String --} -mbGetAttrValue :: (ArrowXml a) => - String -> a XmlTree (Maybe String) -mbGetAttrValue n = - (getAttrValue n >>> notNullA >>^ Just) - `orElse` (constA Nothing) - - -{- | Shortcut arrow to retrieve an attribute of a namespaced element - as a Maybe String --} -mbGetQAttrValue :: (ArrowXml a) => - QName -> a XmlTree (Maybe String) -mbGetQAttrValue qn = - (getQAttrValue qn >>> notNullA >>^ Just) - `orElse` (constA Nothing) - - --- | Construct a qualified name in the Dublin Core namespace -dcName :: String -> QName -dcName local = mkQName "dc" local "http://purl.org/dc/elements/1.1/" - - --- | Construct a qualified name in the epub OPF namespace -opfName :: String -> QName -opfName local = mkQName "opf" local "http://www.idpf.org/2007/opf" - - --- | Construct a qualified name in the XML namespace -xmlName :: String -> QName -xmlName local = mkQName "xml" local "http://www.w3.org/XML/1998/namespace" diff --git a/src/Codec/Epub/Util.hs b/src/Codec/Epub/Util.hs deleted file mode 100644 --- a/src/Codec/Epub/Util.hs +++ /dev/null @@ -1,30 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{- | Utility functions shared by modules that need to read the - contents of XML documents. --} -module Codec.Epub.Util - where - -import Text.Regex - - -{- | 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)) "" diff --git a/src/app/epub-metadata-example.hs b/src/app/epub-metadata-example.hs new file mode 100644 --- /dev/null +++ b/src/app/epub-metadata-example.hs @@ -0,0 +1,50 @@ +{- + This is a small app for maintaining the example code that + goes into the Haddock docs for Codec.Epub +-} + +import Codec.Epub +import Codec.Epub.Data.Package +import Control.Monad.Except + + +main :: IO () +main = do + -- epub-metadata actions are in MonadIO and MonadError, so we're + -- using ErrorT here + + result <- runExceptT $ do + + -- Use the getPkgXmlFromZip action to extract the Package + -- Document as an XML string. There are also other actions + -- for reading from ByteStringS and directories. + -- + -- See Codec.Epub.IO + + xmlString <- getPkgXmlFromZip "/path/to/book.epub" + + -- Now the sections of meta-information about the book can + -- be extracted from that XML using functions like getPackage, + -- getMetadata, etc. + -- + -- See Codec.Epub.Parse + + pkg <- getPackage xmlString -- :: Codec.Epub.Data.Package + meta <- getMetadata xmlString -- :: Codec.Epub.Data.Metadata + + -- Parts of these data structures can be used from here + -- as needed + -- + -- See Codec.Epub.Data.Package for pkgVersion below + -- and the others in Codec.Epub.Data.* + + liftIO $ putStrLn $ pkgVersion pkg + + -- There is also pretty-print formatting of these data types + -- in Codec.Epub.Data through the Formattable typeclass + -- + -- See Codec.Epub.Format + + liftIO $ putStr $ format meta + + either putStrLn return result diff --git a/src/lib/Codec/Epub.hs b/src/lib/Codec/Epub.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub.hs @@ -0,0 +1,70 @@ +{- | + This is a library for parsing and manipulating epub document metadata. Almost all of the data stored in the epub Package Document can be worked with using this API. This includes the most useful block of data, the epub metadata. This library supports epub versions 2 and 3. + + This library was constructed by studying the IDPF specifications for epub documents found here and here + + Consumers of epub-metadata will likely need this module, which re-exports the most useful parts concerning disk IO, parsing of the XML into Codec.Epub.Data.* data structures and formatting these data structures to be pretty-printed. Please also see Codec.Epub.Data.Metadata etc. +-} +module Codec.Epub ( + -- * Epub + module Codec.Epub.Format, + module Codec.Epub.IO, + module Codec.Epub.Parse + + -- * Example + -- $example1 + ) + where + +import Codec.Epub.Format +import Codec.Epub.IO +import Codec.Epub.Parse + + +{- $example1 +> import Codec.Epub +> import Codec.Epub.Data.Package +> import Control.Monad.Error +> +> +> main :: IO () +> main = do +> -- epub-metadata actions are in MonadIO and MonadError, so we're +> -- using ErrorT here +> +> result <- runErrorT $ do +> +> -- Use the getPkgXmlFromZip action to extract the Package +> -- Document as an XML string. There are also other actions +> -- for reading from ByteStringS and directories. +> -- +> -- See Codec.Epub.IO +> +> xmlString <- getPkgXmlFromZip "/path/to/book.epub" +> +> -- Now the sections of meta-information about the book can +> -- be extracted from that XML using functions like getPackage, +> -- getMetadata, etc. +> -- +> -- See Codec.Epub.Parse +> +> pkg <- getPackage xmlString -- :: Codec.Epub.Data.Package +> meta <- getMetadata xmlString -- :: Codec.Epub.Data.Metadata +> +> -- Parts of these data structures can be used from here +> -- as needed +> -- +> -- See Codec.Epub.Data.Package for pkgVersion below +> -- and the others in Codec.Epub.Data.* +> +> liftIO $ putStrLn $ pkgVersion pkg +> +> -- There is also pretty-print formatting of these data types +> -- in Codec.Epub.Data through the Formattable typeclass +> -- +> -- See Codec.Epub.Format +> +> liftIO $ putStr $ format meta +> +> either putStrLn return result +-} diff --git a/src/lib/Codec/Epub/Data/Common.hs b/src/lib/Codec/Epub/Data/Common.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Data/Common.hs @@ -0,0 +1,10 @@ +{- | Data types for working with the metadata of epub documents + + This module helps to avoid circular imports for definitions needed by two or more other modules in this library. +-} +module Codec.Epub.Data.Common + where + + +-- | Attribute value used to relate things to each other in the OPF data +type MFItemId = String diff --git a/src/lib/Codec/Epub/Data/Guide.hs b/src/lib/Codec/Epub/Data/Guide.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Data/Guide.hs @@ -0,0 +1,19 @@ +{- | Data types for working with the metadata of epub documents + + This contains the guide section in an epub2 OPF document. It has been deprecated in the epub3 spec and should not be present in epub3 documents. +-} +module Codec.Epub.Data.Guide + ( GuideRef (..) + ) + where + +import Codec.Epub.Data.Common + + +-- | package\/guide\/reference tag +data GuideRef = GuideRef + { grType :: String -- ^ type attribute. Must follow 13th edition of the Chicago Manual of Style + , grTitle :: Maybe String -- ^ title attribute + , grHref :: MFItemId -- ^ href attribute. Must reference an item in the manifest + } + deriving (Eq, Show) diff --git a/src/lib/Codec/Epub/Data/Manifest.hs b/src/lib/Codec/Epub/Data/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Data/Manifest.hs @@ -0,0 +1,29 @@ +{- | Data types for working with the metadata of epub documents + + This contains the manifest information from an epub document. +-} +module Codec.Epub.Data.Manifest + ( Manifest (..) + , ManifestItem (..) + ) + where + +import Codec.Epub.Data.Common + + +-- | manifest attribute values +type MFItemHref = String +type MFItemMediaType = String + + +-- | package\/manifest\/item tag +data ManifestItem = ManifestItem + { mfiId :: MFItemId -- ^ id attribute + , mfiHref :: MFItemHref -- ^ href attribute + , mfiMediaType :: MFItemMediaType -- ^ media-type attribute + } + deriving (Eq, Show) + + +newtype Manifest = Manifest [ManifestItem] + deriving (Eq, Show) diff --git a/src/lib/Codec/Epub/Data/Metadata.hs b/src/lib/Codec/Epub/Data/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Data/Metadata.hs @@ -0,0 +1,246 @@ +{- | Data types for working with the metadata of epub documents + + This module defines the Metadata structure which contains most of the taxonomic information about the literary work. Metadata is probably the most important data structure in this library. + + Both commonly-used versions of epub (2.x and 3.x) are supported by these types. +-} +module Codec.Epub.Data.Metadata + ( Metadata (..) + , Identifier (..) + , Title (..) + , Creator (..) + , DateValue (..) + , DateEvent (..) + , Description (..) + , Refinement (..) + , dateEventFromString + , dateEventToString + , emptyMetadata + , refineIdentifier + , refineTitle + , refineCreator + ) + where + +import Control.Monad ( mplus ) +import Data.List ( find ) +import qualified Data.Map.Strict as Map +import Data.Map.Strict ( Map ) + + +{- | Refinements represent meta tags within the metadata section + that refine other tags. These are used during the parsing phase + and are discarded as their information is slotted into the data + they refine (CreatorS, TitleS, IdentifierS, etc..) + + This is specific to epub3 +-} +data Refinement = Refinement + { refId :: String -- ^ id attribute + , refProp :: String -- ^ property attribute + , refScheme :: String -- ^ scheme attribute + , refText :: String -- ^ meta tag text + } + + +{- Used for locating specific meta information in a list of + Refinements. The data from these meta tags is related to other + tags by an XML id attribute. +-} +findByIdProp :: String -> String -> [Refinement] -> Maybe Refinement +findByIdProp i prop = find (\r -> refId r == i && refProp r == prop) + + +-- | package\/metadata\/dc:identifier tag +data Identifier = Identifier + { idId :: Maybe String -- ^ id attribute + , idType :: Maybe String -- ^ identifier-type property from meta tag + , idScheme :: Maybe String -- ^ scheme from attribute or meta tag + , idText :: String -- ^ identifier tag text + } + deriving (Eq, Show) + + +{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta + tag info into the data gathered from an identifier tag +-} +refineIdentifier :: [Refinement] -> Identifier -> Identifier +refineIdentifier refinements ident = assignScheme . assignType $ ident + where + meta = findByIdProp (maybe "" id $ idId ident) + "identifier-type" refinements + + assignType ident' = ident' { idType = refText `fmap` meta } + + assignScheme ident' = + let existingScheme = idScheme ident' + in ident' { idScheme = existingScheme `mplus` + (refScheme `fmap` meta) } + + +-- | package\/metadata\/dc:title tag +data Title = Title + { titleLang :: Maybe String -- ^ lang attribute + , titleType :: Maybe String -- ^ title-type property from meta tag + , titleSeq :: Maybe Int -- ^ display-sequence property from meta + , titleText :: String -- ^ title tag text + } + deriving (Eq, Show) + + +{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta + tag info into the data gathered from a title tag +-} +refineTitle :: [Refinement] -> (String, Title) -> Title +refineTitle refinements (elid, title) = assignSeq . assignType $ title + where + assignType title' = + let newTy = refText `fmap` + findByIdProp elid "title-type" refinements + in title' { titleType = newTy } + + assignSeq title' = + let sq = maybe Nothing (Just . read . refText) $ + findByIdProp elid "display-seq" refinements + in title' { titleSeq = sq } + + +{- | package\/metadata\/dc:creator or package\/metadata\/dc:contributor + tags + + This structure is used for both contributor and creator as they are exactly the same. +-} +data Creator = Creator + { creatorRole :: Maybe String -- ^ role from attribute or meta tag + , creatorFileAs :: Maybe String -- ^ file-as from attribute or meta tag + , creatorSeq :: Maybe Int -- ^ display-sequence property from meta + , creatorText :: String -- ^ creator or contributor tag text + } + deriving (Eq, Show) + + +{- | Used internally by Codec.Epub.Parse.Metadata to merge epub3 meta + tag info into the data gathered from contributor and creator tags +-} +refineCreator :: [Refinement] -> (String, Creator) -> Creator +refineCreator refinements (elid, creator) = + assignSeq . assignFileAs . assignRole $ creator + + where + assignRole creator' = + let existingRole = creatorRole creator' + metaRole = maybe Nothing (Just . refText) $ + findByIdProp elid "role" refinements + in creator' { creatorRole = existingRole `mplus` metaRole } + + assignFileAs creator' = + let existingFileAs = creatorFileAs creator' + metaFileAs = maybe Nothing (Just . refText) $ + findByIdProp elid "file-as" refinements + in creator' { creatorFileAs = existingFileAs `mplus` metaFileAs } + + assignSeq creator' = + let sq = maybe Nothing (Just . read . refText) $ + findByIdProp elid "display-seq" refinements + in creator' { creatorSeq = sq } + + +data DateEvent + = Available + | Created + | Date + | DateAccepted + | DateCopyrighted + | DateSubmitted + | Epub + | Issued + | Modified + | Valid + deriving (Eq, Ord, Show) + +dateEventFromString :: Maybe String -> Maybe DateEvent +dateEventFromString (Just "dcterms:available") = Just Available +dateEventFromString (Just "dcterms:created") = Just Created +dateEventFromString (Just "publication") = Just Created -- EPUB 2.x +dateEventFromString (Just "dcterms:date") = Just Date +dateEventFromString (Just "dcterms:dateAccepted") = Just DateAccepted +dateEventFromString (Just "dcterms:dateCopyrighted") = Just DateCopyrighted +dateEventFromString (Just "dcterms:dateSubmitted") = Just DateSubmitted +dateEventFromString (Just "dcterms:issued") = Just Issued +dateEventFromString (Just "original-publication") = Just Issued -- EPUB 2.x +dateEventFromString (Just "dcterms:modified") = Just Modified +dateEventFromString (Just "dcterms:valid") = Just Valid +dateEventFromString Nothing = Just Epub +dateEventFromString _ = Nothing + +dateEventToString :: DateEvent -> String +dateEventToString Available = "available" +dateEventToString Created = "created" +dateEventToString Date = "date" +dateEventToString DateAccepted = "dateAccepted" +dateEventToString DateCopyrighted = "dateCopyrighted" +dateEventToString DateSubmitted = "dateSubmitted" +dateEventToString Epub = "EPUB created" +dateEventToString Issued = "issued" +dateEventToString Modified = "modified" +dateEventToString Valid = "valid" + + +-- | EPUB 2.x: package\/metadata\/dc:date tag, opf:event attribute, text +-- | EPUB 3.x: package\/metadata\/dc:date tag +-- | package\/metadata\/meta property="dcterms:issued" +-- | package\/metadata\/meta property="dcterms:modified" +-- | package\/metadata\/meta property="dcterms:..." +newtype DateValue = DateValue String + deriving (Eq, Show) + + +-- | package\/metadata\/dc:description tag, xml:lang attribute, text +data Description = Description (Maybe String) String + deriving (Eq, Show) + + +{- | package\/metadata tag + + This is perhaps the most useful data structure in this library. It + contains most of the information tools will want to use to + organize epub documents. +-} +data Metadata = Metadata + { metaIds :: [Identifier] -- ^ at least one required + , metaTitles :: [Title] -- ^ at least one required + , metaLangs :: [String] -- ^ dc:language tags, at least one required + , metaContributors :: [Creator] + , metaCreators :: [Creator] + , metaDates :: Map DateEvent DateValue + , metaSource :: Maybe String -- ^ dc:source tags + , metaType :: Maybe String -- ^ dc:type tags + , metaCoverages :: [String] -- ^ dc:coverage tags + , metaDescriptions :: [Description] + , metaFormats :: [String] -- ^ dc:format tags + , metaPublishers :: [String] -- ^ dc:publisher tags + , metaRelations :: [String] -- ^ dc:relation tags + , metaRights :: [String] -- ^ dc:rights tags + , metaSubjects :: [String] -- ^ dc:subject tags + } + deriving (Eq, Show) + +-- | Note: This isn't valid as-is, some required values are empty lists! +emptyMetadata :: Metadata +emptyMetadata = Metadata + { metaIds = [] -- one required + , metaTitles = [] -- one required + , metaLangs = [] -- one required + , metaContributors = [] + , metaCreators = [] + , metaDates = Map.empty + , metaSource = Nothing + , metaType = Nothing + , metaCoverages = [] + , metaDescriptions = [] + , metaFormats = [] + , metaPublishers = [] + , metaRelations = [] + , metaRights = [] + , metaSubjects = [] + } diff --git a/src/lib/Codec/Epub/Data/Package.hs b/src/lib/Codec/Epub/Data/Package.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Data/Package.hs @@ -0,0 +1,19 @@ +{- | Data type for working with epub package info + + This contains the package section from an epub document. In the + OPF XML document, this tag contains the other tags (metadata, + manifest...) +-} +module Codec.Epub.Data.Package + ( Package (..) + ) + where + + +{- | package tag +-} +data Package = Package + { pkgVersion :: String -- ^ version attribute. This contains which epub specification version (2.x or 3.x) this document conforms to. + , pkgUniqueId :: String -- ^ unique-identifier attribute. This should relate to one metaIdentifier in the Metadata and is intended to represent this book's unique identifier. + } + deriving (Eq, Show) diff --git a/src/lib/Codec/Epub/Data/Spine.hs b/src/lib/Codec/Epub/Data/Spine.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Data/Spine.hs @@ -0,0 +1,27 @@ +{- | Data types for working with the metadata of epub documents + + The spine represents a default ordering of items in the manifest. +-} +module Codec.Epub.Data.Spine + ( Spine (..) + , SpineItemref (..) + ) + where + +import Codec.Epub.Data.Common + + +-- | package\/spine\/itemref tag +data SpineItemref = SpineItemref + { siIdRef :: MFItemId -- ^ idref attribute. Must reference an item in the manifest + , siLinear :: Maybe Bool -- ^ linear attribute + } + deriving (Eq, Show) + + +-- | package\/spine tag +data Spine = Spine + { spineToc :: MFItemId -- ^ toc attribute. Must reference the NCX in the manifest + , spineItemrefs :: [SpineItemref] -- ^ at least one required + } + deriving (Eq, Show) diff --git a/src/lib/Codec/Epub/Format.hs b/src/lib/Codec/Epub/Format.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Format.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE FlexibleInstances #-} + +{- | Module for pretty-printing epub meta-information + + Defined here is the Formattable typeclass and instances for the + top-level epub data structures. The intention is that consumers + use the format function on any of these otherwise disparate types. +-} +module Codec.Epub.Format + ( Formattable (..) + ) + where + +import Codec.Epub.Data.Guide +import Codec.Epub.Data.Manifest +import Codec.Epub.Data.Metadata +import Codec.Epub.Data.Package +import Codec.Epub.Data.Spine +import Codec.Epub.Format.Guide +import Codec.Epub.Format.Manifest +import Codec.Epub.Format.Metadata +import Codec.Epub.Format.Package +import Codec.Epub.Format.Spine + + +class Formattable a where + format :: a -> String + + +instance Formattable [GuideRef] where + format = formatGuide + +instance Formattable Manifest where + format = formatManifest + +instance Formattable Metadata where + format = formatMetadata + +instance Formattable Package where + format = formatPackage + +instance Formattable Spine where + format = formatSpine diff --git a/src/lib/Codec/Epub/Format/Guide.hs b/src/lib/Codec/Epub/Format/Guide.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Format/Guide.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE FlexibleContexts #-} + +{- | Module for pretty-printing epub guide info + + Used internally by Codec.Epub.Format +-} +module Codec.Epub.Format.Guide + ( formatGuide + ) + where + +import Control.Monad.Writer.Lazy +import Data.Foldable ( toList ) +import Text.Printf + +import Codec.Epub.Format.Util +import Codec.Epub.Data.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 + + +{- | Format an epub Guide structure for pretty printing +-} +formatGuide :: [GuideRef] -> String +formatGuide guideRefs = toList . execWriter $ tellGuide guideRefs diff --git a/src/lib/Codec/Epub/Format/Manifest.hs b/src/lib/Codec/Epub/Format/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Format/Manifest.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE FlexibleContexts #-} + +{- | Module for pretty-printing epub manifest info + + Used internally by Codec.Epub.Format +-} +module Codec.Epub.Format.Manifest + ( formatManifest + ) + where + +import Control.Monad.Writer.Lazy +import Data.Foldable ( toList ) +import Text.Printf + +import Codec.Epub.Format.Util +import Codec.Epub.Data.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 + + +{- | Format an epub Manifest structure for pretty printing +-} +formatManifest :: Manifest -> String +formatManifest (Manifest mis) = toList . execWriter + $ tellManifest mis diff --git a/src/lib/Codec/Epub/Format/Metadata.hs b/src/lib/Codec/Epub/Format/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Format/Metadata.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE FlexibleContexts #-} + +{- | Module for pretty-printing epub metadata info + + Used internally by Codec.Epub.Format +-} +module Codec.Epub.Format.Metadata + ( formatMetadata + ) + where + +import Control.Monad.Writer.Lazy +import qualified Data.Foldable as Foldable +import qualified Data.Map.Strict as Map +import Text.Printf + +import Codec.Epub.Format.Util +import Codec.Epub.Data.Metadata + + +tellTitle :: MonadWriter (Seq Char) m => Title -> m () +tellTitle (Title Nothing Nothing Nothing text) = + tellSeq $ printf "title: %s\n" text +tellTitle title = + tellSeq $ printf "title\n%s%s%s%s" + (formatSubline "text" (Just $ titleText title)) + (formatSubline "lang" (titleLang title)) + (formatSubline "title-type" (titleType title)) + (formatSubline "display-seq" (show `fmap` titleSeq title)) + + +tellCreator :: MonadWriter (Seq Char) m => Creator -> m () +tellCreator (Creator Nothing Nothing Nothing creator) = + tellSeq $ printf "creator: %s\n" creator +tellCreator (Creator role fileAs dseq creator) = + tellSeq $ printf "creator\n%s%s%s%s" + (formatSubline "text" (Just creator)) + (formatSubline "file-as" fileAs) + (formatSubline "role" role) + (formatSubline "display-seq" (show `fmap` dseq)) + + +tellContributor :: MonadWriter (Seq Char) m => Creator -> m () +tellContributor (Creator Nothing Nothing Nothing contributor) = + tellSeq $ printf "contributor: %s\n" contributor +tellContributor (Creator role fileAs dseq contributor) = + tellSeq $ printf "contributor\n%s%s%s%s" + (formatSubline "text" (Just contributor)) + (formatSubline "file-as" fileAs) + (formatSubline "role" role) + (formatSubline "display-seq" (show `fmap` dseq)) + + +tellDate :: MonadWriter (Seq Char) m => (DateEvent, DateValue) -> m () +tellDate (event', DateValue date') = + tellSeq $ printf "date\n%s%s" + (formatSubline "event" (Just . dateEventToString $ event')) + (formatSubline "text" (Just date')) + + +tellId :: MonadWriter (Seq Char) m => Identifier -> m () +tellId ident = + tellSeq $ printf "identifier\n%s%s%s%s" + (formatSubline "id" (idId ident)) + (formatSubline "identifier-type" (idType ident)) + (formatSubline "scheme" (idScheme ident)) + (formatSubline "text" (Just . idText $ ident)) + + +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) + + +tellSimpleMbString :: MonadWriter (Seq Char) m => String + -> Maybe String -> m () +tellSimpleMbString _ Nothing = return () +tellSimpleMbString label (Just s) = tellSimpleString label s + + +tellMetadata :: MonadWriter (Seq Char) m => Metadata -> m () +tellMetadata (Metadata ids titles langs contributors creators dates source mType coverage desc format publisher relation rights subjects) = do + mapM_ tellId ids + mapM_ tellTitle titles + mapM_ (tellSimpleString "language") langs + mapM_ tellContributor contributors + mapM_ tellCreator creators + mapM_ tellDate $ Map.toList dates + tellSimpleMbString "source" source + tellSimpleMbString "type" mType + mapM_ (tellSimpleString "coverage") coverage + mapM_ tellDescription desc + mapM_ (tellSimpleString "format") format + mapM_ (tellSimpleString "publisher") publisher + mapM_ (tellSimpleString "relation") relation + mapM_ (tellSimpleString "rights") rights + mapM_ (tellSimpleString "subject") subjects + + +{- | Format an epub Metadata structure for pretty printing +-} +formatMetadata :: Metadata -> String +formatMetadata meta = Foldable.toList . execWriter + $ tellMetadata meta diff --git a/src/lib/Codec/Epub/Format/Package.hs b/src/lib/Codec/Epub/Format/Package.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Format/Package.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE FlexibleContexts #-} + +{- | Module for pretty-printing epub package info + + Used internally by Codec.Epub.Format +-} +module Codec.Epub.Format.Package + ( formatPackage + ) + where + +import Control.Monad.Writer.Lazy +import Data.Foldable ( toList ) + +import Codec.Epub.Data.Package +import Codec.Epub.Format.Util + + +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) + + +{- | Format an epub Package structure for pretty printing +-} +formatPackage :: Package -> String +formatPackage (Package v u) = toList . execWriter + $ tellPackage (v, u) diff --git a/src/lib/Codec/Epub/Format/Spine.hs b/src/lib/Codec/Epub/Format/Spine.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Format/Spine.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE FlexibleContexts #-} + +{- | Module for pretty-printing epub spine info + + Used internally by Codec.Epub.Format +-} +module Codec.Epub.Format.Spine + ( formatSpine + ) + where + +import Control.Monad.Writer.Lazy +import Data.Foldable ( toList ) +import Text.Printf + +import Codec.Epub.Format.Util +import Codec.Epub.Data.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 + + +{- | Format an epub Spine structure for pretty printing +-} +formatSpine :: Spine -> String +formatSpine sp = toList . execWriter + $ tellSpine sp diff --git a/src/lib/Codec/Epub/Format/Util.hs b/src/lib/Codec/Epub/Format/Util.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Format/Util.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | Utility functions shared by several formatting modules +module Codec.Epub.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/lib/Codec/Epub/IO.hs b/src/lib/Codec/Epub/IO.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/IO.hs @@ -0,0 +1,181 @@ +{-# LANGUAGE FlexibleContexts #-} + +-- | Functions for performing some IO operations on epub files + +module Codec.Epub.IO + ( getPkgXmlFromZip + , getPkgPathXmlFromZip + , getPkgPathXmlFromBS + , getPkgPathXmlFromDir + , mkEpubArchive + , readArchive + , writeArchive + ) + where + +import Codec.Archive.Zip +import Control.Arrow.ListArrows ( (>>>), deep ) +import Control.Exception +import Control.Monad.Except +import qualified Data.ByteString.Char8 as BS +import Data.ByteString.Lazy ( fromChunks ) +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.UTF8 as UTF8 +import Data.List ( (\\), isPrefixOf ) +import System.Directory +import System.FilePath +import Text.XML.HXT.Arrow.ReadDocument ( readString ) +import Text.XML.HXT.Arrow.XmlArrow ( getAttrValue, hasName, isElem ) +import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) + +import Codec.Epub.Util + + +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 . UTF8.toString . fromEntry) mbEntry + + +{- | The static location of the container.xml, as specified by the + epub docs +-} +containerPath :: FilePath +containerPath = "META-INF/container.xml" + + +{- | Get the path and contents of the epub Package Document from + a ByteString representing an epub (zip) file +-} +getPkgPathXmlFromBS :: (MonadError String m, MonadIO m) + => BS.ByteString -- ^ contents of the zip file + -> m (FilePath, String) -- ^ path (within the epub archive) and contents of the epub Package Document +getPkgPathXmlFromBS 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. + -} + containerDoc <- fileFromArchive containerPath archive + + let cleanedContents = removeIllegalStartChars . removeEncoding + . removeDoctype $ containerDoc + + rootPath <- locateRootFile containerPath cleanedContents + + -- Now that we have the path to the .opf file, extract it + rootContents <- fileFromArchive rootPath archive + + return (rootPath, rootContents) + + +{- | Get the path and contents of the epub Package Document from + an epub (zip) file +-} +getPkgPathXmlFromZip :: (MonadError String m, MonadIO m) + => FilePath -- ^ path to epub zip file + -> m (FilePath, String) -- ^ path (within the epub archive) and contents of the epub Package Document +getPkgPathXmlFromZip zipPath = do + {- Strictly read this file into a ByteString, send to + getPkgPathXmlFromBS + -} + zipFileBytes <- liftIO $ BS.readFile zipPath + getPkgPathXmlFromBS zipFileBytes + + +-- | Get the contents of the epub Package Document from an epub (zip) file +getPkgXmlFromZip :: (MonadError String m, MonadIO m) + => FilePath -- ^ path to epub zip file + -> m String -- ^ contents of the epub Package Document +getPkgXmlFromZip zipPath = snd `liftM` getPkgPathXmlFromZip zipPath + + +{- | Get the path and contents of the epub Package Document from + a directory containing the files from an epub file (as in: + it's been unzipped into a dir) +-} +getPkgPathXmlFromDir :: (MonadError String m, MonadIO m) + => FilePath -- ^ directory path + -> m (FilePath, String) -- ^ path (within the epub archive) and contents of the epub Package Document +getPkgPathXmlFromDir 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 + + 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) + + +{- 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/lib/Codec/Epub/Parse.hs b/src/lib/Codec/Epub/Parse.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE Arrows, FlexibleContexts #-} + +{- | The main parsing interface, these get* functions are intended + to be used by consumers of this library + + This module is called Parse because it invokes the XML parsing + machinery of this library, but consumers of the library do not + have to interact with HXT, Arrows or XML directly. +-} +module Codec.Epub.Parse + ( getGuide + , getManifest + , getMetadata + , getPackage + , getSpine + ) + where + +import Control.Arrow.ListArrows +import Control.Monad.Except +import Text.XML.HXT.Arrow.Namespace ( propagateNamespaces ) +import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) +import Text.XML.HXT.Arrow.XmlState.TypeDefs +import Text.XML.HXT.Arrow.ReadDocument ( readString ) +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub.Data.Guide +import Codec.Epub.Data.Manifest +import Codec.Epub.Data.Metadata +import Codec.Epub.Data.Package +import Codec.Epub.Data.Spine +import Codec.Epub.Parse.Guide +import Codec.Epub.Parse.Manifest +import Codec.Epub.Parse.Metadata +import Codec.Epub.Parse.Package +import Codec.Epub.Parse.Refinements +import Codec.Epub.Parse.Spine +import Codec.Epub.Util + + +{- Extract the epub OPF Package data contained in the supplied + XML string +-} +performParse :: (MonadIO m, MonadError String m) => + IOSLA (XIOState ()) XmlTree b -> String -> m b +performParse parser 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 + >>> parser + ) + + case result of + (r : []) -> return r + _ -> throwError + "ERROR: FIXME with a better message" + + +{- | Parse epub guide items from a String representing the epub XML + Package Document +-} +getGuide :: (MonadIO m, MonadError String m) => + String -> m [GuideRef] +getGuide = performParse guideP + + +{- | Parse epub manifest data from a String representing the epub XML + Package Document +-} +getManifest :: (MonadIO m, MonadError String m) => + String -> m Manifest +getManifest = performParse manifestP + + +{- | Parse epub metadata from a String representing the epub XML + Package Document +-} +{- Parsing the metadata is a two-pass process + First we need to parse the meta tags only, referred to in this + code as 'refinements.' + Second we parse the metadata tags themselves, passing in the + refinements so their info can be merged during parse +-} +getMetadata :: (MonadIO m, MonadError String m) => + String -> m Metadata +getMetadata opfContents = do + refinements <- performParse refinementsP opfContents + rawMd <- performParse (metadataP refinements) opfContents + return rawMd + + +{- | Parse epub package info from a String representing the epub XML + Package Document +-} +getPackage :: (MonadIO m, MonadError String m) => + String -> m Package +getPackage = performParse packageP + + +{- | Parse epub spine info from a String representing the epub XML + Package Document +-} +getSpine :: (MonadIO m, MonadError String m) => + String -> m Spine +getSpine = performParse spineP diff --git a/src/lib/Codec/Epub/Parse/Guide.hs b/src/lib/Codec/Epub/Parse/Guide.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse/Guide.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE Arrows #-} + +-- | Parsing for the guide section of the OPF Package XML Document +module Codec.Epub.Parse.Guide + ( guideP + ) + where + +import Control.Arrow.ListArrows +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub.Data.Guide +import Codec.Epub.Parse.Util + + +guideRefP :: (ArrowXml a) => a (NTree XNode) GuideRef +guideRefP = atQTag (opfName "reference") >>> + proc x -> do + t <- getAttrValue "type" -< x + mt <- mbGetAttrValue "title" -< x + h <- getAttrValue "href" -< x + returnA -< GuideRef t mt h + + +guideP :: (ArrowXml a) => a (NTree XNode) [GuideRef] +guideP = (atQTag (opfName "guide") >>> listA guideRefP) + `orElse` constA [] diff --git a/src/lib/Codec/Epub/Parse/Manifest.hs b/src/lib/Codec/Epub/Parse/Manifest.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse/Manifest.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE Arrows #-} + +-- | Parsing for the manifest section of the OPF Package XML Document +module Codec.Epub.Parse.Manifest + ( manifestP + ) + where + +import Control.Arrow.ListArrows +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub.Data.Manifest +import Codec.Epub.Parse.Util + + +manifestItemP :: (ArrowXml a) => a (NTree XNode) ManifestItem +manifestItemP= atQTag (opfName "item") >>> + proc x -> do + i <- getAttrValue "id" -< x + h <- getAttrValue "href" -< x + m <- getAttrValue "media-type" -< x + returnA -< ManifestItem i h m + + +manifestP :: (ArrowXml a) => a (NTree XNode) Manifest +manifestP = atQTag (opfName "manifest") >>> + proc x -> do + l <- listA manifestItemP -< x + returnA -< Manifest l diff --git a/src/lib/Codec/Epub/Parse/Metadata.hs b/src/lib/Codec/Epub/Parse/Metadata.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse/Metadata.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE Arrows #-} + +-- | Parsing for the metadata section of the OPF Package XML Document +module Codec.Epub.Parse.Metadata + ( metadataP + ) + where + +import Control.Applicative +import Control.Arrow.ListArrows +import Data.List ( isPrefixOf ) +import qualified Data.Map.Strict as Map +import Data.Maybe ( catMaybes ) +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub.Data.Metadata +import Codec.Epub.Parse.Util + + +idP :: (ArrowXml a) => a (NTree XNode) Identifier +idP = atQTag (dcName "identifier") >>> ( unwrapArrow $ Identifier + <$> (WrapArrow $ mbGetAttrValue "id") + <*> (WrapArrow $ constA Nothing) + <*> (WrapArrow $ mbGetQAttrValue (opfName "scheme")) -- An attr in epub2 + <*> (WrapArrow $ text) + ) + + +titleP :: (ArrowXml a) => a (NTree XNode) (String, Title) +titleP = atQTag (dcName "title") >>> + proc x -> do + i <- mbGetAttrValue "id" -< x + l <- mbGetQAttrValue (xmlName "lang") -< x + c <- text -< x + returnA -< ((maybe "" id i), Title l Nothing Nothing c) + + +langP :: (ArrowXml a) => a (NTree XNode) String +langP = atQTag (dcName "language") >>> text + + +{- Since creators and contributors have the same exact XML structure, + this arrow is used to get either of them +-} +creatorP :: (ArrowXml a) => String -> a (NTree XNode) (String, Creator) +creatorP tag = atQTag (dcName tag) >>> + proc x -> do + i <- mbGetAttrValue "id" -< x + r <- mbGetQAttrValue (opfName "role") -< x + f <- mbGetQAttrValue (opfName "file-as") -< x + t <- text -< x + returnA -< ((maybe "" id i), Creator r f Nothing t) + + +dateElemP :: (ArrowXml a) => a (NTree XNode) (Maybe (DateEvent, DateValue)) +dateElemP = atQTag (dcName "date") >>> + proc x -> do + e <- mbGetQAttrValue (opfName "event") -< x + c <- text -< x + returnA -< (, DateValue c) <$> dateEventFromString e + + +dateMetaP :: (ArrowXml a) => a (NTree XNode) (Maybe (DateEvent, DateValue)) +dateMetaP = atQTag (opfName "meta") >>> + proc x -> do + e <- mbGetAttrValue "property" <<< hasAttrValue "property" (isPrefixOf "dcterms:") -< x + c <- text -< x + returnA -< (, DateValue c) <$> dateEventFromString e + + +sourceP :: (ArrowXml a) => a (NTree XNode) (Maybe String) +sourceP = mbQTagText $ dcName "source" + + +typeP :: (ArrowXml a) => a (NTree XNode) (Maybe String) +typeP = mbQTagText $ dcName "type" + + +coverageP :: (ArrowXml a) => a (NTree XNode) String +coverageP = atQTag (dcName "coverage") >>> text + + +descriptionP :: (ArrowXml a) => a (NTree XNode) Description +descriptionP = atQTag (dcName "description") >>> + proc x -> do + l <- mbGetQAttrValue (xmlName "lang") -< x + c <- text -< x + returnA -< Description l c + + +formatP :: (ArrowXml a) => a (NTree XNode) String +formatP = atQTag (dcName "format") >>> text + + +publisherP :: (ArrowXml a) => a (NTree XNode) String +publisherP = atQTag (dcName "publisher") >>> text + + +relationP :: (ArrowXml a) => a (NTree XNode) String +relationP = atQTag (dcName "relation") >>> text + + +rightsP :: (ArrowXml a) => a (NTree XNode) String +rightsP = atQTag (dcName "rights") >>> text + + +subjectP :: (ArrowXml a) => a (NTree XNode) String +subjectP = atQTag (dcName "subject") >>> text + + +metadataP :: (ArrowXml a) => [Refinement] -> a (NTree XNode) Metadata +metadataP refinements = + atQTag (opfName "metadata") >>> ( unwrapArrow $ Metadata + <$> (WrapArrow $ listA $ idP >>. map (refineIdentifier refinements)) + <*> (WrapArrow $ listA $ titleP >>. map (refineTitle refinements)) + <*> (WrapArrow $ listA langP) + <*> (WrapArrow $ listA $ creatorP "contributor" >>. + map (refineCreator refinements)) + <*> (WrapArrow $ listA $ creatorP "creator" >>. + map (refineCreator refinements)) + <*> (Map.fromList . catMaybes <$> (WrapArrow $ listA $ catA [dateElemP, dateMetaP])) + <*> (WrapArrow sourceP) + <*> (WrapArrow typeP) + <*> (WrapArrow $ listA coverageP) + <*> (WrapArrow $ listA descriptionP) + <*> (WrapArrow $ listA formatP) + <*> (WrapArrow $ listA publisherP) + <*> (WrapArrow $ listA relationP) + <*> (WrapArrow $ listA rightsP) + <*> (WrapArrow $ listA subjectP) + ) diff --git a/src/lib/Codec/Epub/Parse/Package.hs b/src/lib/Codec/Epub/Parse/Package.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse/Package.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE Arrows #-} + +-- | Parsing for the package section of the OPF Package XML Document +module Codec.Epub.Parse.Package + ( packageP + ) + where + +import Control.Arrow.ListArrows +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub.Data.Package +import Codec.Epub.Parse.Util + + +packageP :: (ArrowXml a) => a (NTree XNode) Package +packageP = atQTag (opfName "package") >>> + proc x -> do + v <- getAttrValue "version" -< x + u <- getAttrValue "unique-identifier" -< x + returnA -< (Package v u) diff --git a/src/lib/Codec/Epub/Parse/Refinements.hs b/src/lib/Codec/Epub/Parse/Refinements.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse/Refinements.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE Arrows #-} + +{- | Parsing for meta tags in the metadata section of the OPF + Package XML Document +-} +module Codec.Epub.Parse.Refinements + ( refinementsP + ) + where + +import Control.Applicative +import Control.Arrow.ListArrows +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub.Data.Metadata +import Codec.Epub.Parse.Util + + +removeHash :: String -> String +removeHash ('#' : cs) = cs +removeHash s = s + + +refinementP :: (ArrowXml a) => a (NTree XNode) Refinement +refinementP = atQTag (opfName "meta") >>> ( unwrapArrow $ Refinement + <$> (WrapArrow $ mbGetAttrValue "refines" >>^ maybe "" removeHash) + <*> (WrapArrow $ mbGetAttrValue "property" >>^ maybe "" id) + <*> (WrapArrow $ mbGetAttrValue "scheme" >>^ maybe "" id) + <*> (WrapArrow $ text) + ) + + +refinementsP :: (ArrowXml a) => a (NTree XNode) [Refinement] +refinementsP = atQTag (opfName "metadata") >>> listA refinementP diff --git a/src/lib/Codec/Epub/Parse/Spine.hs b/src/lib/Codec/Epub/Parse/Spine.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse/Spine.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE Arrows #-} + +-- | Parsing for the spine section of the OPF Package XML Document +module Codec.Epub.Parse.Spine + ( spineP + ) + where + +import Control.Arrow.ListArrows +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.DOM.TypeDefs + +import Codec.Epub.Data.Spine +import Codec.Epub.Parse.Util + + +spineItemrefP :: (ArrowXml a) => a (NTree XNode) SpineItemref +spineItemrefP = 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 + + +spineP :: (ArrowXml a) => a (NTree XNode) Spine +spineP = atQTag (opfName "spine") >>> + proc x -> do + i <- getAttrValue "toc" -< x + l <- listA spineItemrefP -< x + returnA -< (Spine i l) diff --git a/src/lib/Codec/Epub/Parse/Util.hs b/src/lib/Codec/Epub/Parse/Util.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Parse/Util.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE Arrows #-} + +-- | Helper functions used by the other parsing modules +module Codec.Epub.Parse.Util + ( atQTag + , mbQTagText + , mbGetAttrValue + , mbGetQAttrValue + , notNullA + , text + , dcName + , opfName + , xmlName + ) + where + +import Control.Arrow.ListArrows +import Data.Tree.NTree.TypeDefs ( NTree ) +import Text.XML.HXT.Arrow.XmlArrow +import Text.XML.HXT.DOM.TypeDefs + + +-- 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) +-} + + +{- | Shortcut arrow to drill down to a specific namespaced child + element +-} +atQTag :: (ArrowXml a) => QName -> a (NTree XNode) XmlTree +atQTag tag = deep (isElem >>> hasQName tag) + + +-- | Shortcut arrow to gather up the text part of all child nodes +text :: (ArrowXml a) => a (NTree XNode) String +text = getChildren >>> getText + + +-- | Arrow that succeeds if the input is not the empty list +notNullA :: (ArrowList a) => a [b] [b] +notNullA = isA $ not . null + + +{- | Shortcut arrow to retrieve the contents of a namespaced element + as a Maybe String +-} +mbQTagText :: (ArrowXml a) => QName -> a (NTree XNode) (Maybe String) +mbQTagText tag = + ( atQTag tag >>> + text >>> notNullA >>^ Just ) + `orElse` + (constA Nothing) + + +{- | Shortcut arrow to retrieve an attribute of an element as a + Maybe String +-} +mbGetAttrValue :: (ArrowXml a) => + String -> a XmlTree (Maybe String) +mbGetAttrValue n = + (getAttrValue n >>> notNullA >>^ Just) + `orElse` (constA Nothing) + + +{- | Shortcut arrow to retrieve an attribute of a namespaced element + as a Maybe String +-} +mbGetQAttrValue :: (ArrowXml a) => + QName -> a XmlTree (Maybe String) +mbGetQAttrValue qn = + (getQAttrValue qn >>> notNullA >>^ Just) + `orElse` (constA Nothing) + + +-- | Construct a qualified name in the Dublin Core namespace +dcName :: String -> QName +dcName local = mkQName "dc" local "http://purl.org/dc/elements/1.1/" + + +-- | Construct a qualified name in the epub OPF namespace +opfName :: String -> QName +opfName local = mkQName "opf" local "http://www.idpf.org/2007/opf" + + +-- | Construct a qualified name in the XML namespace +xmlName :: String -> QName +xmlName local = mkQName "xml" local "http://www.w3.org/XML/1998/namespace" diff --git a/src/lib/Codec/Epub/Util.hs b/src/lib/Codec/Epub/Util.hs new file mode 100644 --- /dev/null +++ b/src/lib/Codec/Epub/Util.hs @@ -0,0 +1,27 @@ +{- | Utility functions shared by modules that need to read the + contents of XML documents. +-} +module Codec.Epub.Util + where + +import Text.Regex + + +{- | 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)) "" diff --git a/src/tests/Archive.hs b/src/tests/Archive.hs new file mode 100644 --- /dev/null +++ b/src/tests/Archive.hs @@ -0,0 +1,66 @@ +module Archive + ( tests ) + where + +import Codec.Archive.Zip +import Control.Monad.Except +import Data.List ( isPrefixOf ) +import Data.Maybe ( listToMaybe ) +import System.Directory +import System.FilePath +import Test.HUnit + +import Codec.Epub.Data.Package +import Codec.Epub.IO +import Codec.Epub.Parse + + +tests :: Test +tests = TestList + [ testMkArchive + , testDamagedZip + , testIllegalCharsBeforeDecl + ] + + +{- Test that the mimetype file is the first Entry in archives we create +-} +testMkArchive :: Test +testMkArchive = TestCase $ do + origDir <- getCurrentDirectory + a <- mkEpubArchive $ "util" "resources" "bookfiles" + setCurrentDirectory origDir + let maybeFirstFile = listToMaybe . filesInArchive $ a + + assertEqual "mimetype file is FIRST" (Just "mimetype") maybeFirstFile + + +{- 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 = TestCase $ do + let label = "damaged zip" + let expectedErrorPrefix = "Data.Binary.Get.runGet at position 138: Did not find end of central directory signature" + actual <- runExceptT $ getPkgXmlFromZip $ "util" "resources" + "damagedZipCentralDir.epub" + case actual of + Left actualMessage -> assertBool label $ isPrefixOf expectedErrorPrefix actualMessage + Right _ -> assertFailure label + + +{- 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 $ + "util" "resources" "testIllegalCharsBeforeDecl.opf" + actual <- runExceptT $ getPackage xmlString + let expected = + Right Package {pkgVersion = "2.0", pkgUniqueId = "uuid_id"} + assertEqual "illegal chars before XML declaration" expected actual diff --git a/src/tests/Epub2/ParseGuide.hs b/src/tests/Epub2/ParseGuide.hs new file mode 100644 --- /dev/null +++ b/src/tests/Epub2/ParseGuide.hs @@ -0,0 +1,48 @@ +module Epub2.ParseGuide + ( tests ) + where + +import Control.Monad.Except +import System.FilePath +import Test.HUnit + +import Codec.Epub.Data.Guide +import Codec.Epub.Parse + + +tests :: Test +tests = TestList + [ testFull + , testMinimal + ] + + +{- A test containing a couple of guide ref items +-} +testFull :: Test +testFull = TestCase $ do + xmlString <- readFile $ "util" "resources" "epub2-full.opf" + actual <- runExceptT $ getGuide xmlString + let expected = + Right [ 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 "some guide items" expected actual + + +{- Minimal guide +-} +testMinimal :: Test +testMinimal = TestCase $ do + xmlString <- liftIO $ readFile $ "util" "resources" "epub2-minimal.opf" + actual <- runExceptT $ getGuide xmlString + let expected = Right [] + assertEqual "minimal guide" expected actual diff --git a/src/tests/Epub2/ParseMetadata.hs b/src/tests/Epub2/ParseMetadata.hs new file mode 100644 --- /dev/null +++ b/src/tests/Epub2/ParseMetadata.hs @@ -0,0 +1,148 @@ +module Epub2.ParseMetadata + ( tests ) + where + +import Control.Monad.Except +import qualified Data.Map.Strict as Map +import System.FilePath +import Test.HUnit + +import Codec.Epub.Data.Metadata +import Codec.Epub.Parse + + +tests :: Test +tests = TestList + [ testFull + , testMinimal + , testMissingAll + ] + + +{- 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 $ "util" "resources" "epub2-full.opf" + actual <- runExceptT $ getMetadata xmlString + let expected = + Right Metadata + { metaTitles = + [ Title Nothing Nothing Nothing "Title Of This Book" + , Title (Just "fr") Nothing Nothing "Titre De Ce Livre" + ] + , metaCreators = + [ Creator + (Just "aut") + (Just "Wiggins, Josephine B.") + Nothing + "Josephine B. Wiggins" + , Creator + (Just "aut") + (Just "Dicker, Joël") + Nothing + "Joël Dicker" + , Creator + (Just "aut") + Nothing + Nothing + "Horatio Cromwell" + , Creator + Nothing + Nothing + Nothing + "Natalia Jenkins" + ] + , metaContributors = + [ Creator + (Just "ill") + (Just "Knickerbocker, Reginald Q.") + Nothing + "Reginald Q. Knickerbocker" + , Creator + (Just "edt") + Nothing + 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 = Map.fromList + [ (Issued, DateValue "2010") + , (Created, DateValue "2010-05-07") + , (Epub, DateValue "2009") + ] + , metaType = Just "test OPF Package Document" + , metaFormats = + [ "ePub publication" + , "an additional format" + ] + , metaIds = + [ Identifier (Just "isbn") Nothing (Just "ISBN") "1-82057-821-9" + , Identifier (Just "other") Nothing Nothing "1386506873266" + ] + , metaSource = Just "document source" + , metaLangs = ["en-US", "en-UK"] + , metaRelations = + [ "document relation" + , "an additional relation" + ] + , metaCoverages = + [ "coverage information" + , "an additional coverage" + ] + , metaRights = + [ "Copyright: 2010 Dino Morelli, License: ISC" + , "an additional rights" + ] + } + assertEqual "epub2 - 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 $ "util" "resources" "epub2-minimal.opf" + actual <- runExceptT $ getMetadata xmlString + let expected = + Right Metadata + { metaTitles = [Title Nothing Nothing Nothing + "Title Of This Book"] + , metaCreators = [] + , metaContributors = [] + , metaSubjects = [] + , metaDescriptions = [] + , metaPublishers = [] + , metaDates = Map.empty + , metaType = Nothing + , metaFormats = [] + , metaIds = [Identifier (Just "isbn") Nothing + (Just "ISBN") "1-82057-821-9"] + , metaSource = Nothing + , metaLangs = ["en-us"] + , metaRelations = [] + , metaCoverages = [] + , metaRights = [] + } + 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 $ "util" "resources" "epub2-missingAll.opf" + actual <- runExceptT $ getMetadata xmlString + let expected = Right emptyMetadata + assertEqual "missing all" expected actual diff --git a/src/tests/Epub3/ParseMetadata.hs b/src/tests/Epub3/ParseMetadata.hs new file mode 100644 --- /dev/null +++ b/src/tests/Epub3/ParseMetadata.hs @@ -0,0 +1,103 @@ +module Epub3.ParseMetadata + ( tests ) + where + +import Control.Monad.Except +import qualified Data.Map.Strict as Map +import System.FilePath +import Test.HUnit + +import Codec.Epub.Data.Metadata +import Codec.Epub.Parse + + +tests :: Test +tests = TestList + [ testFull + ] + + +{- 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 $ "util" "resources" "epub3-full.opf" + actual <- runExceptT $ getMetadata xmlString + let expected = + Right Metadata + { metaIds = + [ Identifier (Just "isbn") Nothing Nothing "1-82057-821-9" + , Identifier (Just "other") (Just "some-type") + (Just "some-scheme") "1386506873266" + ] + , metaTitles = + [ Title Nothing (Just "main") (Just 1) "Title Of This Book" + , Title Nothing (Just "subtitle") (Just 2) "The Subtitle" + , Title (Just "fr") Nothing Nothing "Titre De Ce Livre" + ] + , metaLangs = ["en-US", "en-UK"] + , metaContributors = + [ Creator + (Just "ill") + (Just "Knickerbocker, Reginald Q.") + Nothing + "Reginald Q. Knickerbocker" + , Creator + (Just "edt") + Nothing + Nothing + "Beverly Abercrombie" + ] + , metaCreators = + [ Creator + (Just "aut") + (Just "Wiggins, Josephine B.") + (Just 2) + "Josephine B. Wiggins" + , Creator + (Just "aut") + Nothing + (Just 1) + "Horatio Cromwell" + , Creator + Nothing + Nothing + (Just 3) + "Natalia Jenkins" + ] + , metaDates = Map.fromList + [ (Issued, DateValue "2011") + , (Epub, DateValue "2012") + , (Modified, DateValue "2013-08-31T13:06:32Z") + ] + , metaSource = Just "document source" + , metaType = Just "test OPF Package Document" + , metaCoverages = + [ "coverage information" + , "an additional coverage" + ] + , 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" + ] + , metaFormats = + [ "ePub publication" + , "an additional format" + ] + , metaPublishers = + [ "Fictional Books Ltd." + , "An additional publisher" + ] + , metaRelations = + [ "document relation" + , "an additional relation" + ] + , metaSubjects = ["Fiction","Science Fiction"] + , metaRights = + [ "Copyright: 2010 Dino Morelli, License: ISC" + , "an additional rights" + ] + } + + assertEqual "epub3 - very full" expected actual diff --git a/src/tests/ParseManifest.hs b/src/tests/ParseManifest.hs new file mode 100644 --- /dev/null +++ b/src/tests/ParseManifest.hs @@ -0,0 +1,54 @@ +module ParseManifest + ( tests ) + where + +import Control.Monad.Except +import System.FilePath +import Test.HUnit + +import Codec.Epub.Data.Manifest +import Codec.Epub.Parse + + +tests :: Test +tests = TestList + [ testSeveral + , testMissing + ] + + +{- A fairly comprehensive test containing several manifest items +-} +testSeveral :: Test +testSeveral = TestCase $ do + xmlString <- readFile $ "util" "resources" "epub2-full.opf" + actual <- runExceptT $ getManifest xmlString + let expected = + Right $ Manifest [ 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" + } + ] + assertEqual "several manifest items" expected actual + + +{- Test data devoid of any manifest items +-} +testMissing :: Test +testMissing = TestCase $ do + xmlString <- readFile $ "util" "resources" "epub2-missingAll.opf" + actual <- runExceptT $ getManifest xmlString + let expected = + Right $ Manifest [] + assertEqual "missing entirely" expected actual diff --git a/src/tests/ParsePackage.hs b/src/tests/ParsePackage.hs new file mode 100644 --- /dev/null +++ b/src/tests/ParsePackage.hs @@ -0,0 +1,30 @@ +module ParsePackage + ( tests ) + where + +import Control.Monad.Except +import System.FilePath +import Test.HUnit + +import Codec.Epub.Data.Package +import Codec.Epub.Parse + + +tests :: Test +tests = TestList + [ testEpub2 + ] + + +{- Test reading the package info for an EPUB2 document +-} +testEpub2 :: Test +testEpub2 = TestCase $ do + xmlString <- liftIO $ readFile $ "util" "resources" "epub2-minimal.opf" + actual <- runExceptT $ getPackage xmlString + let expected = + Right Package + { pkgVersion = "2.0" + , pkgUniqueId = "isbn" + } + assertEqual "epub2 package info" expected actual diff --git a/src/tests/ParseSpine.hs b/src/tests/ParseSpine.hs new file mode 100644 --- /dev/null +++ b/src/tests/ParseSpine.hs @@ -0,0 +1,55 @@ +module ParseSpine + ( tests ) + where + +import Control.Monad.Except +import System.FilePath +import Test.HUnit + +import Codec.Epub.Data.Spine +import Codec.Epub.Parse + + +tests :: Test +tests = TestList + [ testFull + , testMinimal + , testMissingAll + ] + + +{- A test containing a couple of spine items +-} +testFull :: Test +testFull = TestCase $ do + xmlString <- readFile $ "util" "resources" "epub2-full.opf" + actual <- runExceptT $ getSpine xmlString + let expected = + Right Spine + { spineToc = "ncx" + , spineItemrefs = + [ SpineItemref {siIdRef = "titlePage", siLinear = Nothing} + , SpineItemref {siIdRef = "someContent", siLinear = Nothing} + ] + } + assertEqual "some spine items" expected actual + + +{- Minimal spine, only the spineToc is required +-} +testMinimal :: Test +testMinimal = TestCase $ do + xmlString <- liftIO $ readFile $ "util" "resources" "epub2-minimal.opf" + actual <- runExceptT $ getSpine xmlString + let expected = Right Spine {spineToc = "ncx", spineItemrefs = []} + assertEqual "minimal" expected actual + + +{- Missing any spine info at all +-} +testMissingAll :: Test +testMissingAll = TestCase $ do + xmlString <- readFile $ "util" "resources" "epub2-missingAll.opf" + actual <- runExceptT $ getSpine xmlString + let expected = Right Spine {spineToc = "", spineItemrefs = []} + assertEqual "missing all" expected actual diff --git a/src/tests/test-main.hs b/src/tests/test-main.hs new file mode 100644 --- /dev/null +++ b/src/tests/test-main.hs @@ -0,0 +1,37 @@ +import System.Exit +import Test.HUnit hiding ( counts ) + +import qualified Archive +import qualified Epub2.ParseGuide +import qualified Epub2.ParseMetadata +import qualified Epub3.ParseMetadata +import qualified ParsePackage +import qualified ParseManifest +import qualified ParseSpine + + +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 + , Epub2.ParseGuide.tests + , Epub2.ParseMetadata.tests + , Epub3.ParseMetadata.tests + , ParsePackage.tests + , ParseManifest.tests + , ParseSpine.tests + ] diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,3 @@ -resolver: lts-7.3 +resolver: lts-20.12 packages: - '.' diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,12 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + sha256: af5d667f6096e535b9c725a72cffe0f6c060e0568d9f9eeda04caee70d0d9d2d + size: 649133 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/12.yaml + original: lts-20.12 diff --git a/testsuite/Archive.hs b/testsuite/Archive.hs deleted file mode 100644 --- a/testsuite/Archive.hs +++ /dev/null @@ -1,68 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module Archive - ( tests ) - where - -import Codec.Archive.Zip -import Control.Monad.Except -import Data.List ( isPrefixOf ) -import System.Directory -import System.FilePath -import Test.HUnit - -import Codec.Epub.Data.Package -import Codec.Epub.IO -import Codec.Epub.Parse - - -tests :: Test -tests = TestList - [ testMkArchive - , testDamagedZip - , testIllegalCharsBeforeDecl - ] - - -{- 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 - - -{- 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 = TestCase $ do - let label = "damaged zip" - let expectedErrorPrefix = "Data.Binary.Get.runGet at position 138: Did not find end of central directory signature" - actual <- runExceptT $ getPkgXmlFromZip $ "testsuite" - "damagedZipCentralDir.epub" - case actual of - Left actualMessage -> assertBool label $ isPrefixOf expectedErrorPrefix actualMessage - Right _ -> assertFailure label - - -{- 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 <- runExceptT $ getPackage xmlString - let expected = - Right Package {pkgVersion = "2.0", pkgUniqueId = "uuid_id"} - assertEqual "illegal chars before XML declaration" expected actual diff --git a/testsuite/Epub2/ParseGuide.hs b/testsuite/Epub2/ParseGuide.hs deleted file mode 100644 --- a/testsuite/Epub2/ParseGuide.hs +++ /dev/null @@ -1,51 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module Epub2.ParseGuide - ( tests ) - where - -import Control.Monad.Except -import System.FilePath -import Test.HUnit - -import Codec.Epub.Data.Guide -import Codec.Epub.Parse - - -tests :: Test -tests = TestList - [ testFull - , testMinimal - ] - - -{- A test containing a couple of guide ref items --} -testFull :: Test -testFull = TestCase $ do - xmlString <- readFile $ "testsuite" "epub2-full.opf" - actual <- runExceptT $ getGuide xmlString - let expected = - Right [ 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 "some guide items" expected actual - - -{- Minimal guide --} -testMinimal :: Test -testMinimal = TestCase $ do - xmlString <- liftIO $ readFile $ "testsuite" "epub2-minimal.opf" - actual <- runExceptT $ getGuide xmlString - let expected = Right [] - assertEqual "minimal guide" expected actual diff --git a/testsuite/Epub2/ParseMetadata.hs b/testsuite/Epub2/ParseMetadata.hs deleted file mode 100644 --- a/testsuite/Epub2/ParseMetadata.hs +++ /dev/null @@ -1,153 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module Epub2.ParseMetadata - ( tests ) - where - -import Control.Monad.Except -import System.FilePath -import Test.HUnit - -import Codec.Epub.Data.Metadata -import Codec.Epub.Parse - - -tests :: Test -tests = TestList - [ testFull - , testMinimal - , testMissingAll - ] - - -{- 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" "epub2-full.opf" - actual <- runExceptT $ getMetadata xmlString - let expected = - Right Metadata - { metaTitles = - [ Title Nothing Nothing Nothing "Title Of This Book" - , Title (Just "fr") Nothing Nothing "Titre De Ce Livre" - ] - , metaCreators = - [ Creator - (Just "aut") - (Just "Wiggins, Josephine B.") - Nothing - "Josephine B. Wiggins" - , Creator - (Just "aut") - (Just "Dicker, Joël") - Nothing - "Joël Dicker" - , Creator - (Just "aut") - Nothing - Nothing - "Horatio Cromwell" - , Creator - Nothing - Nothing - Nothing - "Natalia Jenkins" - ] - , metaContributors = - [ Creator - (Just "ill") - (Just "Knickerbocker, Reginald Q.") - Nothing - "Reginald Q. Knickerbocker" - , Creator - (Just "edt") - Nothing - 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" - ] - , metaModified = Nothing - , metaType = Just "test OPF Package Document" - , metaFormats = - [ "ePub publication" - , "an additional format" - ] - , metaIds = - [ Identifier (Just "isbn") Nothing (Just "ISBN") "1-82057-821-9" - , Identifier (Just "other") Nothing Nothing "1386506873266" - ] - , metaSource = Just "document 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" - ] - } - assertEqual "epub2 - 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" "epub2-minimal.opf" - actual <- runExceptT $ getMetadata xmlString - let expected = - Right Metadata - { metaTitles = [Title Nothing Nothing Nothing - "Title Of This Book"] - , metaCreators = [] - , metaContributors = [] - , metaSubjects = [] - , metaDescriptions = [] - , metaPublishers = [] - , metaDates = [] - , metaModified = Nothing - , metaType = Nothing - , metaFormats = [] - , metaIds = [Identifier (Just "isbn") Nothing - (Just "ISBN") "1-82057-821-9"] - , metaSource = Nothing - , metaLangs = ["en-us"] - , metaRelations = [] - , metaCoverages = [] - , metaRights = [] - } - 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" "epub2-missingAll.opf" - actual <- runExceptT $ getMetadata xmlString - let expected = Right emptyMetadata - assertEqual "missing all" expected actual diff --git a/testsuite/Epub3/ParseMetadata.hs b/testsuite/Epub3/ParseMetadata.hs deleted file mode 100644 --- a/testsuite/Epub3/ParseMetadata.hs +++ /dev/null @@ -1,102 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module Epub3.ParseMetadata - ( tests ) - where - -import Control.Monad.Except -import System.FilePath -import Test.HUnit - -import Codec.Epub.Data.Metadata -import Codec.Epub.Parse - - -tests :: Test -tests = TestList - [ testFull - ] - - -{- 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" "epub3-full.opf" - actual <- runExceptT $ getMetadata xmlString - let expected = - Right Metadata - { metaIds = - [ Identifier (Just "isbn") Nothing Nothing "1-82057-821-9" - , Identifier (Just "other") (Just "some-type") - (Just "some-scheme") "1386506873266" - ] - , metaTitles = - [ Title Nothing (Just "main") (Just 1) "Title Of This Book" - , Title Nothing (Just "subtitle") (Just 2) "The Subtitle" - , Title (Just "fr") Nothing Nothing "Titre De Ce Livre" - ] - , metaLangs = ["en-US", "en-UK"] - , metaContributors = - [ Creator - (Just "ill") - (Just "Knickerbocker, Reginald Q.") - Nothing - "Reginald Q. Knickerbocker" - , Creator - (Just "edt") - Nothing - Nothing - "Beverly Abercrombie" - ] - , metaCreators = - [ Creator - (Just "aut") - (Just "Wiggins, Josephine B.") - (Just 2) - "Josephine B. Wiggins" - , Creator - (Just "aut") - Nothing - (Just 1) - "Horatio Cromwell" - , Creator - Nothing - Nothing - (Just 3) - "Natalia Jenkins" - ] - , metaDates = [ Date Nothing "2012" ] - , metaModified = Just "2013-08-31T13:06:32Z" - , metaSource = Just "document source" - , metaType = Just "test OPF Package Document" - , metaCoverages = - [ "coverage information" - , "an additional coverage" - ] - , 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" - ] - , metaFormats = - [ "ePub publication" - , "an additional format" - ] - , metaPublishers = - [ "Fictional Books Ltd." - , "An additional publisher" - ] - , metaRelations = - [ "document relation" - , "an additional relation" - ] - , metaSubjects = ["Fiction","Science Fiction"] - , metaRights = - [ "Copyright: 2010 Dino Morelli, License: BSD3" - , "an additional rights" - ] - } - - assertEqual "epub3 - very full" expected actual diff --git a/testsuite/ParseManifest.hs b/testsuite/ParseManifest.hs deleted file mode 100644 --- a/testsuite/ParseManifest.hs +++ /dev/null @@ -1,57 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module ParseManifest - ( tests ) - where - -import Control.Monad.Except -import System.FilePath -import Test.HUnit - -import Codec.Epub.Data.Manifest -import Codec.Epub.Parse - - -tests :: Test -tests = TestList - [ testSeveral - , testMissing - ] - - -{- A fairly comprehensive test containing several manifest items --} -testSeveral :: Test -testSeveral = TestCase $ do - xmlString <- readFile $ "testsuite" "epub2-full.opf" - actual <- runExceptT $ getManifest xmlString - let expected = - Right $ Manifest [ 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" - } - ] - assertEqual "several manifest items" expected actual - - -{- Test data devoid of any manifest items --} -testMissing :: Test -testMissing = TestCase $ do - xmlString <- readFile $ "testsuite" "epub2-missingAll.opf" - actual <- runExceptT $ getManifest xmlString - let expected = - Right $ Manifest [] - assertEqual "missing entirely" expected actual diff --git a/testsuite/ParsePackage.hs b/testsuite/ParsePackage.hs deleted file mode 100644 --- a/testsuite/ParsePackage.hs +++ /dev/null @@ -1,33 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module ParsePackage - ( tests ) - where - -import Control.Monad.Except -import System.FilePath -import Test.HUnit - -import Codec.Epub.Data.Package -import Codec.Epub.Parse - - -tests :: Test -tests = TestList - [ testEpub2 - ] - - -{- Test reading the package info for an EPUB2 document --} -testEpub2 :: Test -testEpub2 = TestCase $ do - xmlString <- liftIO $ readFile $ "testsuite" "epub2-minimal.opf" - actual <- runExceptT $ getPackage xmlString - let expected = - Right Package - { pkgVersion = "2.0" - , pkgUniqueId = "isbn" - } - assertEqual "epub2 package info" expected actual diff --git a/testsuite/ParseSpine.hs b/testsuite/ParseSpine.hs deleted file mode 100644 --- a/testsuite/ParseSpine.hs +++ /dev/null @@ -1,58 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module ParseSpine - ( tests ) - where - -import Control.Monad.Except -import System.FilePath -import Test.HUnit - -import Codec.Epub.Data.Spine -import Codec.Epub.Parse - - -tests :: Test -tests = TestList - [ testFull - , testMinimal - , testMissingAll - ] - - -{- A test containing a couple of spine items --} -testFull :: Test -testFull = TestCase $ do - xmlString <- readFile $ "testsuite" "epub2-full.opf" - actual <- runExceptT $ getSpine xmlString - let expected = - Right Spine - { spineToc = "ncx" - , spineItemrefs = - [ SpineItemref {siIdRef = "titlePage", siLinear = Nothing} - , SpineItemref {siIdRef = "someContent", siLinear = Nothing} - ] - } - assertEqual "some spine items" expected actual - - -{- Minimal spine, only the spineToc is required --} -testMinimal :: Test -testMinimal = TestCase $ do - xmlString <- liftIO $ readFile $ "testsuite" "epub2-minimal.opf" - actual <- runExceptT $ getSpine xmlString - let expected = Right Spine {spineToc = "ncx", spineItemrefs = []} - assertEqual "minimal" expected actual - - -{- Missing any spine info at all --} -testMissingAll :: Test -testMissingAll = TestCase $ do - xmlString <- readFile $ "testsuite" "epub2-missingAll.opf" - actual <- runExceptT $ getSpine xmlString - let expected = Right Spine {spineToc = "", spineItemrefs = []} - assertEqual "missing all" expected actual diff --git a/testsuite/bookfiles/content/bar b/testsuite/bookfiles/content/bar deleted file mode 100644 --- a/testsuite/bookfiles/content/bar +++ /dev/null diff --git a/testsuite/bookfiles/foo b/testsuite/bookfiles/foo deleted file mode 100644 --- a/testsuite/bookfiles/foo +++ /dev/null diff --git a/testsuite/bookfiles/mimetype b/testsuite/bookfiles/mimetype deleted file mode 100644 --- a/testsuite/bookfiles/mimetype +++ /dev/null diff --git a/testsuite/damagedZipCentralDir.epub b/testsuite/damagedZipCentralDir.epub deleted file mode 100644 Binary files a/testsuite/damagedZipCentralDir.epub and /dev/null differ diff --git a/testsuite/epub2-full.opf b/testsuite/epub2-full.opf deleted file mode 100644 --- a/testsuite/epub2-full.opf +++ /dev/null @@ -1,68 +0,0 @@ - - - - Title Of This Book - Titre De Ce Livre - Josephine B. Wiggins - Joël Dicker - Horatio Cromwell - Natalia Jenkins - 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-UK - Fictional Books Ltd. - An additional publisher - 1386506873266 - Fiction - Science Fiction - test OPF Package Document - ePub publication - an additional format - document source - document relation - an additional relation - coverage information - an additional coverage - Copyright: 2010 Dino Morelli, License: BSD3 - an additional rights - - - - - - - - - - - - - - - - - - - diff --git a/testsuite/epub2-minimal.opf b/testsuite/epub2-minimal.opf deleted file mode 100644 --- a/testsuite/epub2-minimal.opf +++ /dev/null @@ -1,24 +0,0 @@ - - - - Title Of This Book - 1-82057-821-9 - en-us - - - - - - - - - - diff --git a/testsuite/epub2-missingAll.opf b/testsuite/epub2-missingAll.opf deleted file mode 100644 --- a/testsuite/epub2-missingAll.opf +++ /dev/null @@ -1,15 +0,0 @@ - - - - - - - - - - - - diff --git a/testsuite/epub3-full.opf b/testsuite/epub3-full.opf deleted file mode 100644 --- a/testsuite/epub3-full.opf +++ /dev/null @@ -1,97 +0,0 @@ - - - - - - 1-82057-821-9 - 1386506873266 - some-type - - Title Of This Book - main - 1 - The Subtitle - subtitle - 2 - Titre De Ce Livre - - en-US - en-UK - - Reginald Q. Knickerbocker - ill - Knickerbocker, Reginald Q. - Beverly Abercrombie - edt - - Josephine B. Wiggins - aut - Wiggins, Josephine B. - 2 - Horatio Cromwell - aut - 1 - Natalia Jenkins - 3 - - 2012 - - 2013-08-31T13:06:32Z - - document source - - test OPF Package Document - - coverage information - an additional coverage - - 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 - - ePub publication - an additional format - - Fictional Books Ltd. - An additional publisher - - document relation - an additional relation - - Fiction - Science Fiction - - Copyright: 2010 Dino Morelli, License: BSD3 - an additional rights - - - - - - - - - - - - - - - - - - - diff --git a/testsuite/test-main.hs b/testsuite/test-main.hs deleted file mode 100644 --- a/testsuite/test-main.hs +++ /dev/null @@ -1,40 +0,0 @@ --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -import System.Exit -import Test.HUnit hiding ( counts ) - -import qualified Archive -import qualified Epub2.ParseGuide -import qualified Epub2.ParseMetadata -import qualified Epub3.ParseMetadata -import qualified ParsePackage -import qualified ParseManifest -import qualified ParseSpine - - -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 - , Epub2.ParseGuide.tests - , Epub2.ParseMetadata.tests - , Epub3.ParseMetadata.tests - , ParsePackage.tests - , ParseManifest.tests - , ParseSpine.tests - ] diff --git a/testsuite/testIllegalCharsBeforeDecl.opf b/testsuite/testIllegalCharsBeforeDecl.opf deleted file mode 100644 --- a/testsuite/testIllegalCharsBeforeDecl.opf +++ /dev/null @@ -1,18 +0,0 @@ - - - - en - Foo Bar Baz - 1122334455 - - - - - - - - - - diff --git a/util/gentags.sh b/util/gentags.sh deleted file mode 100644 --- a/util/gentags.sh +++ /dev/null @@ -1,3 +0,0 @@ -#! /bin/sh - -find src -regex '.*\..?hs' | xargs hasktags -c diff --git a/util/prefs/boring b/util/prefs/boring deleted file mode 100644 --- a/util/prefs/boring +++ /dev/null @@ -1,124 +0,0 @@ -# This file contains a list of extended regular expressions, one per -# line. A file path matching any of these expressions will be filtered -# out during `darcs add', or when the `--look-for-adds' flag is passed -# to `darcs whatsnew' and `record'. The entries in ~/.darcs/boring (if -# it exists) supplement those in this file. -# -# Blank lines, and lines beginning with an octothorpe (#) are ignored. -# See regex(7) for a description of extended regular expressions. - -### compiler and interpreter intermediate files -# haskell (ghc) interfaces -\.hi$ -\.hi-boot$ -\.o-boot$ -# object files -\.o$ -\.o\.cmd$ -# profiling haskell -\.p_hi$ -\.p_o$ -# haskell program coverage resp. profiling info -\.tix$ -\.prof$ -# fortran module files -\.mod$ -# linux kernel -\.ko\.cmd$ -\.mod\.c$ -(^|/)\.tmp_versions($|/) -# *.ko files aren't boring by default because they might -# be Korean translations rather than kernel modules -# \.ko$ -# python, emacs, java byte code -\.py[co]$ -\.elc$ -\.class$ -# objects and libraries; lo and la are libtool things -\.(obj|a|exe|so|lo|la)$ -# compiled zsh configuration files -\.zwc$ -# Common LISP output files for CLISP and CMUCL -\.(fas|fasl|sparcf|x86f)$ - -### build and packaging systems -# cabal intermediates -\.installed-pkg-config -\.setup-config -# standard cabal build dir, might not be boring for everybody -# ^dist(/|$) -# autotools -(^|/)autom4te\.cache($|/) -(^|/)config\.(log|status)$ -# microsoft web expression, visual studio metadata directories -\_vti_cnf$ -\_vti_pvt$ -# gentoo tools -\.revdep-rebuild.* -# generated dependencies -^\.depend$ - -### version control systems -# cvs -(^|/)CVS($|/) -\.cvsignore$ -# cvs, emacs locks -^\.# -# rcs -(^|/)RCS($|/) -,v$ -# subversion -(^|/)\.svn($|/) -# mercurial -(^|/)\.hg($|/) -# git -(^|/)\.git($|/) -# bzr -\.bzr$ -# sccs -(^|/)SCCS($|/) -# darcs -(^|/)_darcs($|/) -(^|/)\.darcsrepo($|/) -^\.darcs-temp-mail$ --darcs-backup[[:digit:]]+$ -# gnu arch -(^|/)(\+|,) -(^|/)vssver\.scc$ -\.swp$ -(^|/)MT($|/) -(^|/)\{arch\}($|/) -(^|/).arch-ids($|/) -# bitkeeper -(^|/)BitKeeper($|/) -(^|/)ChangeSet($|/) - -### miscellaneous -# backup files -~$ -\.bak$ -\.BAK$ -# patch originals and rejects -\.orig$ -\.rej$ -# X server -\..serverauth.* -# image spam -\# -(^|/)Thumbs\.db$ -# vi, emacs tags -(^|/)(tags|TAGS)$ -#(^|/)\.[^/] -# core dumps -(^|/|\.)core$ -# partial broken files (KIO copy operations) -\.part$ -# waf files, see http://code.google.com/p/waf/ -(^|/)\.waf-[[:digit:].]+-[[:digit:]]+($|/) -(^|/)\.lock-wscript$ -# mac os finder -(^|/)\.DS_Store$ -# emacs saved sessions (desktops) -(^|.*/)\.emacs\.desktop(\.lock)?$ - -(^|/).stack-work($|/) diff --git a/util/resources/bookfiles/content/bar b/util/resources/bookfiles/content/bar new file mode 100644 --- /dev/null +++ b/util/resources/bookfiles/content/bar diff --git a/util/resources/bookfiles/foo b/util/resources/bookfiles/foo new file mode 100644 --- /dev/null +++ b/util/resources/bookfiles/foo diff --git a/util/resources/bookfiles/mimetype b/util/resources/bookfiles/mimetype new file mode 100644 --- /dev/null +++ b/util/resources/bookfiles/mimetype diff --git a/util/resources/damagedZipCentralDir.epub b/util/resources/damagedZipCentralDir.epub new file mode 100644 Binary files /dev/null and b/util/resources/damagedZipCentralDir.epub differ diff --git a/util/resources/epub2-full.opf b/util/resources/epub2-full.opf new file mode 100644 --- /dev/null +++ b/util/resources/epub2-full.opf @@ -0,0 +1,67 @@ + + + + Title Of This Book + Titre De Ce Livre + Josephine B. Wiggins + Joël Dicker + Horatio Cromwell + Natalia Jenkins + 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 + 2009 + en-US + en-UK + Fictional Books Ltd. + An additional publisher + 1386506873266 + Fiction + Science Fiction + test OPF Package Document + ePub publication + an additional format + document source + document relation + an additional relation + coverage information + an additional coverage + Copyright: 2010 Dino Morelli, License: ISC + an additional rights + + + + + + + + + + + + + + + + + + + diff --git a/util/resources/epub2-minimal.opf b/util/resources/epub2-minimal.opf new file mode 100644 --- /dev/null +++ b/util/resources/epub2-minimal.opf @@ -0,0 +1,24 @@ + + + + Title Of This Book + 1-82057-821-9 + en-us + + + + + + + + + + diff --git a/util/resources/epub2-missingAll.opf b/util/resources/epub2-missingAll.opf new file mode 100644 --- /dev/null +++ b/util/resources/epub2-missingAll.opf @@ -0,0 +1,15 @@ + + + + + + + + + + + + diff --git a/util/resources/epub3-full.opf b/util/resources/epub3-full.opf new file mode 100644 --- /dev/null +++ b/util/resources/epub3-full.opf @@ -0,0 +1,97 @@ + + + + + + 1-82057-821-9 + 1386506873266 + some-type + + Title Of This Book + main + 1 + The Subtitle + subtitle + 2 + Titre De Ce Livre + + en-US + en-UK + + Reginald Q. Knickerbocker + ill + Knickerbocker, Reginald Q. + Beverly Abercrombie + edt + + Josephine B. Wiggins + aut + Wiggins, Josephine B. + 2 + Horatio Cromwell + aut + 1 + Natalia Jenkins + 3 + + 2011 + 2012 + 2013-08-31T13:06:32Z + + document source + + test OPF Package Document + + coverage information + an additional coverage + + 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 + + ePub publication + an additional format + + Fictional Books Ltd. + An additional publisher + + document relation + an additional relation + + Fiction + Science Fiction + + Copyright: 2010 Dino Morelli, License: ISC + an additional rights + + + + + + + + + + + + + + + + + + + diff --git a/util/resources/testIllegalCharsBeforeDecl.opf b/util/resources/testIllegalCharsBeforeDecl.opf new file mode 100644 --- /dev/null +++ b/util/resources/testIllegalCharsBeforeDecl.opf @@ -0,0 +1,18 @@ + + + + en + Foo Bar Baz + 1122334455 + + + + + + + + + + diff --git a/util/show-opf.hs b/util/show-opf.hs --- a/util/show-opf.hs +++ b/util/show-opf.hs @@ -1,8 +1,5 @@ #! /usr/bin/runhaskell -isrc --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - import Control.Monad.Error ( runErrorT ) import System.Environment ( getArgs )