X-Git-Url: http://git.euphorik.ch/?p=pompage.git;a=blobdiff_plain;f=src%2FPompage.hs;h=e3066f20ee4131e116a5a8349ce9a214bfd8cb72;hp=b986e99953060c9735f54ce4660e121c6c01dd5e;hb=6d8562993900c1db38b837a4242dbc955e959e22;hpb=96bf4ef892a3bf6d493a139c4ea49992f51a1ddf diff --git a/src/Pompage.hs b/src/Pompage.hs index b986e99..e3066f2 100644 --- a/src/Pompage.hs +++ b/src/Pompage.hs @@ -1,56 +1,122 @@ import System.IO (readFile, FilePath(..)) -import System.Environment (getArgs) +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) 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 + movieFiles :: [FilePath] + , movieId :: Int + , movieTitle :: String + , movieYear :: Maybe Int + , movieDirectors :: [String] + , movieActors :: [String] + , movieCountries :: [String] + , movieLength :: Maybe Int + , movieUserRating :: Maybe Int + , moviePressRating :: Maybe Int + , movieGenres :: [String] + , movieSynopsis :: String + , movieBudget :: Int + , movieBudgetUnit :: String + , movieUrl :: String } deriving (Show) -data Args = Args { - xml :: String - , moviesDir :: FilePath -} deriving (Show) +data Arg = XML | MovieDir deriving (Show, Eq) +type Args = [(Arg, String)] -test = do +main = do args <- getArgs - case readArgs args of - Left mess -> print mess - Right args -> do - paths <- moviePaths $ moviesDir args - file <- readFile "../xml/test.xml" - print $ parseXMLDoc file - + progName <- getProgName + case checkArgs $ readArgs args of + Nothing -> printf usage progName + Just args -> do + let Just dir = lookup MovieDir args + let Just xmlFile = lookup XML args + paths <- moviePaths dir + movies <- readXMLFile xmlFile + print movies + print paths + +coversDir = "../img/covers" movieExtenstions = ["avi", "mkv", "rmvb", "ogm", "divx"] - -readArgs :: [String] -> Either String Args -readArgs plop = undefined -{--readArgs (name:value:rest) = case name of - "-x" -> { xml = value } - "-d" -> { moviesDir = value }--} +usage = "Usage : %s -d -x \n" + +checkArgs :: Maybe Args -> Maybe Args +checkArgs Nothing = 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" = (MovieDir, value) <:> readArgs rest + | otherwise = Nothing + where + _ <:> Nothing = Nothing + arg <:> Just args = Just $ arg : args +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 \\ ["..", "."]) -readXMLFile :: FilePath -> IO Movies -readXMLFile file = undefined +readXMLFile :: FilePath -> IO Movies +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 elem = undefined +{- +findAttr (QName "id" Nothing Nothing) elem of + Nothing -> acc + Just id -> +-} writeXMLFile :: Movies -> FilePath -> IO ()