1 {-# LANGUAGE TypeSynonymInstances, OverlappingInstances, NoMonomorphismRestriction, ScopedTypeVariables #-}
3 import System
.IO
(readFile
, FilePath
(..))
4 import System
.Directory
(
8 import System
.FilePath
((</>))
9 import System
.Environment
(getArgs
, getProgName
)
11 import Text
.Printf
(printf
)
13 import qualified Text
.XML
.Light
.Cursor
as C
14 import Control
.Monad
(foldM
)
15 import Control
.Exception
(SomeException
(..), handle
, bracket
)
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
]
37 emptyMovie
= Movie
0 "no title" Nothing
[] [] []
38 Nothing Nothing Nothing
[] "" Nothing
"" [] ""
40 data Arg
= XML
| MovieDir
deriving (Show
, Eq
)
41 type Args
= [(Arg
, String
)]
45 progName
<- getProgName
46 case checkArgs
$ readArgs args
of
47 Nothing
-> printf usage progName
49 let Just dir
= lookup MovieDir args
50 let Just xmlFile
= lookup XML args
51 paths
<- moviePaths dir
52 movies
<- readXMLFile xmlFile
56 coversDir
= "../img/covers"
57 movieExtenstions
= ["avi", "mkv", "rmvb", "ogm", "divx"]
58 usage
= "Usage : %s -d <Movies dir> -x <XML file>\n"
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
67 readArgs ::
[String
] -> Maybe Args
68 readArgs
(name:value:rest
)
69 | name
== "-x" = (XML
, value
) <:
> readArgs rest
70 | name
== "-d" = (MovieDir
, value
) <:
> readArgs rest
73 _
<:
> Nothing
= Nothing
74 arg
<:
> Just args
= Just
$ arg : args
75 readArgs
(_:
[]) = Nothing
76 readArgs
(_
) = Just
[]
78 moviePaths :: FilePath
-> IO
[FilePath
]
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
85 filePaths ::
(String
-> Bool
) -> FilePath
-> IO
[FilePath
]
86 filePaths predicat baseDir
= do
90 contents
<- getDirectoryContents dir
91 foldM
(\acc entry
-> do
92 let absDir
= dir
</> entry
93 doesDirectoryExist absDir
>>= \exists
->
96 paths
<- processDir absDir
101 return
(absDir : acc
)
105 (contents \\
["..", "."])
107 readXMLFile :: FilePath
-> IO Movies
108 readXMLFile file
= do
109 content
<- readFile file
110 let Just root
= parseXMLDoc content
113 case elementXMLToMovie elem
of
115 Just movie
-> movie : acc
)
119 elementXMLToMovie :: Element
-> Maybe Movie
120 elementXMLToMovie elem
=
121 Just
(emptyMovie
, C
.fromElement elem
) >>?
125 case findAttr
(simpleQName
"id") elem
of
127 Just id
-> Just
(m
{ movieId
= read id :: Int
}, c
)
128 otherwise
-> Nothing
) >>?
130 case firstChildElement c
of
131 Just
(elem
, c'
) -> Just
(m
{ movieTitle
= strContent elem
}, c'
)
132 otherwise
-> Nothing
) >>?
134 case nextSibilingElement c
of
135 Just
(elem
, c'
) -> Just m
{ movieYear
= intElement elem
}
136 otherwise
-> Nothing
)
139 (>>?) :: Maybe alpha
-> (alpha
-> Maybe beta
) -> Maybe beta
140 Nothing
>>? _
= Nothing
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
150 Elem elem
-> Just
(elem
, c'
)
151 otherwise
-> nextSibilingElement c'
154 nextSibilingElement :: C
.Cursor
-> Maybe
(Element
, C
.Cursor
)
155 nextSibilingElement c
=
159 Elem elem
-> Just
(elem
, c'
)
160 otherwise
-> nextSibilingElement c'
163 -- Try to cast an element content to an Int.
164 intElement :: Element
-> Maybe Int
168 else Just
(read content :: Int
)
169 where content
= strContent elem
171 writeXMLFile :: Movies
-> FilePath
-> IO
()
172 writeXMLFile movies file
= undefined
174 filesPath :: FilePath
-> IO
[FilePath
]
175 filesPath basePath
= undefined
177 movieName :: FilePath
-> String
178 movieName
= undefined
180 -- Int is the module id.
181 data SearchResult
= OK
(Int
, Movie
)
182 | Many
[(Int
, String
)] -- String is the name of the movie.
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
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.
196 searchAMovie :: String
-> Module
-> IO SearchResult
197 searchAMovie filename mod
= undefined