From 000d34474e2e52cfcf6db0011813080a1b93a9eb Mon Sep 17 00:00:00 2001 From: Greg Burri Date: Sun, 3 May 2009 22:41:05 +0200 Subject: [PATCH] ADD Progress on XML parsing (not finished yet) ADD Sample for the future XML format --- .gitignore | 3 +++ src/Pompage.hs | 71 ++++++++++++++++++++++++++++++++++++++++++-------- start.sh | 2 +- xml/sample.xml | 35 +++++++++++++++++++++++++ 4 files changed, 99 insertions(+), 12 deletions(-) create mode 100644 .gitignore create mode 100644 xml/sample.xml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..666fa37 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.hi +*.o +\#* \ No newline at end of file diff --git a/src/Pompage.hs b/src/Pompage.hs index e3066f2..2316f3f 100644 --- a/src/Pompage.hs +++ b/src/Pompage.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeSynonymInstances, OverlappingInstances, NoMonomorphismRestriction, ScopedTypeVariables #-} + import System.IO (readFile, FilePath(..)) import System.Directory ( getDirectoryContents @@ -8,13 +10,14 @@ 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 { - movieFiles :: [FilePath] - , movieId :: Int + movieId :: Int , movieTitle :: String , movieYear :: Maybe Int , movieDirectors :: [String] @@ -25,11 +28,15 @@ data Movie = Movie { , moviePressRating :: Maybe Int , movieGenres :: [String] , movieSynopsis :: String - , movieBudget :: Int + , movieBudget :: Maybe Int , movieBudgetUnit :: String + , movieFiles :: [FilePath] , movieUrl :: String } deriving (Show) +emptyMovie = Movie 0 "no title" Nothing [] [] [] + Nothing Nothing Nothing [] "" Nothing "" [] "" + data Arg = XML | MovieDir deriving (Show, Eq) type Args = [(Arg, String)] @@ -44,7 +51,7 @@ main = do paths <- moviePaths dir movies <- readXMLFile xmlFile print movies - print paths + --print paths coversDir = "../img/covers" movieExtenstions = ["avi", "mkv", "rmvb", "ogm", "divx"] @@ -97,7 +104,6 @@ filePaths predicat baseDir = do [] (contents \\ ["..", "."]) - readXMLFile :: FilePath -> IO Movies readXMLFile file = do content <- readFile file @@ -111,13 +117,56 @@ readXMLFile file = do (elChildren root) elementXMLToMovie :: Element -> Maybe Movie -elementXMLToMovie elem = undefined -{- -findAttr (QName "id" Nothing Nothing) elem of - Nothing -> acc - Just id -> --} +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 diff --git a/start.sh b/start.sh index a501312..5b89fa7 100755 --- a/start.sh +++ b/start.sh @@ -4,4 +4,4 @@ # -d -x # cd src -runhaskell Pompage.hs -d /home/gburri/mininux/fat/Films -x ../xml/test.xml \ No newline at end of file +runhaskell Pompage.hs -d /home/gburri/mininux/fat/Films -x ../xml/sample.xml \ No newline at end of file diff --git a/xml/sample.xml b/xml/sample.xml new file mode 100644 index 0000000..856481e --- /dev/null +++ b/xml/sample.xml @@ -0,0 +1,35 @@ + + + + + Rocky Balboa + 2006 + + Sylvester Stallone + + + Sylvester Stallone + Burt Young + Antonio Tarver + + + américain + + 105 + 4 + 3 + + Drame + Action + + +

Rocky Balboa, le légendaire boxeur, a depuis longtemps quitté le ring. De ses succès, il ne reste plus que des histoires qu'il raconte aux clients de son restaurant. La mort de son épouse lui pèse chaque jour et son fils ne vient jamais le voir.

+

Le champion d'aujourd'hui s'appelle Mason Dixon, et tout le monde s'accorde à le définir comme un tueur sans élégance ni coeur. Alors que les promoteurs lui cherchent désespérément un adversaire à sa taille, la légende de Rocky refait surface. L'idée d'opposer deux écoles, deux époques et deux titans aussi différents enflamme tout le monde. Pour Balboa, c'est l'occasion de ranimer les braises d'une passion qui ne l'a jamais quitté. L'esprit d'un champion ne meurt jamais...

+ + + + Rocky [x264 Aac] [Fr Eng] [Fr Eng].mkv + + http://www.allocine.fr/film/fichefilm_gen_cfilm=109061.html + + \ No newline at end of file -- 2.45.2