Semantique 0.1.0 → 0.2.0
raw patch · 2 files changed
+20/−31 lines, 2 filesdep ~classify
Dependency ranges changed: classify
Files
- Semantique.cabal +2/−2
- src/Main.hs +18/−29
Semantique.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: Semantique-version: 0.1.0+version: 0.2.0 synopsis: Command-line tool for maintaining the Semantique database. description: Command-line tool for maintaining the Semantique database. See http://semantik.tv/ license: PublicDomain@@ -23,5 +23,5 @@ -- other-modules: build-depends: base ==4.5.*, tagsoup ==0.12.*, bytestring ==0.9.*, mongoDB ==1.3.*, process ==1.1.*, mtl ==2.1.*, network ==2.4.*, split ==0.2.*,- text ==0.11.*, containers ==0.4.*, classify ==2012.10.*+ text ==0.11.*, containers ==0.4.*, classify >=2012.10.23 hs-source-dirs: src
src/Main.hs view
@@ -20,24 +20,23 @@ import qualified Data.Map as Map import Control.Monad -import Data.Classify.DataTypes-import qualified Data.Classify.Parser as Classify-import qualified Data.Classify.Rank as Classify+import Data.Classify.Television import Epguides main :: IO () main = do args <- getArgs+ let addr = "localhost" case args of- [addr, port, "magnet"] -> withMeteor addr port run- [addr, port, "shows"] -> withMeteor addr port (getTVShows >>= liftIO . mapM_ putStrLn)- [addr, port, "add", name] -> withMeteor addr port (addTVShow name)- [addr, port, "remove", name] -> withMeteor addr port (removeTVShow name)- [addr, port, "epguides", name] -> withMeteor addr port (mkEpguidesEntries name)- [addr, port, "set_epguides", name, url] ->+ [port, "magnet"] -> withMeteor addr port run+ [port, "shows"] -> withMeteor addr port (getTVShows >>= liftIO . mapM_ putStrLn)+ [port, "add", name] -> withMeteor addr port (addTVShow name)+ [port, "remove", name] -> withMeteor addr port (removeTVShow name)+ [port, "epguides", name] -> withMeteor addr port (mkEpguidesEntries name)+ [port, "set_epguides", name, url] -> withMeteor addr port (setEpguides name url)- [addr, port, "rebuild"] -> withMeteor addr port rebuild+ [port, "rebuild"] -> withMeteor addr port rebuild _ -> printUsage withMeteor addr port fn = do@@ -49,7 +48,7 @@ printUsage :: IO () printUsage = do prog <- getProgName- hPutStrLn stderr $ printf "Usage: %s <mongo_addr> <mongo_port> <command>\n" prog+ hPutStrLn stderr $ printf "Usage: %s <mongo_port> <command>\n" prog hPutStrLn stderr $ printf "Commands:" hPutStrLn stderr $ printf " magnet Fetch magnet links from stdin and add to DB." hPutStrLn stderr $ printf " shows List the recognized TV shows."@@ -61,14 +60,6 @@ exitWith ExitSuccess --- stripName "The Big Bang Theory" = "bigbangtheory"--- stripName "CSI: Miami" = "csimiami"-stripName :: String -> String-stripName = worker . filter isAlpha . filter (not . isSpace) . map toLower- where- worker lst | "the" `isPrefixOf` lst = worker (drop 3 lst)- worker lst = lst- isMagnetLink :: URI -> Bool isMagnetLink uri = uriScheme uri == "magnet:" @@ -113,20 +104,19 @@ insertMagnetLinks shows uris = do let magnets = [ uri | Just uri <- map parseURI uris, isMagnetLink uri ]- idx = Map.fromList [ (stripName name, name) | name <- shows ]- elts = [ (uri, Classify.selectBest elts)+ elts = [ (uri, elt) | uri <- magnets , let dn = getDownloadName uri- , let elts = Classify.run (Classify.parseElement idx) dn- , not (null elts) ]- forM_ elts $ \(uri, element) -> do- liftIO $ putStrLn $ "Adding element: " ++ show element- let query = [ "name" =: name element- , case version element of+ , Just elt <- [tryClassify shows dn]+ ]+ forM_ elts $ \(uri, (name, version, title)) -> do+ liftIO $ putStrLn $ "Adding element: " ++ show (name, version, title)+ let query = [ "name" =: name+ , case version of Version season episode -> "episode" =: [ "season" =: season, "episode" =: episode ] DateVersion year month day -> "airdate" =: [ "year" =: year, "month" =: month, "day" =: day ] ]- inst = [ "link" =: show uri, "hash" =: getHash uri, "tags" =: getTags (title element) ]+ inst = [ "link" =: show uri, "hash" =: getHash uri, "tags" =: getTags title ] modify (select query "episodes") ["$addToSet" =: ["instances" =: inst]] return () @@ -165,7 +155,6 @@ 0 -> do liftIO $ putStrLn $ "Inserting new: " ++ show (season, episode, year, month, day, title) insert_ "episodes" [ "name" =: name- , "searchable" =: map stripName (words name) , "episode" =: ["season" =: season, "episode" =: episode] , "airdate" =: airdate , "title" =: title