epub-metadata 2.0.0 → 2.0.1

raw patch · 4 files changed

+53/−20 lines, 4 filesdep +processdep +regex-compatdep −HSHPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: process, regex-compat

Dependencies removed: HSH

API changes (from Hackage documentation)

Files

• epub-metadata.cabal +3/−2
• src/Codec/Epub/IO.hs +39/−9
• src/Codec/Epub/Opf/Cli/Opts.hs +1/−1
• src/Codec/Epub/Opf/Parse.hs +10/−8

@@ -1,5 +1,5 @@ name:                epub-metadata-version:             2.0.0+version:             2.0.1 cabal-version:       >= 1.2 build-type:          Simple license:             BSD3@@ -35,7 +35,8 @@                      Codec.Epub.Opf.Package.Spine,                      Codec.Epub.Opf.Parse    hs-source-dirs:   src-   build-depends:    base >= 3 && < 5, containers, HSH, hxt >= 9, mtl+   build-depends:    base >= 3 && < 5, containers, hxt >= 9, mtl, +                     process, regex-compat    ghc-options:      -Wall  executable           epub-meta

@@ -15,29 +15,59 @@  import Control.Arrow.ListArrows ( (>>>), deep ) import Control.Monad.Error-import HSH.Command+import System.Exit+import System.Process import Text.Printf+import Text.Regex import Text.XML.HXT.Arrow.XmlArrow ( getAttrValue, hasName, isElem ) import Text.XML.HXT.Arrow.XmlState ( no, runX, withValidate ) import Text.XML.HXT.Arrow.ReadDocument ( readString )  +-- | An evil hack to remove encoding from the document+removeEncoding :: String -> String+removeEncoding = flip (subRegex +   (mkRegexWithOpts " +encoding=\"UTF-8\"" False True)) ""+++-- | An evil hack to remove any <!DOCTYPE ...> from the document+removeDoctype :: String -> String+removeDoctype = flip (subRegex +   (mkRegexWithOpts "<!DOCTYPE [^>]*>" False True)) ""+++{- | GNU unzip has annoying non-zero exit codes that aren't fatal+   so we need to check for those special.+-}+handleEC :: (MonadIO m, MonadError String m)+   => String -> ExitCode -> m ()+handleEC msg (ExitFailure c)+   | c > 2 = throwError $ printf "%s  status: %s]\n" msg (show c)+   | otherwise = return ()+handleEC _    ExitSuccess = return ()++ {- | Extract a file from a zipfile.    This is here because ePub files are really just zip files.++   Yep, you saw right sports fans. This code is using the command-+   line unzip utility. In the future I'd like to make it use a+   library. -}-extractFileFromZip :: (MonadIO m, MonadError [Char] m)+extractFileFromZip :: (MonadIO m, MonadError String m)    => FilePath    -- ^ path to zip file    -> FilePath    -- ^ path within zip file to extract    -> m String    -- ^ contents of expected file extractFileFromZip zipPath filePath = do    let dearchiver = "unzip"-   result <- liftIO $ tryEC $ run-      ((printf "%s -p %s %s" dearchiver zipPath filePath) :: String)-   case result of-      Left ps -> throwError $-         printf "[ERROR %s  zip file: %s  path in zip: %s  status: %s]"-            dearchiver zipPath filePath (show ps)-      Right output -> return output++   (ec, output, _) <- liftIO $ readProcessWithExitCode+      dearchiver ["-p", zipPath, filePath] ""++   handleEC (printf "[ERROR %s  zip file: %s  path in zip: %s"+      dearchiver zipPath filePath) ec++   return . removeEncoding . removeDoctype $ output   -- | Get the path within an ePub file to the OPF Package Document

@@ -52,5 +52,5 @@          , "Options:"          ]       footer = init $ unlines-         [ "Version 2.0.0  Dino Morelli <dino@ui3.info>"+         [ "Version 2.0.1  Dino Morelli <dino@ui3.info>"          ]

@@ -28,8 +28,10 @@  -- HXT helpers +{- Not used at this time. But may be used someday atTag :: (ArrowXml a) => String -> a (NTree XNode) XmlTree atTag tag = deep (isElem >>> hasName tag)+-}  atQTag :: (ArrowXml a) => QName -> a (NTree XNode) XmlTree atQTag tag = deep (isElem >>> hasQName tag)@@ -77,7 +79,7 @@   getPackage :: (ArrowXml a) => a (NTree XNode) (String, String)-getPackage = atTag "package" >>>+getPackage = atQTag (opfName "package") >>>    proc x -> do       v <- getAttrValue "version" -< x       u <- getAttrValue "unique-identifier" -< x@@ -162,7 +164,7 @@   getMeta :: (ArrowXml a) => a (NTree XNode) Metadata-getMeta = atTag "metadata" >>> ( unwrapArrow $ Metadata+getMeta = atQTag (opfName "metadata") >>> ( unwrapArrow $ Metadata    <$> (WrapArrow $ listA getTitle)    <*> (WrapArrow $ listA $ getCreator "creator")    <*> (WrapArrow $ listA $ getCreator "contributor")@@ -182,7 +184,7 @@   getManifestItem :: (ArrowXml a) => a (NTree XNode) ManifestItem-getManifestItem = atTag "item" >>>+getManifestItem = atQTag (opfName "item") >>>    proc x -> do       i <- getAttrValue "id" -< x       h <- getAttrValue "href" -< x@@ -191,14 +193,14 @@   getManifest :: (ArrowXml a) => a (NTree XNode) [ManifestItem]-getManifest = atTag "manifest" >>>+getManifest = atQTag (opfName "manifest") >>>    proc x -> do       l <- listA getManifestItem -< x       returnA -< l   getSpineItemref :: (ArrowXml a) => a (NTree XNode) SpineItemref-getSpineItemref = atTag "itemref" >>>+getSpineItemref = atQTag (opfName "itemref") >>>    proc x -> do       i <- getAttrValue "idref" -< x       ml <- mbGetAttrValue "linear" -< x@@ -207,7 +209,7 @@   getSpine :: (ArrowXml a) => a (NTree XNode) Spine-getSpine = atTag "spine" >>>+getSpine = atQTag (opfName "spine") >>>    proc x -> do       i <- getAttrValue "toc" -< x       l <- listA getSpineItemref -< x@@ -215,7 +217,7 @@   getGuideRef :: (ArrowXml a) => a (NTree XNode) GuideRef-getGuideRef = atTag "reference" >>>+getGuideRef = atQTag (opfName "reference") >>>    proc x -> do       t <- getAttrValue "type" -< x       mt <- mbGetAttrValue "title" -< x@@ -224,7 +226,7 @@   getGuide :: (ArrowXml a) => a (NTree XNode) [GuideRef]-getGuide = atTag "guide" >>>+getGuide = atQTag (opfName "guide") >>>    proc x -> do       l <- listA getGuideRef -< x       returnA -< l