src/Pompage.hs

   1 {-# LANGUAGE TypeSynonymInstances, OverlappingInstances, NoMonomorphismRestriction, ScopedTypeVariables #-}
   2
   3 import System.IO (readFile, FilePath(..))
   4 import System.Directory (
   5      getDirectoryContents
   6    , doesDirectoryExist
   7    )
   8 import System.FilePath ((</>))
   9 import System.Environment (getArgs, getProgName)
  10 import Data.List
  11 import Text.Printf (printf)
  12 import Text.XML.Light
  13 import qualified Text.XML.Light.Cursor as C
  14 import Control.Monad (foldM)
  15 import Control.Exception (SomeException(..), handle, bracket)
  16
  17 type Movies = [Movie]
  18
  19 data Movie = Movie {
  20      movieId :: Int
  21    , movieTitle :: String
  22    , movieYear :: Maybe Int
  23    , movieDirectors :: [String]
  24    , movieActors :: [String]
  25    , movieCountries :: [String]
  26    , movieLength :: Maybe Int
  27    , movieUserRating :: Maybe Int
  28    , moviePressRating :: Maybe Int
  29    , movieGenres :: [String]
  30    , movieSynopsis :: String
  31    , movieBudget :: Maybe Int
  32    , movieBudgetUnit :: String
  33    , movieFiles :: [FilePath]
  34    , movieUrl :: String
  35 } deriving (Show)
  36
  37 emptyMovie = Movie 0 "no title" Nothing [] [] []
  38    Nothing Nothing Nothing [] "" Nothing "" [] ""
  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 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 <- readXMLFile xmlFile
  53          print movies
  54          --print paths
  55
  56 coversDir = "../img/covers"
  57 movieExtenstions = ["avi", "mkv", "rmvb", "ogm", "divx"]
  58 usage = "Usage : %s -d <Movies dir> -x <XML file>\n"
  59
  60 checkArgs :: Maybe Args -> Maybe Args
  61 checkArgs Nothing = Nothing
  62 checkArgs (Just args) =
  63    case (lookup XML args, lookup MovieDir args) of
  64       (Just _, Just _) -> Just args
  65       otherwise -> Nothing
  66
  67 readArgs :: [String] -> Maybe Args
  68 readArgs (name:value:rest)
  69    | name == "-x" = (XML, value) <:> readArgs rest
  70    | name == "-d" = (MovieDir, value) <:> readArgs rest
  71    | otherwise = Nothing
  72    where
  73       _ <:> Nothing = Nothing
  74       arg <:> Just args = Just $ arg : args
  75 readArgs (_:[]) = Nothing
  76 readArgs (_) = Just []
  77
  78 moviePaths :: FilePath -> IO [FilePath]
  79 moviePaths dir = do
  80    paths <- filePaths (\filename ->
  81       any (`isSuffixOf` filename) movieExtenstions) dir
  82    -- Keep only the relative path.
  83    return $ map (drop $ Data.List.length dir + 1) paths
  84
  85 filePaths :: (String -> Bool) -> FilePath -> IO [FilePath]
  86 filePaths predicat baseDir = do
  87    processDir baseDir
  88    where
  89       processDir dir = do
  90          contents <- getDirectoryContents dir
  91          foldM (\acc entry -> do
  92             let absDir = dir </> entry
  93             doesDirectoryExist absDir >>= \exists ->
  94                if exists
  95                then do
  96                   paths <- processDir absDir
  97                   return (paths ++ acc)
  98                else
  99                   if predicat entry
 100                   then
 101                      return (absDir : acc)
 102                   else
 103                     return acc)
 104             []
 105             (contents \\ ["..", "."])
 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 elem =
 121    Just (emptyMovie, C.fromElement elem) >>?
 122    (\(m, c) ->
 123       case C.current c of
 124          Elem elem ->
 125             case findAttr (simpleQName "id") elem of
 126             Nothing -> Nothing
 127             Just id -> Just (m { movieId = read id :: Int }, c)
 128          otherwise -> Nothing) >>?
 129    (\(m, c) ->
 130       case firstChildElement c of
 131          Just (elem, c') -> Just (m { movieTitle = strContent elem }, c')
 132          otherwise -> Nothing) >>?
 133    (\(m, c) ->
 134       case nextSibilingElement c of
 135          Just (elem, c') -> Just m { movieYear =  intElement elem }
 136          otherwise -> Nothing)
 137
 138 -- A bit naive
 139 (>>?) :: Maybe alpha -> (alpha -> Maybe beta) -> Maybe beta
 140 Nothing >>? _ = Nothing
 141 Just v >>? f = f v
 142
 143 -- Some XML helper functions
 144 simpleQName name = QName name Nothing Nothing
 145 firstChildElement :: C.Cursor -> Maybe (Element, C.Cursor)
 146 firstChildElement c =
 147    case C.firstChild c of
 148       Just c' ->
 149          case C.current c' of
 150             Elem elem -> Just (elem, c')
 151             otherwise -> nextSibilingElement c'
 152       otherwise -> Nothing
 153
 154 nextSibilingElement :: C.Cursor -> Maybe (Element, C.Cursor)
 155 nextSibilingElement c =
 156    case C.right c of
 157       Just c' ->
 158          case C.current c' of
 159             Elem elem -> Just (elem, c')
 160             otherwise -> nextSibilingElement c'
 161       Nothing -> Nothing
 162
 163 -- Try to cast an element content to an Int.
 164 intElement :: Element -> Maybe Int
 165 intElement elem =
 166    if content == []
 167       then Nothing
 168       else Just (read content :: Int)
 169    where content = strContent elem
 170
 171 writeXMLFile :: Movies -> FilePath -> IO ()
 172 writeXMLFile movies file = undefined
 173
 174 filesPath :: FilePath -> IO [FilePath]
 175 filesPath basePath = undefined
 176
 177 movieName :: FilePath -> String
 178 movieName = undefined
 179
 180 -- Int is the module id.
 181 data SearchResult = OK (Int, Movie)
 182  | Many [(Int, String)] -- String is the name of the movie.
 183  | NotFound
 184
 185 data Module = Module {
 186      search :: String -> IO SearchResult
 187    -- Int is the module id. FilePath is a path to the image like "../img/4353"
 188    , downloadImage :: Int -> FilePath
 189 }
 190
 191 {-
 192    Gets a movie by asking the given module to find a movie.
 193    A movie is seeked by its the filename.
 194    If there is many possibilities then it will ask the user.
 195 -}
 196 searchAMovie :: String -> Module -> IO SearchResult
 197 searchAMovie filename mod = undefined
 198
 199