src/Pompage.hs

   1 import System.IO (readFile, FilePath(..))
   2 import System.Directory (
   3      getDirectoryContents
   4    , doesDirectoryExist
   5    )
   6 import System.FilePath ((</>))
   7 import System.Environment (getArgs, getProgName)
   8 import Data.List
   9 import Text.Printf (printf)
  10 import Text.XML.Light
  11 import Control.Monad (foldM)
  12
  13 -- Some constants.
  14 coversDir = "../img/covers"
  15 movieExtenstions = ["avi", "mkv", "rmvb", "ogm", "divx"]
  16 usage = "Usage : %s -d <Movies dir> -x <XML file>"
  17
  18 type Movies = [Movie]
  19
  20 data Movie = Movie {
  21      movieId :: Int
  22    , movieTitle :: String
  23    , movieYear :: Maybe Int
  24    , movieUserRating :: Maybe Float
  25    , movieDirectors :: [String]
  26    , movieGenres :: [String]
  27    , moviePlot :: String
  28    , movieActors :: [String]
  29    , movieLength :: Maybe Int -- [min].
  30    , movieCountries :: [String]
  31    , movieBudget :: Maybe (Int, String) -- (<budget>, <unit>).
  32    , movieFiles :: [FilePath]
  33    , movieUrl :: String
  34    , movieSourceId :: String
  35 } deriving (Show)
  36
  37 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"
  38
  39
  40 data Arg = XML | MovieDir deriving (Show, Eq)
  41 type Args = [(Arg, String)]
  42
  43 main = do
  44    args <- getArgs
  45    progName <- getProgName
  46    case checkArgs $ readArgs args of
  47       Nothing -> printf (usage ++ "\n") progName
  48       Just args -> do
  49          let Just dir = lookup MovieDir args
  50          let Just xmlFile = lookup XML args
  51          paths <- moviePaths dir
  52          movies <- catch (readXMLFile xmlFile) (\e -> return [])
  53          print movies
  54          putStrLn ""
  55          searchTest "pouet"
  56          --print paths
  57
  58 checkArgs :: Maybe Args -> Maybe Args
  59 checkArgs Nothing = Nothing
  60 checkArgs (Just args) =
  61    case (lookup XML args, lookup MovieDir args) of
  62       (Just _, Just _) -> Just args
  63       otherwise -> Nothing
  64
  65 readArgs :: [String] -> Maybe Args
  66 readArgs (name:value:rest)
  67    | name == "-x" = (XML, value) <:> readArgs rest
  68    | name == "-d" = (MovieDir, value) <:> readArgs rest
  69    | otherwise = Nothing
  70    where
  71       _ <:> Nothing = Nothing
  72       arg <:> Just args = Just $ arg : args
  73 readArgs (_:[]) = Nothing
  74 readArgs (_) = Just []
  75
  76 moviePaths :: FilePath -> IO [FilePath]
  77 moviePaths dir = do
  78    paths <- filePaths (\filename ->
  79       any (`isSuffixOf` filename) movieExtenstions) dir
  80    -- Keep only the relative path.
  81    return $ map (drop $ Data.List.length dir + 1) paths
  82
  83 filePaths :: (String -> Bool) -> FilePath -> IO [FilePath]
  84 filePaths predicat baseDir = do
  85    processDir baseDir
  86    where
  87       processDir dir = do
  88          contents <- getDirectoryContents dir
  89          foldM (\acc entry -> do
  90             let absDir = dir </> entry
  91             doesDirectoryExist absDir >>= \exists ->
  92                if exists
  93                then do
  94                   paths <- processDir absDir
  95                   return (paths ++ acc)
  96                else
  97                   if predicat entry
  98                   then
  99                      return (absDir : acc)
 100                   else
 101                     return acc)
 102             []
 103             (contents \\ ["..", "."])
 104
 105 --- XML ---
 106
 107 readXMLFile :: FilePath -> IO Movies
 108 readXMLFile file = do
 109    content <- readFile file
 110    let Just root = parseXMLDoc content
 111    return $
 112       foldl (\acc elem ->
 113          case elementXMLToMovie elem of
 114             Nothing -> acc
 115             Just movie -> movie : acc)
 116       []
 117       (elChildren root)
 118
 119 elementXMLToMovie :: Element -> Maybe Movie
 120 elementXMLToMovie element =
 121    findAttr (simpleName "id") element>>=
 122    \id -> findChild (simpleName "files") element >>=
 123    \filesElement ->
 124       let files = map strContent (findChildren (simpleName "file") filesElement) in
 125          findChild (simpleName "title") element >>=
 126    \titleElement ->
 127       let title = strContent titleElement in
 128          Just $ movieSample{movieId = read id, movieFiles = files, movieTitle = title} -- TODO
 129
 130 simpleName :: String -> QName
 131 simpleName s = QName s Nothing Nothing
 132
 133 {-
 134    \a ->  of
 135       Nothing -> Nothing
 136       Just id ->
 137          findAttr (QName "id" Nothing Nothing) elem of
 138          -}
 139
 140
 141 writeXMLFile :: Movies -> FilePath -> IO ()
 142 writeXMLFile movies file = undefined
 143
 144
 145 --- Web ---
 146
 147
 148 filesPath :: FilePath -> IO [FilePath]
 149 filesPath basePath = undefined
 150
 151 movieName :: FilePath -> String
 152 movieName = undefined
 153
 154 searchTest :: String -> IO ()
 155 searchTest name = do
 156    result <- searchAMovie name moduleIMDB
 157    return ()
 158
 159 moduleIMDB :: Module
 160 moduleIMDB = Module {
 161    search = \s -> undefined
 162 }
 163
 164 -- Int is the module id.
 165 data SearchResult = OK (Int, Movie)
 166  | Many [(Int, String)] -- String is the name of the movie.
 167  | NotFound
 168
 169 -- TODO : add a socket parameter to all function.
 170 data Module = Module {
 171      search :: String -> IO SearchResult
 172    -- Int is the movie id. FilePath is a path to the image like "../img/4353"
 173    -- , downloadImage :: Int -> FilePath
 174    -- downloadInfo :: Int -> Movie -> IO Movie
 175 }
 176
 177 {-
 178    Gets a movie by asking the given module to find a movie.
 179    A movie is seeked by its the filename.
 180    If there is many possibilities then it will ask the user.
 181 -}
 182 searchAMovie :: String -> Module -> IO SearchResult
 183 searchAMovie filename mod = search mod filename
 184
 185