diff --git a/epub-tools.cabal b/epub-tools.cabal --- a/epub-tools.cabal +++ b/epub-tools.cabal @@ -1,6 +1,6 @@ name: epub-tools cabal-version: >= 1.8 -version: 1.1.2 +version: 2.0.0 build-type: Simple license: BSD3 license-file: LICENSE @@ -12,7 +12,12 @@ synopsis: Command line utilities for working with epub files description: A suite of command-line utilities for creating and manipulating epub book files. Included are: epubmeta, epubname, epubzip category: Application, Console -tested-with: GHC >= 7.0.3 +tested-with: GHC >= 7.6.1 + +data-dir: resources +data-files: default.rules, + epubname-dsl-docs + extra-source-files: testsuite/EpubTools/*.hs testsuite/EpubTools/Test/EpubName/*.hs @@ -23,7 +28,7 @@ executable epubmeta main-is: EpubTools/epubmeta.hs build-depends: base >= 3 && < 5, bytestring, directory, - epub-metadata >= 2.3, filepath, mtl, process, + epub-metadata >= 2.3.1, filepath, mtl, process, zip-archive hs-source-dirs: src other-modules: EpubTools.EpubMeta.Display @@ -36,28 +41,33 @@ executable epubname main-is: EpubTools/epubname.hs - build-depends: base >= 3 && < 5, directory, epub-metadata >= 2.3, - mtl, regex-compat + build-depends: base >= 3 && < 5, directory, epub-metadata >= 2.3.1, + filepath, mtl, parsec, regex-compat hs-source-dirs: src - other-modules: EpubTools.EpubName.Author - EpubTools.EpubName.Format + other-modules: EpubTools.EpubName.Format.Author + EpubTools.EpubName.Format.Compile + EpubTools.EpubName.Format.Format + EpubTools.EpubName.Format.PubYear + EpubTools.EpubName.Format.Util + EpubTools.EpubName.Main EpubTools.EpubName.Opts - EpubTools.EpubName.PubYear + EpubTools.EpubName.Prompt EpubTools.EpubName.Util + ghc-options: -Wall test-suite epubname-tests type: exitcode-stdio-1.0 main-is: EpubTools/test-epubname.hs - build-depends: base, directory, epub-metadata >= 2.3, HUnit, mtl, - regex-compat + build-depends: base, directory, epub-metadata >= 2.3.1, filepath, + HUnit, mtl, parsec, regex-compat hs-source-dirs: src testsuite ghc-options: -Wall executable epubzip main-is: EpubTools/epubzip.hs - build-depends: base >= 3 && < 5, directory, epub-metadata >= 2.3, - filepath, mtl, regex-compat + build-depends: base >= 3 && < 5, directory, epub-metadata >= 2.3.1, + filepath, mtl, parsec, regex-compat hs-source-dirs: src other-modules: EpubTools.EpubZip.Opts ghc-options: -Wall diff --git a/resources/default.rules b/resources/default.rules new file mode 100644 --- /dev/null +++ b/resources/default.rules @@ -0,0 +1,101 @@ +magAeon + titlePat "^A[eE]on ([^ ]+)$" + name "AeonMagazine(wordNum 2 1)" + +magAnalog + titlePat "^(A[^ ]*).*, ([^ ]+) ([0-9]{4})$" + name "(scrub 1)SF(3)-(monthNum 2)" + +magApex + titlePat "^(Apex)[^0-9]*([0-9]+)$" + name "(scrub 1)Magazine(pad 3 2)" + +magBcs + titlePat "(Beneath Ceaseless.*) #([0-9]+).*" + name "(scrub 1)_Issue(pad 3 2)" + +magBlackStatic + titlePat "^(Black Static Horror Magazine)[^0-9]*([0-9]+)$" + name "(scrub 1)(pad 2 2)" + +magChallengingDestiny + titlePat "^(Challenging Destiny) #([0-9]+).*" + name "(scrub 1)Magazine(pad 3 2)" + +magClarkesworld + titlePat "^(Clarkesworld)[^0-9]*([0-9]+)$" + name "(1)(pad 3 2)" + +magFantasyMag + titlePat "^(Fantasy Magazine)[^0-9]+([0-9]+).*" + name "(scrub 1)(pad 3 2)" + +magEclipse_word + titlePat "^(Eclipse) +([a-zA-Z]+)$" + name "(1)(wordNum 2 2)" + +magEclipse_num + titlePat "^(Eclipse) +([0-9]+):.*" + name "(1)(pad 2 2)" + +magFsf + authorMatch "Spilogale" + titlePat ".* ([^ ]+) ([0-9]{4})$" + name "FantasyScienceFiction(2)-(monthNum 1)" + +magFutureOrbits + titlePat "(Future Orbits) Issue ([0-9]+), ([^ ]+) ([0-9]{4})$" + name "(scrub 1)Magazine(pad 2 2)_(4)-(monthNum 3)" + +magGud + authorMatch "GUD Magazine Authors" + titlePat ".* Magazine Issue ([0-9]+) ::.*" + name "GUDMagazine(pad 2 1)" + +magInterzone + titlePat "^(Interzone)[^0-9]*([0-9]+)$" + name "(1)SFF(pad 3 2)" + +magLightspeed_date + titlePat "(Lightspeed) Magazine, (.*) (.*)" + name "(1)(3)-(monthNum 2)" + +magLightspeed_issue + titlePat "(Lightspeed) Magazine Issue (.*)" + name "(1)(pad 3 2)" + +magNemesis + titlePat "(Nemesis Mag)azine #([0-9]+).*" + name "(scrub 1)(pad 3 2)" + +magRageMachine + titlePat "(Rage Machine.*)--([^ ]+) ([0-9]{4})$" + name "(scrub 1)_(3)-(monthNum 2)" + +magSomethingWicked + titlePat "^(Something Wicked)[^0-9]*([0-9]+)" + name "(scrub 1)(pad 3 2)" + +magUniverse + titlePat "^(Jim Baen's Universe)-Vol ([^ ]+) Num ([^ ]+)" + name "(scrub 1)Vol(pad 2 2)Num(pad 2 3)" + +magWeirdTales + titlePat "^(Weird Tales)[^0-9]*([0-9]+)$" + name "(scrub 1)(pad 3 2)" + +compOfTheYear + titlePat "(.*of the Year.*)" + name "(scrub 1)" + +compYearsBest + titlePat "(.*Year's Best.*)" + name "(scrub 1)" + +magLocus + titlePat "^(Locus), ([a-zA-Z]+) ([0-9]{4})$" + name "(scrub 1)Magazine(3)-(monthNum 2)" + +ordinary_book + titlePat "(.*)" + name "(authors)(scrub 1)(year)" diff --git a/resources/epubname-dsl-docs b/resources/epubname-dsl-docs new file mode 100644 --- /dev/null +++ b/resources/epubname-dsl-docs @@ -0,0 +1,165 @@ +epubname rules documentation +---------------------------- + +Book naming is controlled by a set of rules loaded from a file + +At runtime, a rules file is searched for, first in the user's home directory and then in the installed files for epubname. The paths of these files specific to your system are listed in --help output. + +The rules are checked, from first to last, for each file being renamed. The first rule that succeeds is used. + + +Rules have the following format: + + label + authorPat "..." + titlePat "..." + name "..." + +label is to identify what the rule is for to the user and also for verbose output (helpful for debugging rules) + +The indented fields are rule commands and consist of: + + authorPat - Optional. If present, it's a regexp pattern that must + match an author in the book's metadata. If it doesn't match, this + rule is rejected. This may be a partial match, "bar" will match if + authors looks like "foo bar baz" + + titlePat - a regular expression for picking apart the title string in + the book's metadata. The pieces in capture groups ( ) are exposed + as numbered matches in the name construction field. If this match + fails, this rule is rejected. + + name - instructions for building up a new book filename, most often + using the parts extracted in titlePat. More on this below + + +In the name command, there are several functions that can be used. These functions are delimited with parenthesis in the name command's expression. + + authors - Get formatted authors from the metadata. If there are any + authors, a hyphen will be placed after them in the resulting string. + + syntax: (authors) + + INT - Retrieve the text of a specific numbered item from the title + pattern match results + + syntax: (INT) + + monthNum INDEX - Construct a numeric month from a variety of English + months strings. Including abbreviations and ranges + + syntax: (monthNum INT) + + examples: + "January" -> "01" + "Feb" -> "02" + "Mar-Apr" -> "03_04" + "September/October" -> "09_10" + + pad WIDTH INDEX - Pad a numeric value from the pattern match results + + syntax: (pad INT INT) + + examples: + 2 "3" -> "03" + 3 "10" -> "010" + + publisher - Get the formatted publisher file-as string from the + metadata + + syntax: (publisher) + + scrub INDEX - Clean up an item from the pattern match results. A + large number of punctuation is removed and/or converted into + other characters, and the string is CamelCased. In the end, only + alphanumerics, - and _ are used. + + syntax: (scrub INT) + + wordNum WIDTH INDEX - Construct a numeric string from an English word + for a number, with padding. Works on strings from "One" to "Twenty" + + syntax: (wordNum INT INT) + + example: + 2 "One" -> "01" + 3 "Twenty" -> "020" + + year - Get the formatted publication year from the metadata + + syntax: (year) + + Anything else, not in parenthesis, is a string literal to be used at + that position in the resulting string. + + +This probably seems confusing, some examples may help. + +This one is a fictitious magazine with issue and date info in the title: + + original book metadata: + title: Adventurer's Weekly Issue 53, May 2008 + + epubname rule: + magAdventureWeekly + titlePat "(Adventurer's Weekly) Issue ([0-9]+), ([^ ]+) ([0-9]{4})$" + name "(scrub 1)Magazine(pad 3 2)_(4)-(monthNum 3)" + + resulting title: + "AdventurersWeeklyMagazine053_2008-05" + + +Here's one using some more functions: + + original book metadata: + title: Thrilling Journeys Three + creator + role: aut + text: The Thrilling Authors + + epubname rule: + compThrillingJourneys + author "Thrilling Authors" + titlePat "(Thrilling Journeys) (.*)" + name "(scrub 1)(wordNum 2 2)" + + resulting title: + "ThrillingJourneys03" + + +And here's what happens when an ordinary (non-periodical) book is formatted: + + original book metadata: + title: Springtime in the Village + creator + role: aut + file-as: Dandridge, Suzanne + text: Suzanne Dandridge + date + event: publication + text: 2012-10-09 + + epubname rule: + ordinary_book + titlePat "(.*)" + name "(authors)(scrub 1)(year)" + + resulting title: + "DandridgeSuzanne-SpringtimeInTheVillage_2012" + + +The last rule in default.rules, ordinary_book is very important, and looks like this: + + ordinary_book + titlePat "(.*)" + name "(authors)(scrub 1)(year)" + +This rule will match any book and is used to format all simple author-title situations. This rules is responsible for the basic epubname behavior and should always be present and always be last. + + +Preceding a rule label with ! will "switch off" the entire rule. It's a simple way to comment out a single rule in its entirety. example: + + !compThrillingJourneys + author "Thrilling Authors" + titlePat "(Thrilling Journeys) (.*)" + name "(scrub 1)(wordNum 2 2)" diff --git a/src/EpubTools/EpubMeta/Edit.hs b/src/EpubTools/EpubMeta/Edit.hs --- a/src/EpubTools/EpubMeta/Edit.hs +++ b/src/EpubTools/EpubMeta/Edit.hs @@ -2,10 +2,13 @@ -- License: BSD3 (see LICENSE) -- Author: Dino Morelli +{-# LANGUAGE ScopedTypeVariables #-} + module EpubTools.EpubMeta.Edit ( edit ) where +import Control.Exception import Control.Monad import System.Cmd import System.Directory @@ -24,10 +27,9 @@ if an IO exception is raised -} ioMaybe :: IO a -> IO (Maybe a) -ioMaybe action = - (fmap Just $ action) - `catch` - (const $ return Nothing) +ioMaybe action = do + result :: (Either SomeException a) <- try action + either (const . return $ Nothing) (return . Just) result {- Look through the user's environment looking for their preferred diff --git a/src/EpubTools/EpubMeta/Opts.hs b/src/EpubTools/EpubMeta/Opts.hs --- a/src/EpubTools/EpubMeta/Opts.hs +++ b/src/EpubTools/EpubMeta/Opts.hs @@ -103,5 +103,5 @@ , "" , "For more information please see the IDPF OPF specification found here: http://idpf.org/epub/20/spec/OPF_2.0.1_draft.htm" , "" - , "Version 1.1.2 Dino Morelli " + , "Version 2.0.0 Dino Morelli " ] diff --git a/src/EpubTools/EpubName/Author.hs b/src/EpubTools/EpubName/Author.hs deleted file mode 100644 --- a/src/EpubTools/EpubName/Author.hs +++ /dev/null @@ -1,118 +0,0 @@ --- Copyright: 2008-2012 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module EpubTools.EpubName.Author - ( extractAuthors - , authorMatches - ) - where - -import Codec.Epub.Opf.Package -import Control.Monad -import Data.List ( intercalate ) -import Data.Maybe ( isJust ) -import Prelude hiding ( last ) -import Text.Printf -import Text.Regex - -import EpubTools.EpubName.Util - - -extractAuthors :: Metadata -> String -extractAuthors = fmtAuthor . separateCombined . justAuthors - where - fmtAuthor [] = "" - fmtAuthor [c] = formatSingleAuthor c - fmtAuthor cs = (formatMultiAuthors cs) ++ "-" - - -separateCombined :: [MetaCreator] -> [MetaCreator] -separateCombined = concatMap separateOne - - -separateOne :: MetaCreator -> [MetaCreator] -separateOne c@(MetaCreator r _ di) = - case (splitRegex (mkRegex " (&|and) ") di) of - -- If there was only one, leave the file-as alone! - [_] -> [c] - -- Otherwise, explode them into separate MetaCreatorS - ss -> map (MetaCreator r Nothing) ss - - -formatSingleAuthor :: MetaCreator -> String - -formatSingleAuthor (MetaCreator _ (Just fa) di) = - if ((fa == di) && all (/= ',') fa) - then formatSingleAuthor $ MetaCreator Nothing Nothing di - else authorSingle [fa] - -formatSingleAuthor (MetaCreator _ _ di) = - authorSingle . reverse . nameParts $ di - - -nameParts :: String -> [String] -nameParts s = maybe [] id $ foldl mplus Nothing matches - where - matches = - [ matchRegex (mkRegex "(.*) ([^ ]+)$") s - , matchRegex (mkRegex "(.*)") s - ] - - -lastName' :: String -> String -lastName' s = maybe "" head $ foldl mplus Nothing matches - where - matches = - [ matchRegex (mkRegex "(.*),.*") s - , matchRegex (mkRegex ".* (.*)") s - , matchRegex (mkRegex "(.*)") s - ] - -lastName :: MetaCreator -> String -lastName (MetaCreator _ (Just fa) _ ) = lastName' fa -lastName (MetaCreator _ _ di) = lastName' di - - -formatMultiAuthors :: [MetaCreator] -> String -formatMultiAuthors = (intercalate "_") . (map lastName) - - -justAuthors :: Metadata -> [MetaCreator] -justAuthors = (filter isAut) . metaCreators - where - isAut (MetaCreator (Just "aut") _ _) = True - isAut (MetaCreator Nothing _ _) = True - isAut _ = False - - -{- A common simple formatter for many book authors --} -authorSingle :: [String] -> String -authorSingle (last:rest:_) = - printf "%s%s-" (filterCommon last) (filterCommon rest) -authorSingle [n] = printf "%s-" $ filterCommon n -authorSingle _ = undefined - - -{- Throws an error if no author matches the pattern --} -authorMatches :: Metadata -> String -> EN () -authorMatches md re = do - let authorMatches' (MetaCreator _ _ di) = - matchRegex (mkRegex re) di - - unless (any isJust $ map authorMatches' $ justAuthors md) $ - throwError "Specific author string not found" - - -{- Author names with a postfix like II, III, Jr. or Sr. - FIXME: Is anyone calling this? --} -{- -authorPostfix :: [String] -> String -authorPostfix (rest:last:postfix:_) = - printf "%s%s%s-" (filterCommon last) (filterCommon rest) - (filterCommon postfix) -authorPostfix _ = undefined --} diff --git a/src/EpubTools/EpubName/Format.hs b/src/EpubTools/EpubName/Format.hs deleted file mode 100644 --- a/src/EpubTools/EpubName/Format.hs +++ /dev/null @@ -1,395 +0,0 @@ --- Copyright: 2008-2012 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module EpubTools.EpubName.Format - ( tryFormatting - ) - where - -import Codec.Epub.Opf.Package -import Control.Monad.Error -import Data.List ( isPrefixOf ) -import Data.Maybe ( fromJust ) -import Text.Printf -import Text.Regex - -import EpubTools.EpubName.Author -import EpubTools.EpubName.Opts -import EpubTools.EpubName.PubYear -import EpubTools.EpubName.Util - - -formatters :: [Metadata -> EN (String, [String])] -formatters = - [ magAeon - , magAnalog - , magApex - , magBcs - , magBlackStatic - , magChallengingDestiny - , magClarkesworld - , magEclipse - , magFantasyMag - , magFsf - , magFutureOrbits - , magGud - , magInterzone - , magLightspeedDate - , magLightspeedIssue - , magNemesis - , magRageMachine - , magSomethingWicked - , magWeirdTales - , magUniverse - , compOfTheYear - , compYearsBest - , book -- Kind of always want this one last as a catch-all - ] - - -magAeon :: Metadata -> EN (String, [String]) -magAeon md = do - (issue:_) <- extractTitle md "^A[eE]on ([^ ]+)$" - let title = printf "AeonMagazine%s" (wordNum issue) - - return ("magAeon", [title]) - - -magAnalog :: Metadata -> EN (String, [String]) -magAnalog md = do - (prefix:month:year:_) <- - extractTitle md "^(A[^ ]*).*, ([^ ]+) ([0-9]{4})$" - - let title = printf "%sSF%s-%s" - (filterCommon prefix) year (monthNum month) - - return ("magAnalog", [title]) - - -magApex :: Metadata -> EN (String, [String]) -magApex md = do - (prefix:issue:_) <- extractTitle md "^(Apex)[^0-9]*([0-9]+)$" - let title = printf "%sMagazine%03d" - (filterCommon prefix) (read issue :: Int) - - return ("magApex", [title]) - - -magBcs :: Metadata -> EN (String, [String]) -magBcs md = do - (prefix:issue:_) <- - extractTitle md "(Beneath Ceaseless.*) #([0-9]+).*" - let title = printf "%s_Issue%03d" - (filterCommon prefix) (read issue :: Int) - - return ("magBcs", [title]) - - -magBlackStatic :: Metadata -> EN (String, [String]) -magBlackStatic md = do - (prefix:issue:_) <- - extractTitle md "^(Black Static Horror Magazine)[^0-9]*([0-9]+)$" - let title = printf "%s%02d" (filterCommon prefix) (read issue :: Int) - - return ("magBlackStatic", [title]) - - -magChallengingDestiny :: Metadata -> EN (String, [String]) -magChallengingDestiny md = do - (prefix:issue:_) <- extractTitle md "^(Challenging Destiny) #([0-9]+).*" - let title = printf "%sMagazine%03d" - (filterCommon prefix) (read issue :: Int) - - return ("magChallengingDestiny", [title]) - - -magClarkesworld :: Metadata -> EN (String, [String]) -magClarkesworld md = do - (prefix:issue:_) <- - extractTitle md "^(Clarkesworld)[^0-9]*([0-9]+)$" - let title = printf "%s%03d" prefix (read issue :: Int) - - return ("magClarkesworld", [title]) - - -magEclipse :: Metadata -> EN (String, [String]) -magEclipse md = do - authorMatches md "Jonathan Strahan" - - (prefix:issueRaw:_) <- extractTitle md "^(Eclipse) ([^ :]+)" - - let issue = fromJust $ - mbWordNum issueRaw - `mplus` - (Just $ printf "%02d" (read issueRaw :: Int)) - - let title = printf "%s%s" prefix issue - - return ("magEclipse", [title]) - - -magFantasyMag :: Metadata -> EN (String, [String]) -magFantasyMag md = do - (prefix:issue:_) <- - extractTitle md "^(Fantasy Magazine)[^0-9]+([0-9]+).*" - let title = printf "%s%03d" (filterCommon prefix) (read issue :: Int) - - return ("magFantasyMag", [title]) - - -magFsf :: Metadata -> EN (String, [String]) -magFsf md = do - authorMatches md "Spilogale" - - (month:year:_) <- extractTitle md ".* ([^ ]+) ([0-9]{4})$" - let title = printf "FantasyScienceFiction%s-%s" - year (monthNum month) - - return ("magFsf", [title]) - - -magFutureOrbits :: Metadata -> EN (String, [String]) -magFutureOrbits md = do - (prefix:issue:month:year:_) <- extractTitle md - "(Future Orbits) Issue ([0-9]+), ([^ ]+) ([0-9]{4})$" - let title = printf "%sMagazine%02d_%s-%s" (filterCommon prefix) - (read issue :: Int) year (monthNum month) - - return ("magFutureOrbits", [title]) - - -magGud :: Metadata -> EN (String, [String]) -magGud md = do - authorMatches md "GUD Magazine Authors" - - (issue:_) <- - extractTitle md ".* Magazine Issue ([0-9]+) ::.*" - let title = printf "GUDMagazine%02d" (read issue :: Int) - - return ("magGud", [title]) - - -magInterzone :: Metadata -> EN (String, [String]) -magInterzone md = do - (prefix:issue:_) <- - extractTitle md "^(Interzone)[^0-9]*([0-9]+)$" - let title = printf "%sSFF%03d" prefix (read issue :: Int) - - return ("magInterzone", [title]) - - -magLightspeedDate :: Metadata -> EN (String, [String]) -magLightspeedDate md = do - (prefix:month:year:_) <- - extractTitle md "(Lightspeed) Magazine, (.*) (.*)" - let title = printf "%s%s-%s" - prefix year (monthNum month) - - return ("magLightspeedDate", [title]) - - -magLightspeedIssue :: Metadata -> EN (String, [String]) -magLightspeedIssue md = do - (prefix:issue:_) <- - extractTitle md "(Lightspeed) Magazine Issue (.*)" - let title = printf "%s%03d" prefix (read issue :: Int) - - return ("magLightspeedIssue", [title]) - - -magNemesis :: Metadata -> EN (String, [String]) -magNemesis md = do - (prefix:issue:_) <- - extractTitle md "(Nemesis Mag)azine #([0-9]+).*" - let title = printf "%s%03d" (filterCommon prefix) (read issue :: Int) - - return ("magNemesis", [title]) - - -magRageMachine :: Metadata -> EN (String, [String]) -magRageMachine md = do - (prefix:month:year:_) <- - extractTitle md "(Rage Machine.*)--([^ ]+) ([0-9]{4})$" - let title = printf "%s_%s-%s" - (filterCommon prefix) year (monthNum month) - - return ("magRageMachine", [title]) - - -magSomethingWicked :: Metadata -> EN (String, [String]) -magSomethingWicked md = do - (prefix:issue:_) <- extractTitle md "^(Something Wicked)[^0-9]*([0-9]+)" - let title = printf "%s%03d" - (filterCommon prefix) (read issue :: Int) - - return ("magSomethingWicked", [title]) - - -magUniverse :: Metadata -> EN (String, [String]) -magUniverse md = do - (prefix:vol:num:_) <- - extractTitle md "^(Jim Baen's Universe)-Vol ([^ ]+) Num ([^ ]+)" - let title = printf "%sVol%02dNum%02d" (filterCommon prefix) - (read vol :: Int) (read num :: Int) - - return ("magUniverse", [title]) - - -magWeirdTales :: Metadata -> EN (String, [String]) -magWeirdTales md = do - (prefix:issue:_) <- extractTitle md "^(Weird Tales)[^0-9]*([0-9]+)$" - let title = printf "%s%03d" - (filterCommon prefix) (read issue :: Int) - - return ("magWeirdTales", [title]) - - -compOfTheYear :: Metadata -> EN (String, [String]) -compOfTheYear md = do - (title:_) <- extractTitle md "(.*of the Year.*)" - - return ("compOfTheYear", [filterCommon title]) - - -compYearsBest :: Metadata -> EN (String, [String]) -compYearsBest md = do - (title:_) <- extractTitle md "(.*Year's Best.*)" - - return ("compYearsBest", [filterCommon title]) - - -book :: Metadata -> EN (String, [String]) -book md = do - (title:_) <- extractTitle md "(.*)" - year <- getPubYear md - - return ("book", [extractAuthors md, filterCommon title, year]) - - -tryFormatting :: FilePath -> Metadata -> EN (String, String) -tryFormatting oldPath md = do - foldr mplus - (throwError $ printf "%s [ERROR No formatter found]" oldPath) $ - map (\f -> f md >>= finish md) formatters - - -finish :: Metadata -> (String, [String]) -> EN (String, String) -finish md (label, parts) = do - publisher <- fmap (extractPublisher md) $ asks optPublisher - return ( label - , foldr1 (++) (parts ++ [publisher, ".epub"])) - - -extractTitle :: Metadata -> String -> EN [String] -extractTitle md re = do - (MetaTitle _ oldTitle) <- case metaTitles md of - [] -> throwError "format failed, no title present" - ts -> return . head $ ts - - case matchRegex (mkRegex re) oldTitle of - Just matches -> return matches - Nothing -> throwError $ printf "extract title failed: %s" re - - -extractPublisher :: Metadata -> Bool -> String -extractPublisher _ False = "" -extractPublisher md True = maybe "" ('_' :) - (foldr mplus Nothing (map maybePub $ metaContributors md)) - - where - maybePub (MetaCreator (Just "bkp") (Just fa) _ ) = Just fa - maybePub _ = Nothing - - -{- Convert an English month name (with creative ranges and variations) - into number form --} -monthNum :: String -> String -monthNum x - | isPrefixOf x "January" = "01" -monthNum "January-February" = "01_02" -monthNum "January/February" = "01_02" -monthNum "Jan-Feb" = "01_02" -monthNum "Jan/Feb" = "01_02" -monthNum x - | isPrefixOf x "February" = "02" -monthNum x - | isPrefixOf x "March" = "03" -monthNum "March-April" = "03_04" -monthNum "March/April" = "03_04" -monthNum "Mar-Apr" = "03_04" -monthNum "Mar/Apr" = "03_04" -monthNum x - | isPrefixOf x "April" = "04" -monthNum "April-May" = "04_05" -monthNum "April/May" = "04_05" -monthNum "Apr-May" = "04_05" -monthNum "Apr/May" = "04_05" -monthNum "May" = "05" -monthNum "May-June" = "05_06" -monthNum "May/June" = "05_06" -monthNum "May-Jun" = "05_06" -monthNum "May/Jun" = "05_06" -monthNum x - | isPrefixOf x "June" = "06" -monthNum "June/July" = "06_07" -monthNum "June-July" = "06_07" -monthNum "Jun-Jul" = "06_07" -monthNum "Jun/Jul" = "06_07" -monthNum x - | isPrefixOf x "July" = "07" -monthNum "July-August" = "07_08" -monthNum "July/August" = "07_08" -monthNum "Jul-Aug" = "07_08" -monthNum "Jul/Aug" = "07_08" -monthNum x - | isPrefixOf x "August" = "08" -monthNum "August-September" = "08_09" -monthNum "August/September" = "08_09" -monthNum "Aug-Sep" = "08_09" -monthNum "Aug/Sep" = "08_09" -monthNum x - | isPrefixOf x "September" = "09" -monthNum "September-October" = "09_10" -monthNum x - | isPrefixOf x "October" = "10" -monthNum "October-November" = "10_11" -monthNum "October/November" = "10_11" -monthNum "Oct-Nov" = "10_11" -monthNum "Oct/Nov" = "10_11" -monthNum "November-December" = "11_12" -monthNum x - | isPrefixOf x "November" = "11" -monthNum x - | isPrefixOf x "December" = "12" -monthNum x = "[ERROR monthNum " ++ x ++ "]" - - -{- Convert an English word for a number into number form --} -wordNum :: String -> String -wordNum s = maybe ("[ERROR mbWordNum " ++ s ++ "]") id $ mbWordNum s - -mbWordNum :: String -> Maybe String -mbWordNum "One" = Just "01" -mbWordNum "Two" = Just "02" -mbWordNum "Three" = Just "03" -mbWordNum "Four" = Just "04" -mbWordNum "Five" = Just "05" -mbWordNum "Six" = Just "06" -mbWordNum "Seven" = Just "07" -mbWordNum "Eight" = Just "08" -mbWordNum "Nine" = Just "09" -mbWordNum "Ten" = Just "10" -mbWordNum "Eleven" = Just "11" -mbWordNum "Twelve" = Just "12" -mbWordNum "Thirteen" = Just "13" -mbWordNum "Fourteen" = Just "14" -mbWordNum "Fifteen" = Just "15" -mbWordNum "Sixteen" = Just "16" -mbWordNum "Seventeen" = Just "17" -mbWordNum "Eighteen" = Just "18" -mbWordNum "Nineteen" = Just "19" -mbWordNum "Twenty" = Just "20" -mbWordNum _ = Nothing diff --git a/src/EpubTools/EpubName/Format/Author.hs b/src/EpubTools/EpubName/Format/Author.hs new file mode 100644 --- /dev/null +++ b/src/EpubTools/EpubName/Format/Author.hs @@ -0,0 +1,120 @@ +-- Copyright: 2008-2012 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module EpubTools.EpubName.Format.Author + ( extractAuthors + , authorMatches + ) + where + +import Codec.Epub.Opf.Package +import Control.Monad +import Data.List ( intercalate ) +import Data.Maybe ( isJust ) +import Prelude hiding ( last ) +import Text.Printf +import Text.Regex + +import EpubTools.EpubName.Format.Util + + +extractAuthors :: EN String +extractAuthors = do + fmap (fmtAuthor . separateCombined . justAuthors) $ asks gMetadata + where + fmtAuthor [] = "" + fmtAuthor [c] = formatSingleAuthor c + fmtAuthor cs = (formatMultiAuthors cs) ++ "-" + + +separateCombined :: [MetaCreator] -> [MetaCreator] +separateCombined = concatMap separateOne + + +separateOne :: MetaCreator -> [MetaCreator] +separateOne c@(MetaCreator r _ di) = + case (splitRegex (mkRegex " (&|and) ") di) of + -- If there was only one, leave the file-as alone! + [_] -> [c] + -- Otherwise, explode them into separate MetaCreatorS + ss -> map (MetaCreator r Nothing) ss + + +formatSingleAuthor :: MetaCreator -> String + +formatSingleAuthor (MetaCreator _ (Just fa) di) = + if ((fa == di) && all (/= ',') fa) + then formatSingleAuthor $ MetaCreator Nothing Nothing di + else authorSingle [fa] + +formatSingleAuthor (MetaCreator _ _ di) = + authorSingle . reverse . nameParts $ di + + +nameParts :: String -> [String] +nameParts s = maybe [] id $ foldl mplus Nothing matches + where + matches = + [ matchRegex (mkRegex "(.*) ([^ ]+)$") s + , matchRegex (mkRegex "(.*)") s + ] + + +lastName' :: String -> String +lastName' s = maybe "" head $ foldl mplus Nothing matches + where + matches = + [ matchRegex (mkRegex "(.*),.*") s + , matchRegex (mkRegex ".* (.*)") s + , matchRegex (mkRegex "(.*)") s + ] + +lastName :: MetaCreator -> String +lastName (MetaCreator _ (Just fa) _ ) = lastName' fa +lastName (MetaCreator _ _ di) = lastName' di + + +formatMultiAuthors :: [MetaCreator] -> String +formatMultiAuthors = (intercalate "_") . (map lastName) + + +justAuthors :: Metadata -> [MetaCreator] +justAuthors = (filter isAut) . metaCreators + where + isAut (MetaCreator (Just "aut") _ _) = True + isAut (MetaCreator Nothing _ _) = True + isAut _ = False + + +{- A common simple formatter for many book authors +-} +authorSingle :: [String] -> String +authorSingle (last:rest:_) = + printf "%s%s-" (scrubString last) (scrubString rest) +authorSingle [n] = printf "%s-" $ scrubString n +authorSingle _ = undefined + + +{- Throws an error if no author matches the pattern +-} +authorMatches :: String -> EN () +authorMatches re = do + let authorMatches' (MetaCreator _ _ di) = + matchRegex (mkRegex re) di + + md <- asks gMetadata + unless (any isJust $ map authorMatches' $ justAuthors md) $ + throwError "Specific author string not found" + + +{- Author names with a postfix like II, III, Jr. or Sr. + FIXME: Is anyone calling this? +-} +{- +authorPostfix :: [String] -> String +authorPostfix (rest:last:postfix:_) = + printf "%s%s%s-" (filterCommon last) (filterCommon rest) + (filterCommon postfix) +authorPostfix _ = undefined +-} diff --git a/src/EpubTools/EpubName/Format/Compile.hs b/src/EpubTools/EpubName/Format/Compile.hs new file mode 100644 --- /dev/null +++ b/src/EpubTools/EpubName/Format/Compile.hs @@ -0,0 +1,171 @@ +-- Copyright: 2008-2012 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} + +module EpubTools.EpubName.Format.Compile + where + +import Data.Maybe ( catMaybes ) +import Text.ParserCombinators.Parsec + +import EpubTools.EpubName.Format.Author +import EpubTools.EpubName.Format.Format + + +parseRules :: FilePath -> IO (Either ParseError [Formatter]) +parseRules = parseFromFile pFormatters + + +pFormatters :: Parser [Formatter] +pFormatters = fmap catMaybes $ many pFormatter + + +pFormatter :: Parser (Maybe Formatter) +pFormatter = do + l <- many1Till (noneOf " ") eol + a <- optionMaybe $ try $ pCommand "authorMatch" + t <- pCommand "titlePat" + n <- pName + newline <|> return ' ' + let aReplF = maybe (return ()) authorMatches a + return $ case head l of + '!' -> Nothing + _ -> Just $ Formatter l aReplF (extractTitle t) n + + +pName :: Parser [ReplF] +pName = do + pCommandPrefix "name" + fs <- pRepls + eol + return fs + + +pCommand :: String -> Parser String +pCommand c = do + pCommandPrefix c + char '"' + qs <- manyTill (noneOf "\"") (char '"') + eol + return qs + + +pCommandPrefix :: String -> Parser () +pCommandPrefix c = do + many1 space + string c + spaces + return () + + +{- +pRepls :: Parser [[String]] +pRepls = do + char '"' + rs <- many pExpr + char '"' + return rs +-} +pRepls :: Parser [ReplF] +pRepls = do + char '"' + rs <- many pExpr + char '"' + + let extension = literal ".epub" + return $ rs ++ [publisher, extension] + + +{- +pExpr :: Parser [String] +pExpr = pRepl <|> pLiteral +-} +pExpr :: Parser ReplF +pExpr = pRepl <|> pLiteral + + +--pRepl :: Parser [String] +pRepl :: Parser ReplF +pRepl = do + char '(' + spaces + x <- pCall <|> pIndex + spaces + char ')' + return x + + +{- +pCall :: Parser [String] +pCall = do + fn <- pFName + spaces + args <- pArgList + return $ fn : args +-} +pCall :: Parser ReplF +pCall = do + fn <- pFName + spaces + args <- pArgList + mkReplF $ fn : args + + +pFName :: Parser String +pFName = do + first <- letter + rest <- many alphaNum + return $ first : rest + + +pArgList :: Parser [String] +pArgList = sepEndBy (many1 digit) (char ' ') + + +{- +pIndex :: Parser [String] +pIndex = do + ds <- many1 digit + return [ds] +-} +pIndex :: Parser ReplF +pIndex = do + ds <- many1 digit + mkReplF ["index", ds] + + +{- +pLiteral :: Parser [String] +pLiteral = do + l <- many1 (noneOf "()\"") + return [l] +-} +pLiteral :: Parser ReplF +pLiteral = do + l <- many1 (noneOf "()\"") + mkReplF ["literal", l] + + +many1Till :: Parser a -> Parser end -> Parser [a] +many1Till p end = do + h <- p + t <- manyTill p end + return $ h : t + + +eol :: Parser Char +eol = newline <|> (eof >> return '\n') + + +mkReplF :: [String] -> Parser ReplF +mkReplF ("authors" : []) = return authors +mkReplF ("index" : i : []) = return $ index i +mkReplF ("literal" : s : []) = return $ literal s +mkReplF ("monthNum" : i : []) = return $ monthNum i +mkReplF ("pad" : w : i : []) = return $ pad w i +mkReplF ("scrub" : i : []) = return $ scrub i +mkReplF ("wordNum" : w : i : []) = return $ wordNum w i +mkReplF ("year" : []) = return year +mkReplF l = unexpected $ "Bad function definition: " ++ (concat l) diff --git a/src/EpubTools/EpubName/Format/Format.hs b/src/EpubTools/EpubName/Format/Format.hs new file mode 100644 --- /dev/null +++ b/src/EpubTools/EpubName/Format/Format.hs @@ -0,0 +1,285 @@ +-- Copyright: 2008-2012 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +module EpubTools.EpubName.Format.Format + ( ReplF + , authors, index, literal, monthNum, pad, publisher, scrub, wordNum + , year + , Formatter (..) + , tryFormatting + , extractTitle + ) + where + +import Codec.Epub.Opf.Package +import Control.Monad.Error +import Data.List ( isPrefixOf ) +import Text.Printf +import Text.Regex + +import EpubTools.EpubName.Format.Author +import EpubTools.EpubName.Format.PubYear +import EpubTools.EpubName.Format.Util +import EpubTools.EpubName.Opts + + +type ReplF = [String] -> EN String + + +data Formatter = Formatter + String -- formatter label + (EN ()) -- author match pattern + (EN [String]) -- title pattern parser + [ReplF] -- name building actions + + +{- A single, simple formatter that should handle most books with one or + more author. +-} +{- Not using this at the moment, but I'm reluctant to remove it. Could + be useful someday. +ordinaryBookFormatter :: Formatter +ordinaryBookFormatter = Formatter + "ordinary_book" + (return ()) + (extractTitle ".*") + [authors, scrub "1", year] +-} + + +{- Wrapper functions to perform some basic operations in the Error + String monad +-} + +-- general purpose read in the Error String monad +readE :: (MonadError String m, Read a) => String -> String -> m a +readE msg s = case reads s of + [(x, "")] -> return x + _ -> throwError msg + + +-- read an Int in the Error String monad +readIntE :: MonadError String m => String -> m Int +readIntE = readE "Not a number" + + +-- get list element at a specific index in the Error String monad +elemE :: MonadError String m => [a] -> Int -> m a +elemE l i + | i < length l = return $ l !! i + | otherwise = throwError $ "Bad array index: " ++ show i + + +{- Instructions in the book naming DSL. These instructions are used from + the rules file notation, in the name "..." command +-} + +-- Get formatted authors from the metadata +authors :: ReplF +authors _ = extractAuthors + + +-- Retrieve a specific item from the title pattern match results +index :: String -> ReplF +index sIndex matches = readIntE sIndex >>= return . subtract 1 + >>= elemE matches + + +-- Insert a specific string literal into the resulting name string +literal :: String -> ReplF +literal s = return . const s + + +{- Construct a numeric month from a variety of English months strings + Including abbreviations and ranges +-} +monthNum :: String -> ReplF +monthNum sIndex matches = index sIndex matches >>= monthStrToNumbers + + +-- Pad a numeric value from the pattern match results +pad :: String -> String -> ReplF +pad sWidth sIndex matches = do + width <- readIntE sWidth + value <- index sIndex matches >>= readIntE + return $ printf "%0*d" (width :: Int) (value :: Int) + + +-- Get the formatted publisher file-as string from the metadata +publisher :: ReplF +publisher _ = do + md <- asks gMetadata + fmap (extractPublisher md) $ asks $ optPublisher . gOpts + + +-- Clean up an item from the pattern match results +scrub :: String -> ReplF +scrub sIndex matches = fmap scrubString $ index sIndex matches + + +{- Construct a numeric string from an English word for a number, + with padding +-} +wordNum :: String -> String -> ReplF +wordNum sWidth sIndex matches = do + value <- index sIndex matches >>= numStrToInt + width <- readIntE sWidth + return $ printf "%0*d" (width :: Int) (value :: Int) + + +-- Get the formatted publication year from the metadata +year :: ReplF +year _ = getPubYear + + +{- Commands in the book naming DSL. These commands are used from the + rules file notation, in the rule blocks +-} + +{- This is used by the titlePat command to construct a title pattern + matcher for a specific rule +-} +extractTitle :: String -> EN [String] +extractTitle re = do + md <- asks gMetadata + + (MetaTitle _ oldTitle) <- case metaTitles md of + [] -> throwError "format failed, no title present" + ts -> return . head $ ts + + case matchRegex (mkRegex re) oldTitle of + Just matches -> return matches + Nothing -> throwError $ printf "extract title failed: %s" re + + +{- This is used by the name command to execute a series of the DSL + instructions above to create a new filename +-} +name :: [String] -> [ReplF] -> EN String +name matches replacers = + fmap concat $ sequence $ map (\a -> a matches) replacers + + +-- Try a specific formatter +tryFormatter :: Formatter -> EN (String, FilePath) +tryFormatter (Formatter label authorMatch titlePat nameBuilders) = do + authorMatch + matches <- titlePat + newName <- name matches nameBuilders + return (label, sanitizeString newName) + + +{- Try the entire list of formatters, one by one, in order, until one + succeeds or none do +-} +tryFormatting :: (MonadIO m, MonadError String m) => + Options -> [Formatter] -> Metadata -> FilePath -> m (String, FilePath) +tryFormatting opts fs meta oldPath = + either throwError return $ runEN (Globals opts meta) $ + foldr mplus + (throwError $ printf "%s [ERROR No formatter found]" oldPath) $ + map tryFormatter fs + + +extractPublisher :: Metadata -> Bool -> String +extractPublisher _ False = "" +extractPublisher md True = maybe "" ('_' :) + (foldr mplus Nothing (map maybePub $ metaContributors md)) + + where + maybePub (MetaCreator (Just "bkp") (Just fa) _ ) = Just fa + maybePub _ = Nothing + + +{- Convert an English month name (with creative ranges and variations) + into number form +-} +monthStrToNumbers :: String -> EN String +monthStrToNumbers s + | isPrefixOf s "January" = return "01" +monthStrToNumbers "January-February" = return "01_02" +monthStrToNumbers "January/February" = return "01_02" +monthStrToNumbers "Jan-Feb" = return "01_02" +monthStrToNumbers "Jan/Feb" = return "01_02" +monthStrToNumbers s + | isPrefixOf s "February" = return "02" +monthStrToNumbers s + | isPrefixOf s "March" = return "03" +monthStrToNumbers "March-April" = return "03_04" +monthStrToNumbers "March/April" = return "03_04" +monthStrToNumbers "Mar-Apr" = return "03_04" +monthStrToNumbers "Mar/Apr" = return "03_04" +monthStrToNumbers s + | isPrefixOf s "April" = return "04" +monthStrToNumbers "April-May" = return "04_05" +monthStrToNumbers "April/May" = return "04_05" +monthStrToNumbers "Apr-May" = return "04_05" +monthStrToNumbers "Apr/May" = return "04_05" +monthStrToNumbers "May" = return "05" +monthStrToNumbers "May-June" = return "05_06" +monthStrToNumbers "May/June" = return "05_06" +monthStrToNumbers "May-Jun" = return "05_06" +monthStrToNumbers "May/Jun" = return "05_06" +monthStrToNumbers s + | isPrefixOf s "June" = return "06" +monthStrToNumbers "June/July" = return "06_07" +monthStrToNumbers "June-July" = return "06_07" +monthStrToNumbers "Jun-Jul" = return "06_07" +monthStrToNumbers "Jun/Jul" = return "06_07" +monthStrToNumbers s + | isPrefixOf s "July" = return "07" +monthStrToNumbers "July-August" = return "07_08" +monthStrToNumbers "July/August" = return "07_08" +monthStrToNumbers "Jul-Aug" = return "07_08" +monthStrToNumbers "Jul/Aug" = return "07_08" +monthStrToNumbers s + | isPrefixOf s "August" = return "08" +monthStrToNumbers "August-September" = return "08_09" +monthStrToNumbers "August/September" = return "08_09" +monthStrToNumbers "Aug-Sep" = return "08_09" +monthStrToNumbers "Aug/Sep" = return "08_09" +monthStrToNumbers s + | isPrefixOf s "September" = return "09" +monthStrToNumbers "September-October" = return "09_10" +monthStrToNumbers s + | isPrefixOf s "October" = return "10" +monthStrToNumbers "October-November" = return "10_11" +monthStrToNumbers "October/November" = return "10_11" +monthStrToNumbers "Oct-Nov" = return "10_11" +monthStrToNumbers "Oct/Nov" = return "10_11" +monthStrToNumbers "November-December" = return "11_12" +monthStrToNumbers s + | isPrefixOf s "November" = return "11" +monthStrToNumbers s + | isPrefixOf s "December" = return "12" +monthStrToNumbers s = + throwError $ printf "[ERROR monthNum %s]" s + + +{- Convert an English word for a number into number form +-} +numStrToInt :: String -> EN Int +numStrToInt "One" = return 1 +numStrToInt "Two" = return 2 +numStrToInt "Three" = return 3 +numStrToInt "Four" = return 4 +numStrToInt "Five" = return 5 +numStrToInt "Six" = return 6 +numStrToInt "Seven" = return 7 +numStrToInt "Eight" = return 8 +numStrToInt "Nine" = return 9 +numStrToInt "Ten" = return 10 +numStrToInt "Eleven" = return 11 +numStrToInt "Twelve" = return 12 +numStrToInt "Thirteen" = return 13 +numStrToInt "Fourteen" = return 14 +numStrToInt "Fifteen" = return 15 +numStrToInt "Sixteen" = return 16 +numStrToInt "Seventeen" = return 17 +numStrToInt "Eighteen" = return 18 +numStrToInt "Nineteen" = return 19 +numStrToInt "Twenty" = return 20 +numStrToInt s = throwError $ printf "[ERROR wordNum %s]" s diff --git a/src/EpubTools/EpubName/Format/PubYear.hs b/src/EpubTools/EpubName/Format/PubYear.hs new file mode 100644 --- /dev/null +++ b/src/EpubTools/EpubName/Format/PubYear.hs @@ -0,0 +1,57 @@ +-- Copyright: 2011, 2012 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module EpubTools.EpubName.Format.PubYear + ( extractYear + , getPubYear + ) + where + +import Codec.Epub.Opf.Package +import Control.Monad +import Text.Regex + +import EpubTools.EpubName.Opts +import EpubTools.EpubName.Format.Util + + +{- Look for publication date, return "" if none found +-} +getPubYear :: EN String +getPubYear = do + yearHandling <- asks $ optPubYear . gOpts + md <- asks gMetadata + + case yearHandling of + Publication -> getPubYear' md pubAttrs + AnyDate -> getPubYear' md $ pubAttrs ++ [getFirstDate] + NoDate -> return "" + + where + getPubYear' md = return . maybe "" ('_' :) . foldr mplus Nothing . + map (\f -> f (metaDates md)) + + pubAttrs = + [ getDateWithAttr "original-publication" + , getDateWithAttr "publication" + ] + + +getDateWithAttr :: String -> [MetaDate] -> Maybe String +getDateWithAttr attrVal mds = foldr mplus Nothing $ map getPublication' mds + where + getPublication' (MetaDate (Just av) d) + | av == attrVal = extractYear d + getPublication' _ = Nothing + + +getFirstDate :: [MetaDate] -> Maybe String +getFirstDate ((MetaDate _ d) : _) = extractYear d +getFirstDate _ = Nothing + + +extractYear :: String -> Maybe String +extractYear s = case matchRegex (mkRegex "(^| )([0-9]{4})") s of + Just (_ : y : []) -> Just y + _ -> Nothing diff --git a/src/EpubTools/EpubName/Format/Util.hs b/src/EpubTools/EpubName/Format/Util.hs new file mode 100644 --- /dev/null +++ b/src/EpubTools/EpubName/Format/Util.hs @@ -0,0 +1,89 @@ +-- Copyright: 2008-2012 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module EpubTools.EpubName.Format.Util + ( Globals (..) + , EN , runEN + , throwError + , asks + , scrubString + , sanitizeString + ) + where + +import Codec.Epub.Opf.Package +import Control.Monad.Error +import Control.Monad.Identity +import Control.Monad.Reader +import Data.Char +import Data.List ( foldl' ) +import Text.Regex + +import EpubTools.EpubName.Opts + + +data Globals = Globals + { gOpts :: Options + , gMetadata :: Metadata + } + +type EN a = ReaderT Globals (ErrorT String Identity) a + +runEN :: Globals -> EN a -> Either String a +runEN env ev = runIdentity (runErrorT (runReaderT ev env)) + + +{- Convenience function to make a regex replacer for a given pattern + and replacement string. Helps by doing the 'flip' of str and rpl + so you can partial eval. +-} +repl :: String -> String -> String -> String +repl re rpl str = subRegex (mkRegex re) str rpl + + +{- Transforms a string like this: + "the quick brown McCheeseburger" -> "TheQuickBrownMccheeseburger" +-} +camelCase :: String -> String +camelCase s = concat $ map capFirst $ words s + where + capFirst (first:rest) = (toUpper first) : (map toLower rest) + capFirst _ = undefined + + +{- A set of common string filters that apply to any and all parts + of every single string we process in this project. +-} +aggressiveFilters :: [(String -> String)] +aggressiveFilters = + [ repl "[',\\?();#’]" "" + , repl "\\." " " + , repl ":" "_" + , filter (/= '"') + , repl "]" "" + , repl "\\*" "" + , repl "!" "" + , repl "[-/]" " " + , repl "\\[" "_ " + -- Decided that I like the article included in titles + --, repl "^The " "" + , repl "&" " And " + , camelCase + ] + + +{- Utility function to apply the above filters to a string, giving you + back the transformed string +-} +scrubString :: String -> String +scrubString s = foldl' (flip id) s aggressiveFilters + + +{- Utility function to apply a very basic filter to make a legal filename, + giving you back the transformed string. This is used on everything + at the very end, just before the new filename is returned from the + formatting machinery. +-} +sanitizeString :: String -> String +sanitizeString s = foldl' (flip id) s [ repl "/" " " ] diff --git a/src/EpubTools/EpubName/Main.hs b/src/EpubTools/EpubName/Main.hs new file mode 100644 --- /dev/null +++ b/src/EpubTools/EpubName/Main.hs @@ -0,0 +1,73 @@ +-- Copyright: 2008-2012 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module EpubTools.EpubName.Main + ( initialize + ) + where + +import Control.Monad.Error +import Data.List ( intercalate ) +import System.Directory ( doesFileExist ) +import System.Exit + +import EpubTools.EpubName.Format.Compile +import EpubTools.EpubName.Format.Format +import EpubTools.EpubName.Opts +import EpubTools.EpubName.Util + + +instance Error ExitCode where + -- noMsg :: a + noMsg = strMsg "" + + -- strMsg :: String -> a + strMsg = const exitInitFailure + + +initialize :: (MonadError ExitCode m, MonadIO m) => + Options -> m [Formatter] +initialize opts = (locateRules opts) >>= loadFormatters + + +locateRules :: (MonadError ExitCode m, MonadIO m) => + Options -> m FilePath +locateRules opts = do + let paths = optRulesPaths opts + mbResult <- liftIO $ foldl (liftM2 mplus) (return Nothing) + $ map mbExists paths + maybe (errNoRules paths) return mbResult + + +mbExists :: FilePath -> IO (Maybe FilePath) +mbExists p = do + e <- doesFileExist p + if e + then return $ Just p + else return Nothing + + +errNoRules :: (MonadError ExitCode m, MonadIO m) => + [FilePath] -> m FilePath +errNoRules paths = do + liftIO $ do + putStrLn "Unable to find rules file. Paths searched:" + let indentedPaths = map ((++) " ") paths + putStrLn $ intercalate "\n" indentedPaths + throwError exitInitFailure + + +loadFormatters :: (MonadError ExitCode m, MonadIO m) => + FilePath -> m [Formatter] +loadFormatters rulesPath = do + parseResult <- liftIO $ parseRules rulesPath + + case parseResult of + Left err -> do + liftIO $ print err + throwError exitInitFailure + Right fs -> return fs diff --git a/src/EpubTools/EpubName/Opts.hs b/src/EpubTools/EpubName/Opts.hs --- a/src/EpubTools/EpubName/Opts.hs +++ b/src/EpubTools/EpubName/Opts.hs @@ -2,6 +2,7 @@ -- License: BSD3 (see LICENSE) -- Author: Dino Morelli +{-# LANGUAGE FlexibleContexts #-} module EpubTools.EpubName.Opts ( PubYear (..), Options (..) @@ -10,11 +11,17 @@ ) where +import Control.Monad.Error import Data.Maybe import System.Console.GetOpt +import System.Environment import System.Exit +import System.FilePath +import Paths_epub_tools +import EpubTools.EpubName.Util + data PubYear = Publication -- Default, use date event='publication' or 'original-publication' | AnyDate -- Use first date element found @@ -22,26 +29,48 @@ data Options = Options - { optHelp :: Bool - , optNoAction :: Bool - , optOverwrite :: Bool - , optPublisher :: Bool - , optVerbose :: Maybe Int - , optPubYear :: PubYear + { optHelp :: Bool + , optHelpRules :: Bool + , optInteractive :: Bool + , optNoAction :: Bool + , optPublisher :: Bool + , optRulesPaths :: [FilePath] + , optTargetDir :: FilePath + , optVerbose :: Maybe Int + , optPubYear :: PubYear } -defaultOptions :: Options -defaultOptions = Options - { optHelp = False - , optNoAction = False - , optOverwrite = False - , optPublisher = False - , optVerbose = Nothing - , optPubYear = Publication - } +defaultRulesFile :: FilePath +defaultRulesFile = "default.rules" +userRulesPath :: IO FilePath +userRulesPath = do + homeDir <- getEnv"HOME" + return $ homeDir ".epubtools" defaultRulesFile +stockRulesPath :: IO FilePath +stockRulesPath = getDataFileName defaultRulesFile + + +defaultOptions :: IO Options +defaultOptions = do + urp <- userRulesPath + srp <- stockRulesPath + + return Options + { optHelp = False + , optHelpRules = False + , optInteractive = False + , optNoAction = False + , optPublisher = False + , optRulesPaths = [ urp, srp ] + , optTargetDir = "." + , optVerbose = Nothing + , optPubYear = Publication + } + + options :: [OptDescr (Options -> Options)] options = [ Option ['d'] ["any-date"] @@ -53,15 +82,25 @@ , Option ['h'] ["help"] (NoArg (\opts -> opts { optHelp = True } )) "This help text" + , Option [] ["help-rules"] + (NoArg (\opts -> opts { optHelpRules = True } )) + "Help on the naming rules domain specific language" + , Option ['i'] ["interactive"] + (NoArg (\opts -> opts { optInteractive = True } )) + "Prompt user interactively" , Option ['n'] ["no-action"] (NoArg (\opts -> opts { optNoAction = True } )) "Display what would be done, but do nothing" - , Option ['o'] ["overwrite"] - (NoArg (\opts -> opts { optOverwrite = True } )) - "Overwrite existing file with new name" , Option ['p'] ["publisher"] (NoArg (\opts -> opts { optPublisher = True } )) "Include book publisher if present. See below" + , Option ['r'] ["rules"] (ReqArg prependRulesPath "FILE") + "Specify a rules file for naming the books" + , Option ['t'] ["target-dir"] + ( ReqArg + (\p opts -> opts { optTargetDir = p } ) + "DIR") + "Target directory for successfully renamed books. Default: ." , Option ['v'] ["verbose"] ( OptArg ((\n opts -> opts { optVerbose = Just (read n)}) . fromMaybe "1") @@ -70,34 +109,53 @@ ] -parseOpts :: [String] -> IO (Either ExitCode (Options, [String])) -parseOpts argv = +prependRulesPath :: FilePath -> Options -> Options +prependRulesPath p opts = opts { optRulesPaths = newlist } + where + newlist = p : optRulesPaths opts + + +parseOpts :: (MonadError ExitCode m, MonadIO m) => + [String] -> m (Options, [String]) +parseOpts argv = do + dos <- liftIO defaultOptions case getOpt Permute options argv of - (o,n,[] ) -> return . Right $ (foldl (flip id) defaultOptions o, n) + (o,n,[] ) -> return (foldl (flip id) dos o, n) (_,_,errs) -> do - putStrLn $ concat errs ++ usageText - return . Left $ ExitFailure 1 + liftIO $ do + ut <- usageText + putStrLn $ concat errs ++ ut + throwError exitInitFailure -usageText :: String -usageText = (usageInfo header options) ++ "\n" ++ footer +usageText :: IO String +usageText = do + urp <- userRulesPath + srp <- stockRulesPath + return $ (usageInfo header options) ++ "\n" ++ footer urp srp + where header = init $ unlines - [ "Usage: epubname [OPTIONS] FILES" + [ "USAGE: epubname [OPTIONS] FILES" , "Rename EPUB book files with clear names based on their metadata" , "" - , "Options:" + , "OPTIONS:" + , "" ] - footer = init $ unlines - [ "Verbosity levels:" - , " 1 - Include which formatter processed the file" - , " 2 - Include the OPF Package and Metadata info" + footer urp srp = init $ unlines + [ "VERBOSITY LEVELS:" , "" - , "Exit codes:" + , " 1 - Output which formatter processed the file" + , " 2 - Output the OPF Package and Metadata info" + , "" + , "EXIT CODES:" + , "" , " 0 - success" , " 1 - bad options" , " 2 - failed to process one or more of the files given" , "" + , "SIMPLE NAMING:" + , "" , "Book names are constructed by examining parts of the OPF Package metadata such as the title, creators, contributors and dates." , "" , "Strings from the OPF metadata fields are stripped of punctuation, CamelCased and stripped of spaces. Resulting file names look like this:" @@ -113,13 +171,28 @@ , "" , "Only creator tags with either a role attribute of 'aut' or no role at all are considered authors. If a file-as attribute is present, this will be the preferred string. If not, the program tries to do some intelligent parsing of the name." , "" - , "The OPF spec suggests there may be a 2011 element representing original publication date. If this (or opf:event='original-publication') is present, it will be used by default for _year as in the above examples. The --any-date switch will use the first date tag found, regardless of attributes. The year can be parsed out of many date formats, it's very flexible." + , "The OPF spec suggests there may be a 2011 element representing original publication date. If this (or opf:event='original-publication') is present, it will be used by default for _year as in the above examples. The --any-date switch will use the first date tag found, regardless of attributes. The year can be parsed out of many date formats, it's very flexible." , "" , "Publisher: I wanted to provide a way to have multiple copies of the same book produced by different publishers and name them sort-of unambiguously. I came up with the idea of expecting a contributor tag with role attribute of 'bkp' (so far, this is fairly normal). And then use a file-as attribute on that tag to contain a small string to be used in the filename. The idea here is short and sweet for the file-as." , "" - , "Magazines are kind of a sticky problem in that it's often desireable to have edition and/or date info in the filename. There's a lot of chaos out there with titling the epub editions of magazines. The solution in this software is to do some pattern matching on multiple fields in the magazine's metadata combined with custom naming code for specific magazines. This means that support for future magazines will likely have to be hand-coded into future versions of this utility. Modifying this just isn't very non-programmer friendly." + , "MORE COMPLICATED NAMING:" , "" - , "For more information please see the IDPF OPF specification found here: http://idpf.org/epub/20/spec/OPF_2.0.1_draft.htm" + , "Magazines are kind of a sticky problem in that it's often desireable to have edition and/or date info in the filename. There's a lot of chaos out there with titling the epub editions of magazines. The solution in this software is to do some pattern matching on multiple fields in the magazine's metadata combined with custom naming rules for specific magazines." , "" - , "Version 1.1.2 Dino Morelli " + , "This software ships with a set of rules to properly name over 20 magazines and compilations that are commonly purchased by the developer. These default rules can be extended to add new publications, and used as an example." + , "" + , "epubname will search the following locations for a rules file, in this order:" + , "" + , " " ++ urp + , " " ++ srp + , "" + , "Use the last one, in share, as a model for a custom file for your ~" + , "" + , "Please see --help-rules for more information on the syntax of the DSL in the rules file." + , "" + , "" + , "For more information on the EPUB format, please see the IDPF OPF specification found here: http://idpf.org/epub/20/spec/OPF_2.0.1_draft.htm" + , "" + , "" + , "Version 2.0.0 Dino Morelli " ] diff --git a/src/EpubTools/EpubName/Prompt.hs b/src/EpubTools/EpubName/Prompt.hs new file mode 100644 --- /dev/null +++ b/src/EpubTools/EpubName/Prompt.hs @@ -0,0 +1,45 @@ +module EpubTools.EpubName.Prompt + ( PromptResult (..) + , prompt + , continue + ) + where + +import Data.Char ( toLower ) + + +data PromptResult + = Yes + | No + | Quit + deriving Eq + + +prompt :: IO PromptResult +prompt = do + putStr "Rename this file? [Ynq], or ? for more options: " + c <- getChar + putStr "\n" + + case (toLower c) of + 'y' -> return Yes + ' ' -> return Yes + '\n' -> return Yes + 'n' -> return No + 'q' -> return Quit + '?' -> more >> prompt + _ -> putStrLn "Unknown choice" >> prompt + + +continue :: PromptResult -> Bool +continue Quit = False +continue _ = True + + +more :: IO () +more = putStr . unlines $ + [ "y: rename this file" + , "n: don't rename this file" + , "q: cancel now, don't rename any files beyond this point" + , " or : accept the default (which is capitalized)" + ] diff --git a/src/EpubTools/EpubName/PubYear.hs b/src/EpubTools/EpubName/PubYear.hs deleted file mode 100644 --- a/src/EpubTools/EpubName/PubYear.hs +++ /dev/null @@ -1,56 +0,0 @@ --- Copyright: 2011, 2012 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -module EpubTools.EpubName.PubYear - ( extractYear - , getPubYear - ) - where - -import Codec.Epub.Opf.Package -import Control.Monad -import Text.Regex - -import EpubTools.EpubName.Opts -import EpubTools.EpubName.Util - - -{- Look for publication date, return "" if none found --} -getPubYear :: Metadata -> EN String -getPubYear md = do - yearHandling <- asks optPubYear - - case yearHandling of - Publication -> getPubYear' pubAttrs - AnyDate -> getPubYear' $ pubAttrs ++ [getFirstDate] - NoDate -> return "" - - where - getPubYear' = return . maybe "" ('_' :) . foldr mplus Nothing . - map (\f -> f (metaDates md)) - - pubAttrs = - [ getDateWithAttr "publication" - , getDateWithAttr "original-publication" - ] - - -getDateWithAttr :: String -> [MetaDate] -> Maybe String -getDateWithAttr attrVal mds = foldr mplus Nothing $ map getPublication' mds - where - getPublication' (MetaDate (Just av) d) - | av == attrVal = extractYear d - getPublication' _ = Nothing - - -getFirstDate :: [MetaDate] -> Maybe String -getFirstDate ((MetaDate _ d) : _) = extractYear d -getFirstDate _ = Nothing - - -extractYear :: String -> Maybe String -extractYear s = case matchRegex (mkRegex "(^| )([0-9]{4})") s of - Just (_ : y : []) -> Just y - _ -> Nothing diff --git a/src/EpubTools/EpubName/Util.hs b/src/EpubTools/EpubName/Util.hs --- a/src/EpubTools/EpubName/Util.hs +++ b/src/EpubTools/EpubName/Util.hs @@ -3,69 +3,11 @@ -- Author: Dino Morelli module EpubTools.EpubName.Util - ( EN , runEN - , throwError - , asks - , filterCommon - ) where -import Control.Monad.Error -import Control.Monad.Reader -import Data.Char -import Data.List ( foldl' ) -import Text.Regex - -import EpubTools.EpubName.Opts - - -type EN a = ReaderT Options (ErrorT String IO) a - -runEN :: Options -> EN a -> IO (Either String a) -runEN env ev = runErrorT $ runReaderT ev env - - -{- Convenience function to make a regex replacer for a given pattern - and replacement string. Helps by doing the 'flip' of str and rpl - so you can partial eval. --} -repl :: String -> String -> String -> String -repl re rpl str = subRegex (mkRegex re) str rpl - - -{- Transforms a string like this: - "the quick brown McCheeseburger" -> "TheQuickBrownMccheeseburger" --} -capFirstAndDeSpace :: String -> String -capFirstAndDeSpace s = concat $ map capFirst $ words s - where - capFirst (first:rest) = (toUpper first) : (map toLower rest) - capFirst _ = undefined - - -{- A set of common string filters that apply to any and all parts - of every single string we process in this project. --} -commonFilters :: [(String -> String)] -commonFilters = - [ repl "[',\\?();#’]" "" - , repl "\\." " " - , repl ":" "_" - , filter (/= '"') - , repl "]" "" - , repl "\\*" "" - , repl "!" "" - , repl "-" " " - , repl "\\[" "_ " - -- Decided that I like the article included in titles - --, repl "^The " "" - , repl "&" " And " - , capFirstAndDeSpace - ] +import System.Exit -{- Utility function to apply the above commonFilters to a string, - giving you back the transformed string --} -filterCommon :: String -> String -filterCommon s = foldl' (flip id) s commonFilters +exitInitFailure, exitProcessingFailure :: ExitCode +exitInitFailure = ExitFailure 1 +exitProcessingFailure = ExitFailure 128 diff --git a/src/EpubTools/EpubZip/Opts.hs b/src/EpubTools/EpubZip/Opts.hs --- a/src/EpubTools/EpubZip/Opts.hs +++ b/src/EpubTools/EpubZip/Opts.hs @@ -68,5 +68,5 @@ , "" , "For more information please see the IDPF OPF specification found here: http://idpf.org/epub/20/spec/OPF_2.0.1_draft.htm" , "" - , "Version 1.1.2 Dino Morelli " + , "Version 2.0.0 Dino Morelli " ] diff --git a/src/EpubTools/epubname.hs b/src/EpubTools/epubname.hs --- a/src/EpubTools/epubname.hs +++ b/src/EpubTools/epubname.hs @@ -2,22 +2,28 @@ -- License: BSD3 (see LICENSE) -- Author: Dino Morelli +{-# LANGUAGE FlexibleContexts #-} + import Codec.Epub.Opf.Format.Package import Codec.Epub.Opf.Package import Codec.Epub.Opf.Parse import Control.Monad -import Control.Monad.Trans -import System.Directory ( doesFileExist, renameFile ) +import Control.Monad.Error +import System.Directory ( doesDirectoryExist, doesFileExist, renameFile ) import System.Environment ( getArgs ) +import System.FilePath import System.Exit import System.IO ( BufferMode ( NoBuffering ) - , hSetBuffering, stdout, stderr + , hSetBuffering, stdin, stdout, stderr ) import Text.Printf -import EpubTools.EpubName.Format ( tryFormatting ) +import EpubTools.EpubName.Format.Format ( Formatter (..), tryFormatting ) +import EpubTools.EpubName.Main import EpubTools.EpubName.Opts ( Options (..), parseOpts, usageText ) +import EpubTools.EpubName.Prompt ( PromptResult (..), prompt, continue ) import EpubTools.EpubName.Util +import Paths_epub_tools {- Construct additional verbose output @@ -31,11 +37,12 @@ (formatPackage False pkg) -{- Format output for a book that was processed +{- Format and display output for a book that was processed -} -makeOutput :: Options -> (FilePath, FilePath, String, Package) -> String -makeOutput opts (oldPath, newPath, fmtUsed, pkg) = - printf "%s -> %s%s" oldPath newPath +displayResults :: (MonadError String m, MonadIO m) => + Options -> FilePath -> FilePath -> String -> Package -> m () +displayResults opts oldPath newPath fmtUsed pkg = + liftIO $ printf "%s -> %s%s\n" oldPath newPath (additional (optVerbose opts) (fmtUsed, pkg)) where additional Nothing = const "" @@ -45,44 +52,101 @@ {- Process an individual epub book file -} -processBook :: Options -> FilePath -> IO Bool -processBook opts oldPath = do - result <- runEN opts $ do - pkg <- parseEpubOpf oldPath - let md = opMeta pkg - (fmtUsed, newPath) <- tryFormatting oldPath md +processBook :: Options -> [Formatter] -> [FilePath] -> Bool -> Bool + -> IO Bool - when (not $ optOverwrite opts) $ do - fileExists <- liftIO $ doesFileExist newPath - when fileExists $ throwError $ - printf "ERROR: File %s already exists!" newPath +processBook _ _ [] _ priRes = + return priRes - unless (optNoAction opts) $ liftIO $ renameFile oldPath newPath +processBook _ _ _ False priRes = + return priRes - return (oldPath, newPath, fmtUsed, pkg) +processBook opts formatters (oldPath:paths) _ priRes = do + result <- runErrorT $ do + {- Parse the book's metadata + The reason for the nested runErrorT block is, if there is + failure during parsing, we need to mark the result up with the + file path. Failures here will otherwise get lost in the output + when multiple books are processed at once. + -} + epkg <- runErrorT $ parseEpubOpf oldPath + pkg <- either + ( \msg -> throwError + $ printf "ERROR: File %s: %s" oldPath msg + ) return epkg - let (success, report) = either ((,) False) - (\r -> (True, makeOutput opts r)) result - putStrLn report - return success + (fmtUsed, shortPath) <- + tryFormatting opts formatters (opMeta pkg) oldPath + let newPath = optTargetDir opts shortPath + fileExists <- liftIO $ doesFileExist newPath + when fileExists $ throwError $ + printf "File %s already exists. No change." newPath + + displayResults opts oldPath newPath fmtUsed pkg + + promptResult <- liftIO $ case (optInteractive opts) of + True -> prompt + False -> return Yes + + when ((promptResult == Yes) && (optNoAction opts == False)) $ + liftIO $ renameFile oldPath newPath + + return $ continue promptResult + + (thisRes, cont) <- either (\errmsg -> do + putStrLn errmsg + return (False, True) + ) + (\c -> return (True, c)) + result + + let newRes = case (priRes, thisRes) of + (False, _) -> False + (_ , r) -> r + + processBook opts formatters paths cont newRes + + main :: IO () main = do -- No buffering, it messes with the order of output - mapM_ (flip hSetBuffering NoBuffering) [ stdout, stderr ] + mapM_ (flip hSetBuffering NoBuffering) [ stdout, stderr, stdin ] - (opts, paths) <- getArgs >>= parseOpts >>= either exitWith return + either exitWith exitWith =<< (runErrorT $ do + -- Parse command-line arguments + (opts, paths) <- (liftIO getArgs) >>= parseOpts - ec <- if ((optHelp opts) || (null paths)) - then do - putStrLn usageText - return ExitSuccess - else do - when (optNoAction opts) (putStrLn "No-action specified") - codes <- mapM (processBook opts) paths - case all id codes of - True -> return ExitSuccess - False -> return . ExitFailure $ 2 + -- User asked for rules help, this is a special termination case + when (optHelpRules opts) $ do + liftIO $ do + rulesHelpPath <- getDataFileName "epubname-dsl-docs" + readFile rulesHelpPath >>= putStrLn + throwError ExitSuccess - exitWith ec + -- User asked for help, this is a special termination case + when ((optHelp opts) || (null paths)) $ do + liftIO $ usageText >>= putStrLn + throwError ExitSuccess + + let targetDir = optTargetDir opts + targetDirExists <- liftIO $ doesDirectoryExist targetDir + unless targetDirExists $ do + _ <- liftIO $ printf + "ERROR: Target directory doesn't exist: %s\n" targetDir + throwError exitInitFailure + + -- Locate the rules file, load it and parse into a list of + -- formatters + fs <- initialize opts + + when (optNoAction opts) $ liftIO + $ putStrLn "No-action specified" + + -- Perform the formatting operation on the books + code <- liftIO $ processBook opts fs paths True True + case code of + True -> return ExitSuccess + False -> throwError exitProcessingFailure + ) diff --git a/src/EpubTools/epubzip.hs b/src/EpubTools/epubzip.hs --- a/src/EpubTools/epubzip.hs +++ b/src/EpubTools/epubzip.hs @@ -7,52 +7,73 @@ import Codec.Epub.Opf.Package import Codec.Epub.Opf.Parse import Control.Monad +import Control.Monad.Error import System.Directory import System.Environment import System.Exit import System.FilePath +import System.IO ( BufferMode ( NoBuffering ) + , hSetBuffering, stdout, stderr + ) import Text.Printf -import EpubTools.EpubName.Format ( tryFormatting ) +import EpubTools.EpubName.Format.Format ( tryFormatting ) +import EpubTools.EpubName.Main import qualified EpubTools.EpubName.Opts as EN -import EpubTools.EpubName.Util ( runEN ) import EpubTools.EpubZip.Opts -exitFail :: String -> IO () -exitFail msg = do - putStrLn msg - exitWith $ ExitFailure 1 - - main :: IO () main = do - (opts, paths) <- getArgs >>= parseOpts + -- No buffering, it messes with the order of output + mapM_ (flip hSetBuffering NoBuffering) [ stdout, stderr ] - when ((optHelp opts) || (null paths)) $ exitFail usageText + either exitWith exitWith =<< (runErrorT $ do + -- Parse command-line arguments + (opts, paths) <- liftIO $ getArgs >>= parseOpts - let inputPath = head paths - isDir <- doesDirectoryExist inputPath - en <- if isDir - then runEN EN.defaultOptions $ do - package <- do - (_, contents) <- opfContentsFromDir "." - parseXmlToOpf contents - (_, newPath) <- tryFormatting - "CURRENT DIRECTORY" $ opMeta package - return $ inputPath newPath - else return . Right $ inputPath + -- User asked for help, this is a special termination case + when ((optHelp opts) || (null paths)) $ do + liftIO $ putStrLn usageText + throwError ExitSuccess - case en of - Right zipPath -> do - exists <- doesFileExist zipPath - when ((not . optOverwrite $ opts) && exists) $ do - exitFail $ - printf "File %s exists, use --overwrite to force" zipPath + let inputPath = head paths + isDir <- liftIO $ doesDirectoryExist inputPath - archive <- mkEpubArchive "." - writeArchive zipPath archive + en <- if isDir + then do + dos <- liftIO EN.defaultOptions + fs <- initialize dos + runErrorT $ do + package <- do + (_, contents) <- opfContentsFromDir "." + parseXmlToOpf contents - printf "Book created: %s\n" zipPath + (_, newPath) <- tryFormatting dos fs + (opMeta package) "CURRENT DIRECTORY" - Left errorMsg -> exitFail errorMsg + return $ inputPath newPath + else return . Right $ inputPath + + case en of + Right zipPath -> do + exists <- liftIO $ doesFileExist zipPath + if ((not . optOverwrite $ opts) && exists) + then do + _ <- liftIO $ printf + "File %s exists, use --overwrite to force\n" + zipPath + throwError $ ExitFailure 1 + else liftIO $ removeFile zipPath + + _ <- liftIO $ do + archive <- mkEpubArchive "." + writeArchive zipPath archive + printf "Book created: %s\n" zipPath + + return ExitSuccess + + Left errorMsg -> do + liftIO $ putStrLn errorMsg + throwError $ ExitFailure 1 + ) diff --git a/testsuite/EpubTools/Test/EpubName/Format.hs b/testsuite/EpubTools/Test/EpubName/Format.hs --- a/testsuite/EpubTools/Test/EpubName/Format.hs +++ b/testsuite/EpubTools/Test/EpubName/Format.hs @@ -7,119 +7,118 @@ ) where -import Codec.Epub.Opf.Package.Metadata +import Codec.Epub.Opf.Package +import Control.Monad.Error import Test.HUnit ( Test (..), assertEqual ) import Test.HUnit.Base ( Assertion ) -import EpubTools.EpubName.Format ( tryFormatting ) +import EpubTools.EpubName.Format.Format import EpubTools.EpubName.Opts -import EpubTools.EpubName.Util -formatTests :: Test -formatTests = TestLabel "Format" $ TestList - [ testAuthorMinimal - , testAuthorOneName - , testAuthorRole - , testAuthorFileas - , testAuthorFull - , testAuthorSeveral - , testSeveralAuthors - , testNoAuthor - , testCreatorsNoAuthor - , testCreatorsNoAuthorPubDate - , testCapsTitle - , testColon - , testBracketTitle - , testNoTitle - , testAllPunctuation - , testPubYear - , testPubYearAny - , testPubYearUnwanted - , testMagAeon - , testMagAEon - , testMagApexLong - , testMagApexShort - , testChallengingDestinyShort - , testChallengingDestinyLong - , testAnalog - , testAsimovs - , testFantasyMagazine - , testFsfShort - , testFsfLong - , testFsfAmpersand - , testMagFutureOrbits - , testGudShort - , testGudLong - , testGudVeryLong - , testInterzoneShort - , testInterzoneLong - , testNemesisShort - , testNemesisLong - , testMagSomethingWicked - , testMagSomethingWickedMonth - , testSFBestOf - , testBestSF - , testYearsBest - , testMagBlackStatic - , testRageMachineMag - , testEclipseMag - , testEclipseMagNum - , testBcs - , testBkpFileAs - , testBkpText - , testBkpMissing - , testMagUniverse - , testMagClarkesworld - , testLightspeedDate - , testLightspeedIssue - , testMagWeirdTales - ] +formatTests :: Options -> [Formatter] -> Test +formatTests opts fs = TestLabel "Format" $ TestList $ + map (\f -> f (opts, fs)) + [ testAuthorMinimal + , testAuthorOneName + , testAuthorRole + , testAuthorFileas + , testAuthorFull + , testAuthorSeveral + , testSeveralAuthors + , testNoAuthor + , testCreatorsNoAuthor + , testCreatorsNoAuthorPubDate + , testCapsTitle + , testColon + , testBracketTitle + , testNoTitle + , testAllPunctuation + , testPubYear + , testPubYearAny + , testPubYearUnwanted + , testMagAeon + , testMagAEon + , testMagApexLong + , testMagApexShort + , testChallengingDestinyShort + , testChallengingDestinyLong + , testAnalog + , testAsimovs + , testFantasyMagazine + , testFsfShort + , testFsfShortComma + , testFsfLong + , testFsfAmpersand + , testFsfAmpersandSpaces + , testMagFutureOrbits + , testGudShort + , testGudLong + , testGudVeryLong + , testInterzoneShort + , testInterzoneLong + , testNemesisShort + , testNemesisLong + , testMagSomethingWicked + , testMagSomethingWickedMonth + , testSFBestOf + , testBestSF + , testYearsBest + , testMagBlackStatic + , testRageMachineMag + , testEclipseMagWord + , testEclipseMagNum + , testBcs + , testBkpFileAs + , testBkpText + , testBkpMissing + , testMagUniverse + , testMagClarkesworld + , testLightspeedDate + , testLightspeedIssue + , testMagWeirdTales + ] -assertNewNameOpts :: Options -> String -> Metadata +assertNewName :: Options -> [Formatter] -> String -> Metadata -> (String, String) -> Assertion -assertNewNameOpts opts desc meta expected = do - result <- runEN opts $ tryFormatting "" meta +assertNewName opts fs desc meta expected = do + result <- runErrorT $ tryFormatting opts fs meta "" let actual = either (\em -> ("NO FORMATTER", em)) id result assertEqual desc expected actual -assertNewName :: String -> Metadata -> (String, String) -> Assertion -assertNewName = assertNewNameOpts defaultOptions - - -testAuthorMinimal :: Test -testAuthorMinimal = TestCase $ - assertNewName "minimal author" meta expected +testAuthorMinimal :: (Options, [Formatter]) -> Test +testAuthorMinimal (opts, fs) = TestCase $ + assertNewName opts fs "minimal author" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Herman Melville"] , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "MelvilleHerman-MobyDick.epub" ) -testAuthorOneName :: Test -testAuthorOneName = TestCase $ - assertNewName "author is a single word" meta expected +testAuthorOneName :: (Options, [Formatter]) -> Test +testAuthorOneName (opts, fs) = TestCase $ + assertNewName opts fs "author is a single word" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Melville"] , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "Melville-MobyDick.epub" ) -testAuthorRole :: Test -testAuthorRole = TestCase $ - assertNewName "author with role" meta expected +testAuthorRole :: (Options, [Formatter]) -> Test +testAuthorRole (opts, fs) = TestCase $ + assertNewName opts fs "author with role" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing @@ -127,14 +126,14 @@ , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "MelvilleHerman-MobyDick.epub" ) -testAuthorFileas :: Test -testAuthorFileas = TestCase $ - assertNewName "author with file-as" meta expected +testAuthorFileas :: (Options, [Formatter]) -> Test +testAuthorFileas (opts, fs) = TestCase $ + assertNewName opts fs "author with file-as" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing @@ -143,14 +142,14 @@ , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "MelvilleHerman-MobyDick.epub" ) -testAuthorFull :: Test -testAuthorFull = TestCase $ - assertNewName "author fully filled out" meta expected +testAuthorFull :: (Options, [Formatter]) -> Test +testAuthorFull (opts, fs) = TestCase $ + assertNewName opts fs "author fully filled out" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") @@ -159,14 +158,14 @@ , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "MelvilleHerman-MobyDick.epub" ) -testAuthorSeveral :: Test -testAuthorSeveral = TestCase $ - assertNewName "several authors" meta expected +testAuthorSeveral :: (Options, [Formatter]) -> Test +testAuthorSeveral (opts, fs) = TestCase $ + assertNewName opts fs "several authors" meta expected where meta = emptyMetadata { metaCreators = @@ -181,14 +180,14 @@ "Ninety Percent of Everything"] } expected = - ( "book" + ( "ordinary_book" , "Kelly_Kessel_Lethem-NinetyPercentOfEverything.epub" ) -testNoAuthor :: Test -testNoAuthor = TestCase $ - assertNewName "no creator(s) at all" meta expected +testNoAuthor :: (Options, [Formatter]) -> Test +testNoAuthor (opts, fs) = TestCase $ + assertNewName opts fs "no creator(s) at all" meta expected where meta = emptyMetadata { metaCreators = [] @@ -196,14 +195,14 @@ "Some Collection of Fine Stories, Volume 1"] } expected = - ( "book" + ( "ordinary_book" , "SomeCollectionOfFineStoriesVolume1.epub" ) -testCreatorsNoAuthor :: Test -testCreatorsNoAuthor = TestCase $ - assertNewName "creators, but no author(s) at all" meta expected +testCreatorsNoAuthor :: (Options, [Formatter]) -> Test +testCreatorsNoAuthor (opts, fs) = TestCase $ + assertNewName opts fs "creators, but no author(s) at all" meta expected where meta = emptyMetadata { metaCreators = @@ -216,14 +215,14 @@ "Some Collection of Fine Stories, Volume 1"] } expected = - ( "book" + ( "ordinary_book" , "SomeCollectionOfFineStoriesVolume1.epub" ) -testCreatorsNoAuthorPubDate :: Test -testCreatorsNoAuthorPubDate = TestCase $ - assertNewName "creators, but no author(s) at all, with pub date" +testCreatorsNoAuthorPubDate :: (Options, [Formatter]) -> Test +testCreatorsNoAuthorPubDate (opts, fs) = TestCase $ + assertNewName opts fs "creators, but no author(s) at all, with pub date" meta expected where meta = emptyMetadata @@ -239,14 +238,14 @@ "2008"] } expected = - ( "book" + ( "ordinary_book" , "SomeCollectionOfFineStoriesVolume1_2008.epub" ) -testSeveralAuthors :: Test -testSeveralAuthors = TestCase $ - assertNewName "more than one author separated by & and/or and" meta expected +testSeveralAuthors :: (Options, [Formatter]) -> Test +testSeveralAuthors (opts, fs) = TestCase $ + assertNewName opts fs "more than one author separated by & and/or and" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -254,28 +253,28 @@ , metaTitles = [MetaTitle Nothing "Big Trouble"] } expected = - ( "book" + ( "ordinary_book" , "Anderson_Tunglewacker_Milner-BigTrouble.epub" ) -testCapsTitle :: Test -testCapsTitle = TestCase $ - assertNewName "title all caps" meta expected +testCapsTitle :: (Options, [Formatter]) -> Test +testCapsTitle (opts, fs) = TestCase $ + assertNewName opts fs "title all caps" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Greg Bear"] , metaTitles = [MetaTitle Nothing "EON"] } expected = - ( "book" + ( "ordinary_book" , "BearGreg-Eon.epub" ) -testColon :: Test -testColon = TestCase $ - assertNewName "colon becomes underscore" meta expected +testColon :: (Options, [Formatter]) -> Test +testColon (opts, fs) = TestCase $ + assertNewName opts fs "colon becomes underscore" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Ed Howdershelt"] @@ -283,28 +282,28 @@ "Book 1: 3rd World Products, Inc."] } expected = - ( "book" + ( "ordinary_book" , "HowdersheltEd-Book1_3rdWorldProductsInc.epub" ) -testBracketTitle :: Test -testBracketTitle = TestCase $ - assertNewName "title with brackets" meta expected +testBracketTitle :: (Options, [Formatter]) -> Test +testBracketTitle (opts, fs) = TestCase $ + assertNewName opts fs "title with brackets" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Mercedes Lackey"] , metaTitles = [MetaTitle Nothing "SKitty [Shipscat series #1]"] } expected = - ( "book" + ( "ordinary_book" , "LackeyMercedes-Skitty_ShipscatSeries1.epub" ) -testNoTitle :: Test -testNoTitle = TestCase $ - assertNewName "missing title" meta expected +testNoTitle :: (Options, [Formatter]) -> Test +testNoTitle (opts, fs) = TestCase $ + assertNewName opts fs "missing title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -316,25 +315,25 @@ ) -testAllPunctuation :: Test -testAllPunctuation = TestCase $ - assertNewName "big test of all punctuation" meta expected +testAllPunctuation :: (Options, [Formatter]) -> Test +testAllPunctuation (opts, fs) = TestCase $ + assertNewName opts fs "big test of all punctuation" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Dino Morelli"] , metaTitles = [MetaTitle Nothing - "The *crazy*: Sand-box. Of Smedley's discontent, fear & Malnourishment? (Maybe not!); [Part #2]"] + "The *crazy*: Sand-box. Of Smedley's discontent/loathing, fear & Malnourishment? (Maybe not!); [Part #2]"] } expected = - ( "book" - , "MorelliDino-TheCrazy_SandBoxOfSmedleysDiscontentFearAndMalnourishmentMaybeNot_Part2.epub" + ( "ordinary_book" + , "MorelliDino-TheCrazy_SandBoxOfSmedleysDiscontentLoathingFearAndMalnourishmentMaybeNot_Part2.epub" ) -testPubYear :: Test -testPubYear = TestCase $ - assertNewName "book with a publication year" meta expected +testPubYear :: (Options, [Formatter]) -> Test +testPubYear (opts, fs) = TestCase $ + assertNewName opts fs "book with a publication year" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Jim Jones"] @@ -342,50 +341,50 @@ , metaDates = [MetaDate (Just "publication") "2003"] } expected = - ( "book" + ( "ordinary_book" , "JonesJim-ATimelessStory_2003.epub" ) -testPubYearAny :: Test -testPubYearAny = TestCase $ - assertNewNameOpts opts +testPubYearAny :: (Options, [Formatter]) -> Test +testPubYearAny (opts, fs) = TestCase $ + assertNewName testOpts fs "book with original-publication attr and --any-date" meta expected where - opts = defaultOptions { optPubYear = AnyDate } + testOpts = opts { optPubYear = AnyDate } meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Jim Jones"] , metaTitles = [MetaTitle Nothing "A Timeless Story"] , metaDates = [MetaDate (Just "original-publication") "2003"] } expected = - ( "book" + ( "ordinary_book" , "JonesJim-ATimelessStory_2003.epub" ) -testPubYearUnwanted :: Test -testPubYearUnwanted = TestCase $ - assertNewNameOpts opts +testPubYearUnwanted :: (Options, [Formatter]) -> Test +testPubYearUnwanted (opts, fs) = TestCase $ + assertNewName testOpts fs "book with a publication year but we don't want" meta expected where - opts = defaultOptions { optPubYear = NoDate } + testOpts = opts { optPubYear = NoDate } meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Jim Jones"] , metaTitles = [MetaTitle Nothing "A Timeless Story"] , metaDates = [MetaDate (Just "original-publication") "2003"] } expected = - ( "book" + ( "ordinary_book" , "JonesJim-ATimelessStory.epub" ) -testMagAeon :: Test -testMagAeon = TestCase $ - assertNewName "Aeon magazine" meta expected +testMagAeon :: (Options, [Formatter]) -> Test +testMagAeon (opts, fs) = TestCase $ + assertNewName opts fs "Aeon magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Aeon Authors"] @@ -397,9 +396,9 @@ ) -testMagAEon :: Test -testMagAEon = TestCase $ - assertNewName "AEon magazine" meta expected +testMagAEon :: (Options, [Formatter]) -> Test +testMagAEon (opts, fs) = TestCase $ + assertNewName opts fs "AEon magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "AEon Authors"] @@ -411,9 +410,9 @@ ) -testMagApexLong :: Test -testMagApexLong = TestCase $ - assertNewName "Apex Magazine, older, long title" meta expected +testMagApexLong :: (Options, [Formatter]) -> Test +testMagApexLong (opts, fs) = TestCase $ + assertNewName opts fs "Apex Magazine, older, long title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing @@ -427,9 +426,9 @@ ) -testMagApexShort :: Test -testMagApexShort = TestCase $ - assertNewName "Apex Magazine, newer, short title" meta expected +testMagApexShort :: (Options, [Formatter]) -> Test +testMagApexShort (opts, fs) = TestCase $ + assertNewName opts fs "Apex Magazine, newer, short title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing @@ -443,9 +442,10 @@ ) -testChallengingDestinyShort :: Test -testChallengingDestinyShort = TestCase $ - assertNewName "Challenging Destiny Magazine, short title" meta expected +testChallengingDestinyShort :: (Options, [Formatter]) -> Test +testChallengingDestinyShort (opts, fs) = TestCase $ + assertNewName opts fs + "Challenging Destiny Magazine, short title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -459,9 +459,10 @@ ) -testChallengingDestinyLong :: Test -testChallengingDestinyLong = TestCase $ - assertNewName "Challenging Destiny Magazine, long title" meta expected +testChallengingDestinyLong :: (Options, [Formatter]) -> Test +testChallengingDestinyLong (opts, fs) = TestCase $ + assertNewName opts fs + "Challenging Destiny Magazine, long title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -475,9 +476,9 @@ ) -testAnalog :: Test -testAnalog = TestCase $ - assertNewName "Analog" meta expected +testAnalog :: (Options, [Formatter]) -> Test +testAnalog (opts, fs) = TestCase $ + assertNewName opts fs "Analog" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -491,9 +492,9 @@ ) -testAsimovs :: Test -testAsimovs = TestCase $ - assertNewName "Asimovs" meta expected +testAsimovs :: (Options, [Formatter]) -> Test +testAsimovs (opts, fs) = TestCase $ + assertNewName opts fs "Asimovs" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -506,9 +507,9 @@ , "AsimovsSF2003-08.epub" ) -testFantasyMagazine :: Test -testFantasyMagazine = TestCase $ - assertNewName "Fantasy Magazine" meta expected +testFantasyMagazine :: (Options, [Formatter]) -> Test +testFantasyMagazine (opts, fs) = TestCase $ + assertNewName opts fs "Fantasy Magazine" meta expected where meta = emptyMetadata { metaCreators = @@ -529,13 +530,28 @@ ) -testFsfShort :: Test -testFsfShort = TestCase $ - assertNewName "FSF Magazine, short" meta expected +testFsfShort :: (Options, [Formatter]) -> Test +testFsfShort (opts, fs) = TestCase $ + assertNewName opts fs "FSF Magazine, short" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Spilogale Authors"] + , metaTitles = [MetaTitle Nothing "FSF Oct/Nov 2003"] + } + expected = + ( "magFsf" + , "FantasyScienceFiction2003-10_11.epub" + ) + + +testFsfShortComma :: (Options, [Formatter]) -> Test +testFsfShortComma (opts, fs) = TestCase $ + assertNewName opts fs "FSF Magazine, short, comma" meta expected + where + meta = emptyMetadata + { metaCreators = [MetaCreator Nothing Nothing + "Spilogale Authors"] , metaTitles = [MetaTitle Nothing "FSF, April 2008"] } expected = @@ -544,9 +560,9 @@ ) -testFsfLong :: Test -testFsfLong = TestCase $ - assertNewName "FSF Magazine, long" meta expected +testFsfLong :: (Options, [Formatter]) -> Test +testFsfLong (opts, fs) = TestCase $ + assertNewName opts fs "FSF Magazine, long" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -560,13 +576,28 @@ ) -testFsfAmpersand :: Test -testFsfAmpersand = TestCase $ - assertNewName "FSF Magazine, ampersand" meta expected +testFsfAmpersand :: (Options, [Formatter]) -> Test +testFsfAmpersand (opts, fs) = TestCase $ + assertNewName opts fs "FSF Magazine, ampersand" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing "Spilogale"] + , metaTitles = [MetaTitle Nothing "F&SF, Apr 2004"] + } + expected = + ( "magFsf" + , "FantasyScienceFiction2004-04.epub" + ) + + +testFsfAmpersandSpaces :: (Options, [Formatter]) -> Test +testFsfAmpersandSpaces (opts, fs) = TestCase $ + assertNewName opts fs "FSF Magazine, ampersand, spaces" meta expected + where + meta = emptyMetadata + { metaCreators = [MetaCreator Nothing Nothing + "Spilogale"] , metaTitles = [MetaTitle Nothing "F & SF Dec 2003"] } expected = @@ -575,9 +606,9 @@ ) -testMagFutureOrbits :: Test -testMagFutureOrbits = TestCase $ - assertNewName "testMagFutureOrbits" meta expected +testMagFutureOrbits :: (Options, [Formatter]) -> Test +testMagFutureOrbits (opts, fs) = TestCase $ + assertNewName opts fs "testMagFutureOrbits" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -591,9 +622,9 @@ ) -testGudShort :: Test -testGudShort = TestCase $ - assertNewName "Gud Magazine, short" meta expected +testGudShort :: (Options, [Formatter]) -> Test +testGudShort (opts, fs) = TestCase $ + assertNewName opts fs "Gud Magazine, short" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -607,9 +638,9 @@ ) -testGudLong :: Test -testGudLong = TestCase $ - assertNewName "Gud Magazine, long" meta expected +testGudLong :: (Options, [Formatter]) -> Test +testGudLong (opts, fs) = TestCase $ + assertNewName opts fs "Gud Magazine, long" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -623,9 +654,9 @@ ) -testGudVeryLong :: Test -testGudVeryLong = TestCase $ - assertNewName "Gud Magazine, very long" meta expected +testGudVeryLong :: (Options, [Formatter]) -> Test +testGudVeryLong (opts, fs) = TestCase $ + assertNewName opts fs "Gud Magazine, very long" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -639,9 +670,9 @@ ) -testInterzoneShort :: Test -testInterzoneShort = TestCase $ - assertNewName "Interzone Magazine, short" meta expected +testInterzoneShort :: (Options, [Formatter]) -> Test +testInterzoneShort (opts, fs) = TestCase $ + assertNewName opts fs "Interzone Magazine, short" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -655,9 +686,9 @@ ) -testInterzoneLong :: Test -testInterzoneLong = TestCase $ - assertNewName "Interzone Magazine, long" meta expected +testInterzoneLong :: (Options, [Formatter]) -> Test +testInterzoneLong (opts, fs) = TestCase $ + assertNewName opts fs "Interzone Magazine, long" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -671,9 +702,9 @@ ) -testNemesisShort :: Test -testNemesisShort = TestCase $ - assertNewName "Nemesis Magazine, short" meta expected +testNemesisShort :: (Options, [Formatter]) -> Test +testNemesisShort (opts, fs) = TestCase $ + assertNewName opts fs "Nemesis Magazine, short" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -687,9 +718,9 @@ ) -testNemesisLong :: Test -testNemesisLong = TestCase $ - assertNewName "Nemesis Magazine, long" meta expected +testNemesisLong :: (Options, [Formatter]) -> Test +testNemesisLong (opts, fs) = TestCase $ + assertNewName opts fs "Nemesis Magazine, long" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -703,9 +734,9 @@ ) -testMagSomethingWicked :: Test -testMagSomethingWicked = TestCase $ - assertNewName "Something Wicked Magazine" meta expected +testMagSomethingWicked :: (Options, [Formatter]) -> Test +testMagSomethingWicked (opts, fs) = TestCase $ + assertNewName opts fs "Something Wicked Magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -719,9 +750,9 @@ ) -testMagSomethingWickedMonth :: Test -testMagSomethingWickedMonth = TestCase $ - assertNewName "Something Wicked Magazine, month in title" meta expected +testMagSomethingWickedMonth :: (Options, [Formatter]) -> Test +testMagSomethingWickedMonth (opts, fs) = TestCase $ + assertNewName opts fs "Something Wicked Magazine, month in title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") @@ -736,9 +767,9 @@ ) -testSFBestOf :: Test -testSFBestOf = TestCase $ - assertNewName "Science Fiction: The Best of the Year" meta expected +testSFBestOf :: (Options, [Formatter]) -> Test +testSFBestOf (opts, fs) = TestCase $ + assertNewName opts fs "Science Fiction: The Best of the Year" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -752,9 +783,9 @@ ) -testBestSF :: Test -testBestSF = TestCase $ - assertNewName "The Best Science Fiction and Fantasy of the Year" +testBestSF :: (Options, [Formatter]) -> Test +testBestSF (opts, fs) = TestCase $ + assertNewName opts fs "The Best Science Fiction and Fantasy of the Year" meta expected where meta = emptyMetadata @@ -770,9 +801,9 @@ ) -testYearsBest :: Test -testYearsBest = TestCase $ - assertNewName "The Year's Best SF" meta expected +testYearsBest :: (Options, [Formatter]) -> Test +testYearsBest (opts, fs) = TestCase $ + assertNewName opts fs "The Year's Best SF" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing @@ -786,9 +817,9 @@ ) -testMagBlackStatic :: Test -testMagBlackStatic = TestCase $ - assertNewName "Black Static Magazine" meta expected +testMagBlackStatic :: (Options, [Formatter]) -> Test +testMagBlackStatic (opts, fs) = TestCase $ + assertNewName opts fs "Black Static Magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator Nothing Nothing @@ -802,9 +833,9 @@ ) -testRageMachineMag :: Test -testRageMachineMag = TestCase $ - assertNewName "Rage Machine Magazine" meta expected +testRageMachineMag :: (Options, [Formatter]) -> Test +testRageMachineMag (opts, fs) = TestCase $ + assertNewName opts fs "Rage Machine Magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "edt") Nothing @@ -818,9 +849,9 @@ ) -testEclipseMag :: Test -testEclipseMag = TestCase $ - assertNewName "Eclipse Magazine" meta expected +testEclipseMagWord :: (Options, [Formatter]) -> Test +testEclipseMagWord (opts, fs) = TestCase $ + assertNewName opts fs "Eclipse Magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") @@ -830,14 +861,14 @@ "Eclipse One"] } expected = - ( "magEclipse" + ( "magEclipse_word" , "Eclipse01.epub" ) -testEclipseMagNum :: Test -testEclipseMagNum = TestCase $ - assertNewName "Eclipse Magazine" meta expected +testEclipseMagNum :: (Options, [Formatter]) -> Test +testEclipseMagNum (opts, fs) = TestCase $ + assertNewName opts fs "Eclipse Magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") @@ -847,14 +878,14 @@ "Eclipse 4: New Science Fiction and Fantasy"] } expected = - ( "magEclipse" + ( "magEclipse_num" , "Eclipse04.epub" ) -testBcs :: Test -testBcs = TestCase $ - assertNewName "Beneath Ceaseless Skies Magazine" meta expected +testBcs :: (Options, [Formatter]) -> Test +testBcs (opts, fs) = TestCase $ + assertNewName opts fs "Beneath Ceaseless Skies Magazine" meta expected where meta = emptyMetadata { metaCreators = @@ -874,13 +905,13 @@ ) -testBkpFileAs :: Test -testBkpFileAs = TestCase $ - assertNewNameOpts opts +testBkpFileAs :: (Options, [Formatter]) -> Test +testBkpFileAs (opts, fs) = TestCase $ + assertNewName testOpts fs "book publisher suffix requested and present in file-as" meta expected where - opts = defaultOptions { optPublisher = True } + testOpts = opts { optPublisher = True } meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing "Herman Melville"] @@ -889,18 +920,18 @@ , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "MelvilleHerman-MobyDick_acme.epub" ) -testBkpText :: Test -testBkpText = TestCase $ - assertNewNameOpts opts +testBkpText :: (Options, [Formatter]) -> Test +testBkpText (opts, fs) = TestCase $ + assertNewName testOpts fs "book publisher suffix requested and present in text" meta expected where - opts = defaultOptions { optPublisher = True } + testOpts = opts { optPublisher = True } meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing "Herman Melville"] @@ -909,36 +940,36 @@ , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "MelvilleHerman-MobyDick.epub" ) -testBkpMissing :: Test -testBkpMissing = TestCase $ - assertNewNameOpts opts +testBkpMissing :: (Options, [Formatter]) -> Test +testBkpMissing (opts, fs) = TestCase $ + assertNewName testOpts fs "book publisher suffix requested and not present" meta expected where - opts = defaultOptions { optPublisher = True } + testOpts = opts { optPublisher = True } meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing "Herman Melville"] , metaTitles = [MetaTitle Nothing "Moby Dick"] } expected = - ( "book" + ( "ordinary_book" , "MelvilleHerman-MobyDick.epub" ) -testMagUniverse :: Test -testMagUniverse = TestCase $ - assertNewNameOpts opts +testMagUniverse :: (Options, [Formatter]) -> Test +testMagUniverse (opts, fs) = TestCase $ + assertNewName testOpts fs "Jim Baen's Universe Magazine" meta expected where - opts = defaultOptions { optPublisher = True } + testOpts = opts { optPublisher = True } meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing "Jim Baen's Universe"] @@ -950,9 +981,9 @@ ) -testMagClarkesworld :: Test -testMagClarkesworld = TestCase $ - assertNewName "Clarkesworld Magazine" meta expected +testMagClarkesworld :: (Options, [Formatter]) -> Test +testMagClarkesworld (opts, fs) = TestCase $ + assertNewName opts fs "Clarkesworld Magazine" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") @@ -967,9 +998,9 @@ ) -testLightspeedDate :: Test -testLightspeedDate = TestCase $ - assertNewName "Lightspeed Magazine, date in title" meta expected +testLightspeedDate :: (Options, [Formatter]) -> Test +testLightspeedDate (opts, fs) = TestCase $ + assertNewName opts fs "Lightspeed Magazine, date in title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") Nothing @@ -978,14 +1009,15 @@ "Lightspeed Magazine, June 2010"] } expected = - ( "magLightspeedDate" + ( "magLightspeed_date" , "Lightspeed2010-06.epub" ) -testLightspeedIssue :: Test -testLightspeedIssue = TestCase $ - assertNewName "Lightspeed Magazine, issue number in title" meta expected +testLightspeedIssue :: (Options, [Formatter]) -> Test +testLightspeedIssue (opts, fs) = TestCase $ + assertNewName opts fs + "Lightspeed Magazine, issue number in title" meta expected where meta = emptyMetadata { metaCreators = [MetaCreator (Just "aut") (Just "Magazine, Lightspeed & Clark, Maggie & Valentine, Genevieve & Baxter, Stephen & Okorafor, Nnedi & Wilison, Daniel H. & Reed, Robert & Sedia, Ekaterina") "Lightspeed Magazine"] @@ -993,14 +1025,14 @@ "Lightspeed Magazine Issue 10"] } expected = - ( "magLightspeedIssue" + ( "magLightspeed_issue" , "Lightspeed010.epub" ) -testMagWeirdTales :: Test -testMagWeirdTales = TestCase $ - assertNewName "Weird Tales magazine" meta expected +testMagWeirdTales :: (Options, [Formatter]) -> Test +testMagWeirdTales (opts, fs) = TestCase $ + assertNewName opts fs "Weird Tales magazine" meta expected where meta = emptyMetadata { metaCreators = diff --git a/testsuite/EpubTools/Test/EpubName/PubYear.hs b/testsuite/EpubTools/Test/EpubName/PubYear.hs --- a/testsuite/EpubTools/Test/EpubName/PubYear.hs +++ b/testsuite/EpubTools/Test/EpubName/PubYear.hs @@ -9,7 +9,7 @@ import Test.HUnit ( Test (..), assertEqual ) -import EpubTools.EpubName.PubYear +import EpubTools.EpubName.Format.PubYear pubYearTests :: Test diff --git a/testsuite/EpubTools/test-epubname.hs b/testsuite/EpubTools/test-epubname.hs --- a/testsuite/EpubTools/test-epubname.hs +++ b/testsuite/EpubTools/test-epubname.hs @@ -5,16 +5,28 @@ module Main where +import Control.Monad.Error import System.Exit import Test.HUnit ( Counts (..), Test (..), runTestTT ) +import EpubTools.EpubName.Format.Format +import EpubTools.EpubName.Main +import EpubTools.EpubName.Opts import EpubTools.Test.EpubName.Format import EpubTools.Test.EpubName.PubYear main :: IO () main = do - counts <- runTestTT tests + dos <- defaultOptions + let testOpts = dos { optRulesPaths = ["resources/default.rules"] } + ir <- runErrorT $ initialize testOpts + either (exitWith) (runTests testOpts) ir + + +runTests :: Options -> [Formatter] -> IO () +runTests opts fs = do + counts <- runTestTT $ tests opts fs exit $ testsPassed counts @@ -27,8 +39,8 @@ testsPassed (Counts _ _ e f) = (e == 0) && (f == 0) -tests :: Test -tests = TestList - [ formatTests +tests :: Options -> [Formatter] -> Test +tests opts fs = TestList + [ formatTests opts fs , pubYearTests ]