module Data.Classify.Rank ( selectBest , sortByRank , sortByRank' ) where import Data.Classify.DataTypes import Data.List import Data.Char import Data.Ord -- For testing import qualified Data.Map as Map import qualified Data.Classify.Parser as P import Control.Monad -- import Utils selectBest :: [Element] -> Element selectBest = last . sortByRank sortByRank :: [Element] -> [Element] sortByRank = map fst . sortByRank' sortByRank' elts = concatMap (sortBy (comparing (length.name.fst))) $ 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) --cleanTitle = null (takeWhile (not . isAlpha) (title elt)) unrealVersion (Version season episode) = sum [ episode < 1 ==> negate 1 , episode > 50 ==> negate 2 , episode > 100 ==> negate 5 , season < 1 ==> negate 10 , season > 50 ==> 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 infix 2 ==> True ==> n = n False ==> _ = 0 -------------------------------------------------------------- -- Tests -------------------------------------------------------------- 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", 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) , ("hidden.palms.0112-yestv.[VTV].mkv", palms, Version 1 12) , ("the.colbert.report.06.28.01.dsr.xvid-sys.[VTV].avi", colbert, DateVersion 2001 6 28) , ("the.colbert.report.06.28.15.dsr.xvid-sys.[VTV].avi", colbert, DateVersion 2015 6 28) , ("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.09.13.08.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2008 9 13) , ("the.colbert.report.09.13.09.dsr.xvid-crimson.[VTV].avi", colbert, DateVersion 2009 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) , ("Saturday Night Live S38E05 Bruno Mars PROPER HDTV x264-BAJSKORV", "Saturday Night Live", Version 38 5) , ("Conan 2010 11 08 Seth Rogen HDTV XviD-FQM", "Conan", DateVersion 2010 11 08) , ("Conan 2000 11 08 Seth Rogen HDTV XviD-FQM", "Conan", DateVersion 2000 11 08) , ("Time.Warp.S01E02.HDTV.XviD-GNARLY.avi", "Time Warp", Version 1 2) , ("True.Blood.S01E07.720p.HDTV.x264-2HD.mkv", "True Blood", Version 1 7) , ("Family.Guy.S07E03.PDTV.XviD-LOL.avi", "Family Guy", Version 7 3) , ("Dexter.S03E02.720p.HDTV.x264-SYS.mkv", "Dexter", Version 3 2) , ("Greys.Anatomy.S05E04.720p.HDTV.X264-DIMENSION.mkv", "Greys Anatomy", Version 5 4) , ("Life.S02E05.HDTV.XviD-LOL.[VTV].avi", "Life", Version 2 5) , ("Merlin.2008.S01E05.WS.PDTV.XviD-BiA.avi", "Merlin", Version 1 5) , ("South.Park.S12E09.DSR.XviD-0TV.avi", "South Park", Version 12 9) , ("Stargate.Atlantis.S05E12.720p.HDTV.x264-CTU.mkv", "Stargate Atlantis", Version 5 12) , ("Heroes.S03E05.HDTV.XviD-LOL.avi", "Heroes", Version 3 5) , ("Californication.S02E04.720p.HDTV.X264-DIMENSION.mkv", "Californication", Version 2 4) , ("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) -> let elts = P.run (P.parseElement testSeries) str in if null elts then do putStrLn $ "Failed to parse: " ++ str putStrLn $ "Expected: " ++ show (series, expectedVersion) else let best = selectBest elts v = version best in when (version best /= expectedVersion) $ do forM (sortByRank' elts) $ \(elt,rank) -> putStrLn $ "Erroneous parse: " ++ show (rank, score elt,str, title elt, version elt) putStrLn $ "Expected: " ++ show (series, expectedVersion)