diff --git a/epub-metadata.cabal b/epub-metadata.cabal --- a/epub-metadata.cabal +++ b/epub-metadata.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: epub-metadata -version: 5.2 +version: 5.3 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 diff --git a/src/app/epub-metadata-example.hs b/src/app/epub-metadata-example.hs --- a/src/app/epub-metadata-example.hs +++ b/src/app/epub-metadata-example.hs @@ -6,7 +6,6 @@ import Codec.Epub import Codec.Epub.Data.Package import Control.Monad.Except -import Control.Monad.IO.Class ( liftIO ) main :: IO () diff --git a/src/lib/Codec/Epub/Data/Metadata.hs b/src/lib/Codec/Epub/Data/Metadata.hs --- a/src/lib/Codec/Epub/Data/Metadata.hs +++ b/src/lib/Codec/Epub/Data/Metadata.hs @@ -5,20 +5,22 @@ 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 (..) + ( Creator (..) , DateEvent (..) + , DateValue (..) , Description (..) + , Identifier (..) + , Metadata (..) , Refinement (..) + , Source (..) + , Title (..) , dateEventFromString , dateEventToString , emptyMetadata + , refineCreator , refineIdentifier + , refineSource , refineTitle - , refineCreator ) where @@ -41,6 +43,7 @@ , refScheme :: String -- ^ scheme attribute , refText :: String -- ^ meta tag text } + deriving Show {- Used for locating specific meta information in a list of @@ -67,15 +70,15 @@ refineIdentifier :: [Refinement] -> Identifier -> Identifier refineIdentifier refinements ident = assignScheme . assignType $ ident where - meta = findByIdProp (maybe "" id $ idId ident) + idTypeMeta = findByIdProp (maybe "" id $ idId ident) "identifier-type" refinements - assignType ident' = ident' { idType = refText `fmap` meta } + assignType ident' = ident' { idType = refText `fmap` idTypeMeta } assignScheme ident' = let existingScheme = idScheme ident' in ident' { idScheme = existingScheme `mplus` - (refScheme `fmap` meta) } + (refScheme `fmap` idTypeMeta) } -- | package\/metadata\/dc:title tag @@ -145,6 +148,37 @@ in creator' { creatorSeq = sq } +{- | package\/metadata\/dc:source tags +-} +data Source = Source + { sourceType :: Maybe String + , sourceScheme :: Maybe String + , sourceSourceOf :: Maybe String + , sourceText :: String + } + 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 +-} +refineSource :: [Refinement] -> (String, Source) -> Source +refineSource refinements (elid, source) = + assignType . assignScheme . assignSourceOf $ source + + where + idTypeMeta = findByIdProp elid "identifier-type" refinements + + assignType source' = source' { sourceType = refText <$> idTypeMeta } + + assignScheme source' = source' { sourceScheme = refScheme <$> idTypeMeta } + + assignSourceOf source' = + let existingSourceOf = sourceSourceOf source' + metaSourceOf = maybe Nothing (Just . refText) $ + findByIdProp elid "source-of" refinements + in source' { sourceSourceOf = existingSourceOf `mplus` metaSourceOf } + + data DateEvent = Available | Created @@ -213,7 +247,7 @@ , metaContributors :: [Creator] , metaCreators :: [Creator] , metaDates :: Map DateEvent DateValue - , metaSource :: Maybe String -- ^ dc:source tags + , metaSources :: [Source] -- ^ dc:source tags , metaType :: Maybe String -- ^ dc:type tags , metaCoverages :: [String] -- ^ dc:coverage tags , metaDescriptions :: [Description] @@ -234,7 +268,7 @@ , metaContributors = [] , metaCreators = [] , metaDates = Map.empty - , metaSource = Nothing + , metaSources = [] , metaType = Nothing , metaCoverages = [] , metaDescriptions = [] diff --git a/src/lib/Codec/Epub/Format/Guide.hs b/src/lib/Codec/Epub/Format/Guide.hs --- a/src/lib/Codec/Epub/Format/Guide.hs +++ b/src/lib/Codec/Epub/Format/Guide.hs @@ -9,9 +9,9 @@ ) where -import Control.Monad.Writer.Lazy +import Control.Monad.Writer.Lazy ( MonadWriter, execWriter ) import Data.Foldable ( toList ) -import Text.Printf +import Text.Printf ( printf ) import Codec.Epub.Format.Util import Codec.Epub.Data.Guide diff --git a/src/lib/Codec/Epub/Format/Manifest.hs b/src/lib/Codec/Epub/Format/Manifest.hs --- a/src/lib/Codec/Epub/Format/Manifest.hs +++ b/src/lib/Codec/Epub/Format/Manifest.hs @@ -9,9 +9,9 @@ ) where -import Control.Monad.Writer.Lazy +import Control.Monad.Writer.Lazy ( MonadWriter, execWriter ) import Data.Foldable ( toList ) -import Text.Printf +import Text.Printf ( printf ) import Codec.Epub.Format.Util import Codec.Epub.Data.Manifest diff --git a/src/lib/Codec/Epub/Format/Metadata.hs b/src/lib/Codec/Epub/Format/Metadata.hs --- a/src/lib/Codec/Epub/Format/Metadata.hs +++ b/src/lib/Codec/Epub/Format/Metadata.hs @@ -9,10 +9,10 @@ ) where -import Control.Monad.Writer.Lazy +import Control.Monad.Writer.Lazy ( MonadWriter, execWriter ) import qualified Data.Foldable as Foldable import qualified Data.Map.Strict as Map -import Text.Printf +import Text.Printf ( printf ) import Codec.Epub.Format.Util import Codec.Epub.Data.Metadata @@ -51,6 +51,17 @@ (formatSubline "display-seq" (show `fmap` dseq)) +tellSource :: MonadWriter (Seq Char) m => Source -> m () +tellSource (Source Nothing Nothing Nothing source) = + tellSeq $ printf "source: %s\n" source +tellSource (Source idType' scheme sourceOf source) = + tellSeq $ printf "source\n%s%s%s%s" + (formatSubline "text" (Just source)) + (formatSubline "identifier-type" idType') + (formatSubline "scheme" scheme) + (formatSubline "source-of" sourceOf) + + tellDate :: MonadWriter (Seq Char) m => (DateEvent, DateValue) -> m () tellDate (event', DateValue date') = tellSeq $ printf "date\n%s%s" @@ -87,14 +98,14 @@ 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 +tellMetadata (Metadata ids titles langs contributors creators dates sources 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 + mapM_ tellSource sources tellSimpleMbString "type" mType mapM_ (tellSimpleString "coverage") coverage mapM_ tellDescription desc diff --git a/src/lib/Codec/Epub/Format/Package.hs b/src/lib/Codec/Epub/Format/Package.hs --- a/src/lib/Codec/Epub/Format/Package.hs +++ b/src/lib/Codec/Epub/Format/Package.hs @@ -9,7 +9,7 @@ ) where -import Control.Monad.Writer.Lazy +import Control.Monad.Writer.Lazy ( MonadWriter, execWriter ) import Data.Foldable ( toList ) import Codec.Epub.Data.Package diff --git a/src/lib/Codec/Epub/Format/Spine.hs b/src/lib/Codec/Epub/Format/Spine.hs --- a/src/lib/Codec/Epub/Format/Spine.hs +++ b/src/lib/Codec/Epub/Format/Spine.hs @@ -9,9 +9,9 @@ ) where -import Control.Monad.Writer.Lazy +import Control.Monad.Writer.Lazy ( MonadWriter, execWriter ) import Data.Foldable ( toList ) -import Text.Printf +import Text.Printf ( printf ) import Codec.Epub.Format.Util import Codec.Epub.Data.Spine diff --git a/src/lib/Codec/Epub/Format/Util.hs b/src/lib/Codec/Epub/Format/Util.hs --- a/src/lib/Codec/Epub/Format/Util.hs +++ b/src/lib/Codec/Epub/Format/Util.hs @@ -8,14 +8,14 @@ ) where -import Control.Monad.Writer.Lazy +import Control.Monad.Writer.Lazy ( MonadWriter, tell ) import Data.Sequence ( Seq, fromList ) -import Text.Printf +import Text.Printf ( printf ) formatSubline :: String -> Maybe String -> String formatSubline _ Nothing = "" -formatSubline key (Just value) = printf " %s: %s\n" key value +formatSubline key (Just value) = printf " %s: %s\n" key value tellSeq :: MonadWriter (Seq a) m => [a] -> m () diff --git a/src/lib/Codec/Epub/IO.hs b/src/lib/Codec/Epub/IO.hs --- a/src/lib/Codec/Epub/IO.hs +++ b/src/lib/Codec/Epub/IO.hs @@ -13,20 +13,20 @@ ) where -import Codec.Archive.Zip +import Codec.Archive.Zip ( Archive, ZipOption (OptRecursive), + addFilesToArchive, emptyArchive, findEntryByPath, fromArchive, fromEntry, toArchive ) import Control.Arrow.ListArrows ( (>>>), deep ) -import Control.Exception +import Control.Exception ( SomeException, evaluate, try ) import Control.Monad ( (>=>), forM, liftM ) -import Control.Monad.Except +import Control.Monad.Except ( MonadError, MonadIO, throwError ) import Control.Monad.IO.Class ( liftIO ) -import Control.Monad.Trans ( MonadIO ) 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 System.Directory ( doesDirectoryExist, getDirectoryContents, setCurrentDirectory ) +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 ) diff --git a/src/lib/Codec/Epub/Parse.hs b/src/lib/Codec/Epub/Parse.hs --- a/src/lib/Codec/Epub/Parse.hs +++ b/src/lib/Codec/Epub/Parse.hs @@ -16,15 +16,14 @@ ) where -import Control.Arrow.ListArrows -import Control.Monad.Except +import Control.Arrow.ListArrows ( IOSLA, (>>>) ) +import Control.Monad.Except ( MonadError, MonadIO, throwError ) import Control.Monad.IO.Class ( liftIO ) -import Control.Monad.Trans ( MonadIO ) 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.XmlState.TypeDefs ( XIOState ) import Text.XML.HXT.Arrow.ReadDocument ( readString ) -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.DOM.TypeDefs ( XmlTree ) import Codec.Epub.Data.Guide import Codec.Epub.Data.Manifest @@ -43,7 +42,7 @@ {- Extract the epub OPF Package data contained in the supplied XML string -} -performParse :: (MonadIO m, MonadError String m) => +performParse :: (MonadIO m, MonadError String m, Show b) => IOSLA (XIOState ()) XmlTree b -> String -> m b performParse parser contents = do {- Improper encoding and schema declarations have been causing @@ -59,8 +58,10 @@ case result of (r : []) -> return r - _ -> throwError - "ERROR: FIXME with a better message" + (_ : unparseable) -> throwError $ + "ERROR: Unable to parse epub metadata\n" <> (show unparseable) + [] -> throwError $ + "ERROR: Unable to parse epub metadata" {- | Parse epub guide items from a String representing the epub XML diff --git a/src/lib/Codec/Epub/Parse/Guide.hs b/src/lib/Codec/Epub/Parse/Guide.hs --- a/src/lib/Codec/Epub/Parse/Guide.hs +++ b/src/lib/Codec/Epub/Parse/Guide.hs @@ -6,10 +6,10 @@ ) where -import Control.Arrow.ListArrows +import Control.Arrow.ListArrows ( (>>>), constA, listA, orElse, returnA ) import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, getAttrValue ) +import Text.XML.HXT.DOM.TypeDefs ( XNode ) import Codec.Epub.Data.Guide import Codec.Epub.Parse.Util diff --git a/src/lib/Codec/Epub/Parse/Manifest.hs b/src/lib/Codec/Epub/Parse/Manifest.hs --- a/src/lib/Codec/Epub/Parse/Manifest.hs +++ b/src/lib/Codec/Epub/Parse/Manifest.hs @@ -6,10 +6,10 @@ ) where -import Control.Arrow.ListArrows +import Control.Arrow.ListArrows ( (>>>), listA, returnA ) import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, getAttrValue ) +import Text.XML.HXT.DOM.TypeDefs ( XNode ) import Codec.Epub.Data.Manifest import Codec.Epub.Parse.Util diff --git a/src/lib/Codec/Epub/Parse/Metadata.hs b/src/lib/Codec/Epub/Parse/Metadata.hs --- a/src/lib/Codec/Epub/Parse/Metadata.hs +++ b/src/lib/Codec/Epub/Parse/Metadata.hs @@ -6,14 +6,14 @@ ) where -import Control.Applicative -import Control.Arrow.ListArrows +import Control.Applicative ( WrappedArrow (WrapArrow), unwrapArrow ) +import Control.Arrow.ListArrows ( (>>.), (>>>), (<<<), catA, constA, listA, returnA ) 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 Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, hasAttrValue ) +import Text.XML.HXT.DOM.TypeDefs ( XNode ) import Codec.Epub.Data.Metadata import Codec.Epub.Parse.Util @@ -70,8 +70,12 @@ returnA -< (, DateValue c) <$> dateEventFromString e -sourceP :: (ArrowXml a) => a (NTree XNode) (Maybe String) -sourceP = mbQTagText $ dcName "source" +sourceP :: (ArrowXml a) => a (NTree XNode) (String, Source) +sourceP = atQTag (dcName "source") >>> + proc x -> do + i <- mbGetAttrValue "id" -< x + t <- text -< x + returnA -< ((maybe "" id i), Source Nothing Nothing Nothing t) typeP :: (ArrowXml a) => a (NTree XNode) (Maybe String) @@ -121,7 +125,7 @@ <*> (WrapArrow $ listA $ creatorP "creator" >>. map (refineCreator refinements)) <*> (Map.fromList . catMaybes <$> (WrapArrow $ listA $ catA [dateElemP, dateMetaP])) - <*> (WrapArrow sourceP) + <*> (WrapArrow $ listA $ sourceP >>. map (refineSource refinements)) <*> (WrapArrow typeP) <*> (WrapArrow $ listA coverageP) <*> (WrapArrow $ listA descriptionP) diff --git a/src/lib/Codec/Epub/Parse/Package.hs b/src/lib/Codec/Epub/Parse/Package.hs --- a/src/lib/Codec/Epub/Parse/Package.hs +++ b/src/lib/Codec/Epub/Parse/Package.hs @@ -6,10 +6,10 @@ ) where -import Control.Arrow.ListArrows +import Control.Arrow.ListArrows ( (>>>), returnA ) import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, getAttrValue ) +import Text.XML.HXT.DOM.TypeDefs ( XNode ) import Codec.Epub.Data.Package import Codec.Epub.Parse.Util diff --git a/src/lib/Codec/Epub/Parse/Refinements.hs b/src/lib/Codec/Epub/Parse/Refinements.hs --- a/src/lib/Codec/Epub/Parse/Refinements.hs +++ b/src/lib/Codec/Epub/Parse/Refinements.hs @@ -8,13 +8,13 @@ ) where -import Control.Applicative -import Control.Arrow.ListArrows +import Control.Applicative (WrappedArrow (WrapArrow), unwrapArrow) +import Control.Arrow.ListArrows ((>>>), (>>^), listA) import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.Arrow.XmlArrow (ArrowXml) +import Text.XML.HXT.DOM.TypeDefs (XNode) -import Codec.Epub.Data.Metadata +import Codec.Epub.Data.Metadata (Refinement (..)) import Codec.Epub.Parse.Util diff --git a/src/lib/Codec/Epub/Parse/Spine.hs b/src/lib/Codec/Epub/Parse/Spine.hs --- a/src/lib/Codec/Epub/Parse/Spine.hs +++ b/src/lib/Codec/Epub/Parse/Spine.hs @@ -6,10 +6,10 @@ ) where -import Control.Arrow.ListArrows +import Control.Arrow.ListArrows ( (>>>), listA, returnA ) import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, getAttrValue ) +import Text.XML.HXT.DOM.TypeDefs ( XNode ) import Codec.Epub.Data.Spine import Codec.Epub.Parse.Util diff --git a/src/lib/Codec/Epub/Parse/Util.hs b/src/lib/Codec/Epub/Parse/Util.hs --- a/src/lib/Codec/Epub/Parse/Util.hs +++ b/src/lib/Codec/Epub/Parse/Util.hs @@ -14,10 +14,12 @@ ) where -import Control.Arrow.ListArrows +import Control.Arrow.ListArrows ( ArrowList, (>>^), (>>>), constA, deep, + getChildren, isA, orElse ) import Data.Tree.NTree.TypeDefs ( NTree ) -import Text.XML.HXT.Arrow.XmlArrow -import Text.XML.HXT.DOM.TypeDefs +import Text.XML.HXT.Arrow.XmlArrow ( ArrowXml, getAttrValue, getQAttrValue, + getText, hasQName, isElem ) +import Text.XML.HXT.DOM.TypeDefs ( QName, XmlTree, XNode, mkQName ) -- HXT helpers diff --git a/src/lib/Codec/Epub/Util.hs b/src/lib/Codec/Epub/Util.hs --- a/src/lib/Codec/Epub/Util.hs +++ b/src/lib/Codec/Epub/Util.hs @@ -4,7 +4,7 @@ module Codec.Epub.Util where -import Text.Regex +import Text.Regex ( mkRegexWithOpts, subRegex ) {- | An evil hack to remove *ILLEGAL* characters before the XML diff --git a/src/tests/Epub2/ParseGuide.hs b/src/tests/Epub2/ParseGuide.hs --- a/src/tests/Epub2/ParseGuide.hs +++ b/src/tests/Epub2/ParseGuide.hs @@ -3,7 +3,6 @@ where import Control.Monad.Except -import Control.Monad.IO.Class ( liftIO ) import System.FilePath import Test.HUnit diff --git a/src/tests/Epub2/ParseMetadata.hs b/src/tests/Epub2/ParseMetadata.hs --- a/src/tests/Epub2/ParseMetadata.hs +++ b/src/tests/Epub2/ParseMetadata.hs @@ -3,7 +3,6 @@ where import Control.Monad.Except -import Control.Monad.IO.Class ( liftIO ) import qualified Data.Map.Strict as Map import System.FilePath import Test.HUnit @@ -90,7 +89,7 @@ [ Identifier (Just "isbn") Nothing (Just "ISBN") "1-82057-821-9" , Identifier (Just "other") Nothing Nothing "1386506873266" ] - , metaSource = Just "document source" + , metaSources = [Source Nothing Nothing Nothing "document source"] , metaLangs = ["en-US", "en-UK"] , metaRelations = [ "document relation" @@ -129,7 +128,7 @@ , metaFormats = [] , metaIds = [Identifier (Just "isbn") Nothing (Just "ISBN") "1-82057-821-9"] - , metaSource = Nothing + , metaSources = [] , metaLangs = ["en-us"] , metaRelations = [] , metaCoverages = [] diff --git a/src/tests/Epub3/ParseMetadata.hs b/src/tests/Epub3/ParseMetadata.hs --- a/src/tests/Epub3/ParseMetadata.hs +++ b/src/tests/Epub3/ParseMetadata.hs @@ -71,7 +71,10 @@ , (Epub, DateValue "2012") , (Modified, DateValue "2013-08-31T13:06:32Z") ] - , metaSource = Just "document source" + , metaSources = + [ Source Nothing Nothing Nothing "document source" + , Source (Just "15") (Just "onix:codelist5") (Just "pagination") "another source" + ] , metaType = Just "test OPF Package Document" , metaCoverages = [ "coverage information" diff --git a/src/tests/ParsePackage.hs b/src/tests/ParsePackage.hs --- a/src/tests/ParsePackage.hs +++ b/src/tests/ParsePackage.hs @@ -3,7 +3,6 @@ where import Control.Monad.Except -import Control.Monad.IO.Class ( liftIO ) import System.FilePath import Test.HUnit diff --git a/src/tests/ParseSpine.hs b/src/tests/ParseSpine.hs --- a/src/tests/ParseSpine.hs +++ b/src/tests/ParseSpine.hs @@ -3,7 +3,6 @@ where import Control.Monad.Except -import Control.Monad.IO.Class ( liftIO ) import System.FilePath import Test.HUnit diff --git a/util/resources/epub3-full.opf b/util/resources/epub3-full.opf --- a/util/resources/epub3-full.opf +++ b/util/resources/epub3-full.opf @@ -45,6 +45,9 @@ 2013-08-31T13:06:32Z document source + another source + 15 + pagination test OPF Package Document