X-Git-Url: http://git.euphorik.ch/?p=pompage.git;a=blobdiff_plain;f=src%2FPompage.hs;h=e89942be2527411bd12af60b1668e893e56b7de2;hp=200da4c56aa899ca36159d7d10a8d3947776ebf0;hb=HEAD;hpb=4c7939a757a98c33339c48482ffc1708e9662809 diff --git a/src/Pompage.hs b/src/Pompage.hs index 200da4c..e89942b 100644 --- a/src/Pompage.hs +++ b/src/Pompage.hs @@ -1,58 +1,71 @@ import System.IO (readFile, FilePath(..)) +import System.Directory ( + getDirectoryContents + , doesDirectoryExist + ) +import System.FilePath (()) import System.Environment (getArgs, getProgName) import Data.List import Text.Printf (printf) import Text.XML.Light +import Control.Monad (foldM) + +-- Some constants. +coversDir = "../img/covers" +movieExtenstions = ["avi", "mkv", "rmvb", "ogm", "divx"] +usage = "Usage : %s -d -x " type Movies = [Movie] data Movie = Movie { - files :: [FilePath] - , id :: Int - , title :: String - , year :: Maybe Int - , directors :: [String] - , actors :: [String] - , countries :: [String] - , length :: Maybe Int - , userRating :: Maybe Int - , pressRating :: Maybe Int - , genre :: [String] - , synopsis :: String - , budget :: Int - , budgetUnit :: String - , url :: String + movieId :: Int + , movieTitle :: String + , movieYear :: Maybe Int + , movieUserRating :: Maybe Float + , movieDirectors :: [String] + , movieGenres :: [String] + , moviePlot :: String + , movieActors :: [String] + , movieLength :: Maybe Int -- [min]. + , movieCountries :: [String] + , movieBudget :: Maybe (Int, String) -- (, ). + , movieFiles :: [FilePath] + , movieUrl :: String + , movieSourceId :: String } deriving (Show) -data Arg = XML | MoviesDir deriving (Show, Eq) +movieSample = Movie 1 "Batman" (Just 1989) (Just 7.6) ["Tim Burton"] ["Action", "Crime", "Thriller"] "The Dark Knight of Gotham City begins his war on crime with his first major enemy being the clownishly homicidal Joker." ["Michael Keaton", "Jack Nicholson", "Kim Basinger"] (Just 126) ["USA", "UK"] Nothing ["/home/gburr/divx/batman.mkv"] "http://www.imdb.com/title/tt0096895/" "0096895" + + +data Arg = XML | MovieDir deriving (Show, Eq) type Args = [(Arg, String)] main = do args <- getArgs progName <- getProgName case checkArgs $ readArgs args of - Nothing -> printf usage progName + Nothing -> printf (usage ++ "\n") progName Just args -> do - let dir = case lookup MoviesDir args of - Just d -> d - Nothing -> "." + let Just dir = lookup MovieDir args + let Just xmlFile = lookup XML args paths <- moviePaths dir - file <- readFile "../xml/test.xml" - print $ parseXMLDoc file - -movieExtenstions = ["avi", "mkv", "rmvb", "ogm", "divx"] -usage = "Usage : %s -x [-d ]\n" - + movies <- catch (readXMLFile xmlFile) (\e -> return []) + print movies + putStrLn "" + searchTest "pouet" + --print paths + checkArgs :: Maybe Args -> Maybe Args checkArgs Nothing = Nothing -checkArgs (Just args) = if any (\(a, _) -> a == XML) args - then Just args - else Nothing +checkArgs (Just args) = + case (lookup XML args, lookup MovieDir args) of + (Just _, Just _) -> Just args + otherwise -> Nothing readArgs :: [String] -> Maybe Args readArgs (name:value:rest) | name == "-x" = (XML, value) <:> readArgs rest - | name == "-d" = (MoviesDir, value) <:> readArgs rest + | name == "-d" = (MovieDir, value) <:> readArgs rest | otherwise = Nothing where _ <:> Nothing = Nothing @@ -61,31 +74,104 @@ readArgs (_:[]) = Nothing readArgs (_) = Just [] moviePaths :: FilePath -> IO [FilePath] -moviePaths dir = undefined +moviePaths dir = do + paths <- filePaths (\filename -> + any (`isSuffixOf` filename) movieExtenstions) dir + -- Keep only the relative path. + return $ map (drop $ Data.List.length dir + 1) paths + +filePaths :: (String -> Bool) -> FilePath -> IO [FilePath] +filePaths predicat baseDir = do + processDir baseDir + where + processDir dir = do + contents <- getDirectoryContents dir + foldM (\acc entry -> do + let absDir = dir entry + doesDirectoryExist absDir >>= \exists -> + if exists + then do + paths <- processDir absDir + return (paths ++ acc) + else + if predicat entry + then + return (absDir : acc) + else + return acc) + [] + (contents \\ ["..", "."]) + +--- XML --- readXMLFile :: FilePath -> IO Movies -readXMLFile file = undefined +readXMLFile file = do + content <- readFile file + let Just root = parseXMLDoc content + return $ + foldl (\acc elem -> + case elementXMLToMovie elem of + Nothing -> acc + Just movie -> movie : acc) + [] + (elChildren root) + +elementXMLToMovie :: Element -> Maybe Movie +elementXMLToMovie element = + findAttr (simpleName "id") element>>= + \id -> findChild (simpleName "files") element >>= + \filesElement -> + let files = map strContent (findChildren (simpleName "file") filesElement) in + findChild (simpleName "title") element >>= + \titleElement -> + let title = strContent titleElement in + Just $ movieSample{movieId = read id, movieFiles = files, movieTitle = title} -- TODO + +simpleName :: String -> QName +simpleName s = QName s Nothing Nothing +{- + \a -> of + Nothing -> Nothing + Just id -> + findAttr (QName "id" Nothing Nothing) elem of + -} writeXMLFile :: Movies -> FilePath -> IO () writeXMLFile movies file = undefined + +--- Web --- + + filesPath :: FilePath -> IO [FilePath] filesPath basePath = undefined movieName :: FilePath -> String movieName = undefined +searchTest :: String -> IO () +searchTest name = do + result <- searchAMovie name moduleIMDB + return () + +moduleIMDB :: Module +moduleIMDB = Module { + search = \s -> undefined +} + -- Int is the module id. data SearchResult = OK (Int, Movie) | Many [(Int, String)] -- String is the name of the movie. | NotFound +-- TODO : add a socket parameter to all function. data Module = Module { search :: String -> IO SearchResult - -- Int is the module id. FilePath is a path to the image like "../img/4353" - , downloadImage :: Int -> FilePath + -- Int is the movie id. FilePath is a path to the image like "../img/4353" + -- , downloadImage :: Int -> FilePath + -- downloadInfo :: Int -> Movie -> IO Movie } {- @@ -94,6 +180,6 @@ data Module = Module { If there is many possibilities then it will ask the user. -} searchAMovie :: String -> Module -> IO SearchResult -searchAMovie filename mod = undefined +searchAMovie filename mod = search mod filename