X-Git-Url: http://git.euphorik.ch/index.cgi?a=blobdiff_plain;f=src%2FPompage.hs;h=2316f3ff5b91e2009ad9e75deaa02006fe559d44;hb=000d34474e2e52cfcf6db0011813080a1b93a9eb;hp=200da4c56aa899ca36159d7d10a8d3947776ebf0;hpb=4c7939a757a98c33339c48482ffc1708e9662809;p=pompage.git

diff --git a/src/Pompage.hs b/src/Pompage.hs
index 200da4c..2316f3f 100644
--- a/src/Pompage.hs
+++ b/src/Pompage.hs
@@ -1,30 +1,43 @@
+{-# LANGUAGE TypeSynonymInstances, OverlappingInstances, NoMonomorphismRestriction, ScopedTypeVariables #-}
+
 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 qualified Text.XML.Light.Cursor as C
+import Control.Monad (foldM)
+import Control.Exception (SomeException(..), handle, bracket)
 
 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
+   , movieDirectors :: [String]
+   , movieActors :: [String]
+   , movieCountries :: [String]
+   , movieLength :: Maybe Int
+   , movieUserRating :: Maybe Int
+   , moviePressRating :: Maybe Int
+   , movieGenres :: [String]
+   , movieSynopsis :: String
+   , movieBudget :: Maybe Int
+   , movieBudgetUnit :: String
+   , movieFiles :: [FilePath]
+   , movieUrl :: String
 } deriving (Show)
 
-data Arg = XML | MoviesDir deriving (Show, Eq)
+emptyMovie = Movie 0 "no title" Nothing [] [] []
+   Nothing Nothing Nothing [] "" Nothing "" [] ""
+
+data Arg = XML | MovieDir deriving (Show, Eq)
 type Args = [(Arg, String)]
 
 main = do
@@ -33,26 +46,28 @@ main = do
    case checkArgs $ readArgs args of
       Nothing -> printf usage 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
+         movies <- readXMLFile xmlFile
+         print movies
+         --print paths
 
+coversDir = "../img/covers"
 movieExtenstions = ["avi", "mkv", "rmvb", "ogm", "divx"]
-usage = "Usage : %s -x <XML file> [-d <Movies dir>]\n"
+usage = "Usage : %s -d <Movies dir> -x <XML file>\n"
 
 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,12 +76,97 @@ 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 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 =
+   Just (emptyMovie, C.fromElement elem) >>?
+   (\(m, c) ->
+      case C.current c of
+         Elem elem ->
+            case findAttr (simpleQName "id") elem of
+            Nothing -> Nothing
+            Just id -> Just (m { movieId = read id :: Int }, c)
+         otherwise -> Nothing) >>?
+   (\(m, c) ->
+      case firstChildElement c of
+         Just (elem, c') -> Just (m { movieTitle = strContent elem }, c')
+         otherwise -> Nothing) >>?
+   (\(m, c) ->
+      case nextSibilingElement c of
+         Just (elem, c') -> Just m { movieYear =  intElement elem }
+         otherwise -> Nothing)
+
+-- A bit naive
+(>>?) :: Maybe alpha -> (alpha -> Maybe beta) -> Maybe beta
+Nothing >>? _ = Nothing
+Just v >>? f = f v
+
+-- Some XML helper functions
+simpleQName name = QName name Nothing Nothing
+firstChildElement :: C.Cursor -> Maybe (Element, C.Cursor)
+firstChildElement c =
+   case C.firstChild c of
+      Just c' ->
+         case C.current c' of
+            Elem elem -> Just (elem, c')
+            otherwise -> nextSibilingElement c'
+      otherwise -> Nothing
+
+nextSibilingElement :: C.Cursor -> Maybe (Element, C.Cursor)
+nextSibilingElement c =
+   case C.right c of
+      Just c' ->
+         case C.current c' of
+            Elem elem -> Just (elem, c')
+            otherwise -> nextSibilingElement c'
+      Nothing -> Nothing
+
+-- Try to cast an element content to an Int.
+intElement :: Element -> Maybe Int
+intElement elem =
+   if content == []
+      then Nothing
+      else Just (read content :: Int)
+   where content = strContent elem
 
 writeXMLFile :: Movies -> FilePath -> IO ()
 writeXMLFile movies file = undefined