diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,35 +1,1 @@ -Copyright (c) 2008, David Himmelstrup -All rights reserved. - -Redistribution and use in source and binary forms, -with or without modification, are permitted provided -that the following conditions are met: - - * Redistributions of source code must retain - the above copyright notice, this list of - conditions and the following disclaimer. - * Redistributions in binary form must reproduce - the above copyright notice, this list of - conditions and the following disclaimer in the - documentation and/or other materials provided - with the distribution. - * Neither the name of David Himmelstrup nor the - names of other contributors may be used to - endorse or promote products derived from this - software without specific prior written permission. - - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND -CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, -INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES -OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, -BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, -WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE -USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY -OF SUCH DAMAGE. +PUBLIC DOMAIN diff --git a/classify.cabal b/classify.cabal --- a/classify.cabal +++ b/classify.cabal @@ -1,17 +1,22 @@ +Cabal-version: >=1.6 Name: classify -Version: 2008.11.17 -Copyright: 2004-2008, Lemmih -Build-Depends: base, mtl, containers +Version: 2012.10.21 Build-Type: Simple -License: BSD3 +License: PublicDomain License-File: LICENSE Author: Lemmih Maintainer: Lemmih Synopsis: Library for classification of media files. Category: Data -HS-Source-Dirs: src -Exposed-Modules: - Data.Classify.DataTypes, - Data.Classify.Rank, - Data.Classify.Parser, - Data.Classify.Printer + +Library + Build-Depends: base >= 4 && <= 5, mtl, containers + HS-Source-Dirs: src + Exposed-Modules: + Data.Classify.DataTypes, + Data.Classify.Rank, + Data.Classify.Parser, + Data.Classify.Printer +Source-repository head + type: darcs + location: http://hub.darcs.net/Lemmih/classify 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 @@ -1,4 +1,4 @@ -module Data.Classify.Parser +module Data.Classify.Parser --(parseElement,generateMarkup,module Parser) where @@ -79,8 +79,9 @@ month <- getDigits 2 separator day <- getDigits 2 - mkDate year month day (n+4) - , do month <- getDigits 2 + mkDate year month day n + , do satisfy (not.isDigit) + month <- getDigits 2 separator day <- getDigits 2 separator @@ -92,12 +93,16 @@ = choice [ parseDateVersion , do s <- many1 digit - oneOf "XxEe." - e <- many1 digit + oneOf "XxEe" + e <- many1 digit + return (makeVersion s e, 3) + , do s <- many1 digit + oneOf "." + e <- many1 digit return (makeVersion s e, 0) , do s <- count 2 digit +++ count 1 digit e <- count 2 digit - return (makeVersion s e, 0) + return (makeVersion s e, negate 2) , do oneOf "sS" s <- many1 digit oneOf "Ee" @@ -110,37 +115,35 @@ trunc xs = [ toLower x | x <- xs, isAlphaNum x ] -parseSeries known - = do many anyChar - nPre <- many1 anyChar - n <- case Map.lookup (trunc nPre) known of - Nothing -> fail "not known" - Just v -> return v +parseSeries known = do + many anyChar + nPre <- many1 anyChar + n <- case Map.lookup (trunc nPre) known of + Nothing -> fail "not known" + Just v -> return v -- guard (trunc n `Map.member` known) - s <- look - guard (take 2 s /= "th") -- Fix for '24th 2007.avi'. It shouldn't parse 24th as a series. - many anyChar - separator - (v,s) <- parseVersion - satisfy (not.isDigit) - separator - (t,l) <- choice - [do { t <- manyTill anyChar (do char '.' - rest <- look - if '.' `elem` rest - then pfail - else return ()) - ; l <- look - ; return (t,l) } - ,do { t <- look - ; return ("",t) }] --- guard (null $ takeWhile isDigit $ pp t) --- guard (null $ takeWhile isDigit $ pp l) - guard (trunc l `Set.member` knownExtensions) - return $ Series n v (pp t) (pp l) s - where pp = trim . removeGarbage + s <- look + guard (take 2 s /= "th") -- Fix for '24th 2007.avi'. It shouldn't parse 24th as a series. + many anyChar + separator + (v,s) <- parseVersion + satisfy (not.isDigit) + separator + (t,l) <- choice + [do { t <- manyTill anyChar (do char '.' + rest <- look + if '.' `elem` rest + then pfail + else return ()) + ; l <- look + ; return (t,l) } + ,do { t <- look + ; choice [return ("",t), return (t,"")] }] + guard (trunc l `Set.member` knownExtensions) + 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","mkv"] +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 @@ -27,24 +27,27 @@ $ groupBy (\a b -> snd a == snd b) $ sortBy (comparing snd) $ zip elts (map getRank elts) -getRank elt - = sum [ score elt, - cleanExtension ==> 2, - cleanTitle ==> 1, - unrealVersion (version elt), - numLength (version elt) - ] - where - cleanExtension = all isAlpha (lastname elt) - cleanTitle = all isAlpha (title elt) +getRank elt = + sum [ score elt, + cleanExtension ==> 2, + --cleanTitle ==> 1, + unrealVersion (version elt), + numLength (version elt) + ] + where + cleanExtension = all isAlpha (lastname elt) + cleanTitle = all isAlpha (title elt) + --cleanTitle = null (takeWhile (not . isAlpha) (title elt)) -unrealVersion (Version season episode) = sum [ episode > 0 ==> 1 - , episode > 50 ==> negate 2 - , season < 1 ==> negate 10 - , season > 30 ==> negate 1 +unrealVersion (Version season episode) = sum [ episode < 1 ==> negate 1 + , episode > 50 ==> negate 2 + , episode > 100 ==> negate 5 + , season < 1 ==> negate 10 + , season > 30 ==> negate 3 ] unrealVersion (DateVersion year month day) = 0 +numLength (Version season episode) | season < 1 || episode < 1 = 0 numLength (Version season episode) = sum [ floor $ logBase 10 (fromIntegral season) , floor $ logBase 10 (fromIntegral episode) ] numLength _ = 0 @@ -104,6 +107,7 @@ , ("Psych - 1x09 - Forget Me Not.avi", "Psych", Version 1 9) , ("south.park.1109.dsr.xvid-sys.[VTV].avi", "South Park", Version 11 9) , ("South Park - 12x09 - Breast Cancer Show Ever.avi", "South Park", Version 12 9) + , ("Merlin 2008 5x03 The Death Song Of Uther Pendragon REPACK HDTV x264-FoV", "Merlin", Version 5 3) ] runTests = flip mapM_ testData $ \(str, series, expectedVersion) -> @@ -114,8 +118,8 @@ else let best = selectBest elts v = version best in when (version best /= expectedVersion) $ - do forM (sortByRank' elts) $ \(elt,score) -> - putStrLn $ "Erroneous parse: " ++ show (score,str, title elt, version elt) + do forM (sortByRank' elts) $ \(elt,rank) -> + putStrLn $ "Erroneous parse: " ++ show (rank, score elt,str, title elt, version elt) putStrLn $ "Expected: " ++ show (series, expectedVersion)