diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ import Distribution.Simple -main = defaultMainWithHooks defaultUserHooks +main = defaultMain diff --git a/classify.cabal b/classify.cabal --- a/classify.cabal +++ b/classify.cabal @@ -1,13 +1,13 @@ -Name: classify -Version: 2007.6.26 -Copyright: 2004-2007, Lemmih -Build-Depends: base, mtl -License: BSD3 -Author: Lemmih -Maintainer: Lemmih -Homepage: http://www.scannedinavian.org/~lemmih/ -Synopsis: Library for classification of files. -Category: Tool +Name: classify +Version: 2008.10.19 +Copyright: 2004-2008, Lemmih +Build-Depends: base, mtl, containers, old-time +Build-Type: Simple +License: BSD3 +Author: Lemmih +Maintainer: Lemmih +Synopsis: Library for classification of media files. +Category: Tool HS-Source-Dirs: src Exposed-Modules: Data.Classify.DataTypes, diff --git a/src/Data/Classify/DataTypes.hs b/src/Data/Classify/DataTypes.hs --- a/src/Data/Classify/DataTypes.hs +++ b/src/Data/Classify/DataTypes.hs @@ -1,5 +1,8 @@ +{-# OPTIONS -fglasgow-exts #-} module Data.Classify.DataTypes where +import Data.Typeable + data Element = Series { @@ -9,7 +12,7 @@ lastname :: LastName, score :: Int } - deriving (Eq,Read,Show) + deriving (Eq,Read,Show,Typeable) type Name = String type LastName = Name diff --git a/src/Data/Classify/Parser.hs b/src/Data/Classify/Parser.hs --- a/src/Data/Classify/Parser.hs +++ b/src/Data/Classify/Parser.hs @@ -60,20 +60,31 @@ return (currentYear, 0) ] +getDigits n + = do ds <- many1 digit + satisfy (not.isDigit) + guard (length ds <= 2) + return (read ds) + +mkDate year month day n + = do guard (month >= 1 && month <= 12) + guard (day >= 1 && day <= 31) + return (DateVersion year month day, n) + parseDateVersion = choice [ do (year, n) <- parseYear separator - month <- count 2 digit + month <- getDigits 2 separator - day <- count 2 digit - return (DateVersion year (read month) (read day), n) - , do month <- count 2 digit + day <- getDigits 2 + mkDate year month day (n+4) + , do month <- getDigits 2 separator - day <- count 2 digit + day <- getDigits 2 separator (year, n) <- parseYear - return (DateVersion year (read month) (read day), n) + mkDate year month day (n+5) +++ mkDate year day month (n+3) ] parseVersion @@ -125,7 +136,7 @@ return $ Series n v (pp t) (pp l) s where pp = trim . removeGarbage -knownExtensions = Set.fromList $ map trunc ["avi","mpg", "mpeg", "mp4", "mov","wmv","mkw"] +knownExtensions = Set.fromList $ map trunc ["avi","mpg", "mpeg", "mp4", "mov","wmv","mkw","mkv"] removeGarbage [] = [] removeGarbage ('.':xs) = ' ':removeGarbage xs diff --git a/src/Data/Classify/Rank.hs b/src/Data/Classify/Rank.hs --- a/src/Data/Classify/Rank.hs +++ b/src/Data/Classify/Rank.hs @@ -53,19 +53,32 @@ testSeries = Map.fromList [ (P.trunc t,t) | (_,t,_) <- testData] +v24 = "24" +simpsons = "The Simpsons" +colbert = "The Colbert Report" +palms = "Hidden Palms" +daily = "The Daily Show" + testData = [ ("24.S06E01.6AM.TO.7AM.PROPER.DVDRip.XviD-MEMETiC.avi", "24", Version 6 1) , ("The.Simpsons.S18E09.PROPER.PDTV.XviD-2HD.avi", "The Simpsons", Version 18 9) , ("30.Rock.S01E09.HDTV.XviD-NoTV.avi", "30 Rock", Version 1 9) , ("Cops.S19E32.HDTV.XviD-2HD.avi", "Cops", Version 19 32) , ("The.4400.S04E02.DSR.XviD-ORENJi.avi", "The 4400", Version 4 2) , ("Jay.Leno.2007.06.25.John.Edwards.HDTV.XViD-STFU.avi", "Jay Leno", DateVersion 2007 6 25) - , ("the.daily.show.06.21.07.dsr.xvid-crimson.[VTV].avi", "The Daily Show", DateVersion 2007 6 21) - , ("the.colbert.report.06.21.07.dsr.xvid-w4f.[VTV].avi", "The Colbert Report", DateVersion 2007 6 21) - , ("hidden.palms.0107-yestv.[VTV].avi", "Hidden Palms", Version 1 7) - , ("hidden.palms.0108-yestv.[VTV].avi", "Hidden Palms", Version 1 8) - , ("hidden.palms.0109-yestv.[VTV].avi", "Hidden Palms", Version 1 9) - , ("hidden.palms.0110-yestv.[VTV].avi", "Hidden Palms", Version 1 10) - , ("hidden.palms.0111-yestv.[VTV].avi", "Hidden Palms", Version 1 11) + , ("the.daily.show.06.21.07.dsr.xvid-crimson.[VTV].avi", daily, DateVersion 2007 6 21) + , ("the.colbert.report.06.21.07.dsr.xvid-w4f.[VTV].avi", colbert, DateVersion 2007 6 21) + , ("hidden.palms.0107-yestv.[VTV].avi", palms, Version 1 7) + , ("hidden.palms.0108-yestv.[VTV].avi", palms, Version 1 8) + , ("hidden.palms.0109-yestv.[VTV].avi", palms, Version 1 9) + , ("hidden.palms.0110-yestv.[VTV].avi", palms, Version 1 10) + , ("hidden.palms.0111-yestv.[VTV].avi", palms, Version 1 11) + , ("the.colbert.report.06.28.07.dsr.xvid-sys.[VTV].avi", colbert, DateVersion 2007 6 28) + , ("the.colbert.report.07.26.07.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2007 7 26) + , ("the.colbert.report.07.25.07.dsr.xvid-stfu.[VTV].avi", colbert, DateVersion 2007 7 25) + , ("the.colbert.report.09.12.07.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2007 9 12) + , ("the.colbert.report.09.13.07.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2007 9 13) + , ("the.colbert.report.9.19.07.dsr.xvid.iht.[VTV].avi", colbert, DateVersion 2007 9 19) + , ("the.daily.show.9.19.07.dsr.xvid.iht.[VTV].avi", daily, DateVersion 2007 9 19) ] runTests = flip mapM_ testData $ \(str, series, expectedVersion) -> @@ -76,8 +89,8 @@ else let best = selectBest elts v = version best in when (version best /= expectedVersion) $ - do forM (sortByRank elts) $ \elt -> - putStrLn $ "Erroneous parse: " ++ show (str, title elt, version elt) + do forM (sortByRank' elts) $ \(elt,score) -> + putStrLn $ "Erroneous parse: " ++ show (score,str, title elt, version elt) putStrLn $ "Expected: " ++ show (series, expectedVersion)