Package.hs 21 KB
Newer Older
md9ms's avatar
md9ms committed
1
{-# OPTIONS -cpp #-}
2
3
4
5
6
7
8
9
10
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Package
-- Copyright   :  Isaac Jones 2003-2004
-- 
-- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
-- Stability   :  alpha
-- Portability :  
--
ijones's avatar
ijones committed
11
-- Explanation: Package description and parsing
12

ijones's avatar
ijones committed
13
{- All rights reserved.
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

43
module Distribution.Package (
simonmar's avatar
simonmar committed
44
45
	PackageIdentifier(..), 
	showPackageId,
46
	PackageDescription(..),
md9ms's avatar
md9ms committed
47
        BuildInfo(..),
48
        Executable(..),
ijones's avatar
ijones committed
49
	emptyPackageDescription,
50
        parsePackageDesc,
ijones's avatar
ijones committed
51
        hasLibs,
ijones's avatar
ijones committed
52
#ifdef DEBUG
53
        hunitTests,
ijones's avatar
ijones committed
54
        test
ijones's avatar
ijones committed
55
#endif
56
  ) where
57

md9ms's avatar
md9ms committed
58
59
60
61
import Control.Monad.State
import Control.Monad(when, foldM)
import Control.Monad.Error
import Data.Char(isSpace, toLower)
md9ms's avatar
md9ms committed
62
import Data.List(isPrefixOf)
63
import Data.Maybe(fromMaybe)
ijones's avatar
ijones committed
64

65
66
import Distribution.Version(Version(..), VersionRange(..),
                            showVersion, parseVersion, parseVersionRange)
md9ms's avatar
md9ms committed
67
import Distribution.Misc(License(..), Dependency(..), Extension(..))
md9ms's avatar
md9ms committed
68
import Distribution.Setup(CompilerFlavor(..))
69

70
71
import System.IO(openFile, IOMode(..), hGetContents)

ijones's avatar
ijones committed
72
73
import Text.ParserCombinators.Parsec

ijones's avatar
ijones committed
74
#ifdef DEBUG
ijones's avatar
ijones committed
75
import HUnit (Test(..), (~:), (~=?), assertEqual, assertBool, Assertion, runTestTT)
ijones's avatar
ijones committed
76
77
#endif

78
79
data PackageIdentifier
    = PackageIdentifier {pkgName::String, pkgVersion::Version}
simonmar's avatar
simonmar committed
80
      deriving (Read, Show, Eq)
81

simonmar's avatar
simonmar committed
82
showPackageId :: PackageIdentifier -> String
ijones's avatar
ijones committed
83
showPackageId (PackageIdentifier n (Version [] _)) = n -- if no version, don't show version.
simonmar's avatar
simonmar committed
84
85
86
showPackageId pkgid = 
  pkgName pkgid ++ '-': showVersion (pkgVersion pkgid)

87
88
89
90
91
92
93
94
95
96
-- | This data type is the internal representation of the file @pkg.descr@.
-- It contains two kinds of information about the package: information
-- which is needed for all packages, such as the package name and version, and 
-- information which is needed for the simple build system only, such as 
-- the compiler options and library name.
-- 
data PackageDescription
    =  PackageDescription {
	-- the following are required by all packages:
	package        :: PackageIdentifier,
97
        license        :: License,
98
99
100
        copyright      :: String,
        maintainer     :: String,
        stability      :: String,
101
        library        :: Maybe BuildInfo,
102
103
104
105
106
107
108
109
        executables    :: [Executable]
    }
    deriving (Show, Read, Eq)

data Executable = Executable {
        exeName    :: String,
        modulePath :: FilePath,
        buildInfo  :: BuildInfo
110
    }
ijones's avatar
ijones committed
111
112
    deriving (Show, Read, Eq)

113
114
115
116
117
118
119
120
121
122
123
124
125
126
data BuildInfo = BuildInfo {
        buildDepends    :: [Dependency],
        modules         :: [String],
	exposedModules  :: [String],
        cSources        :: [FilePath],
        hsSourceDir     :: FilePath,
        extensions      :: [Extension],
        extraLibs       :: [String],
        includeDirs     :: [FilePath],
        includes        :: [FilePath],
        options         :: [(CompilerFlavor,[String])]
    }
    deriving (Show,Read,Eq)

ijones's avatar
ijones committed
127
128
129
130
131
132
133
134
135
-- |Set the name for this package. Convenience function.
setPkgName :: String -> PackageDescription -> PackageDescription
setPkgName n desc@PackageDescription{package=pkgIdent}
    = desc{package=pkgIdent{pkgName=n}}

-- |Set the version for this package. Convenience function.
setPkgVersion :: Version -> PackageDescription -> PackageDescription
setPkgVersion v desc@PackageDescription{package=pkgIdent}
    = desc{package=pkgIdent{pkgVersion=v}}
136
137
138

emptyPackageDescription :: PackageDescription
emptyPackageDescription
ijones's avatar
ijones committed
139
    =  PackageDescription {package      = PackageIdentifier "" (Version [] []),
140
                      license      = AllRightsReserved,
141
142
143
                      copyright    = "",
                      maintainer   = "",
                      stability    = "",
144
145
                      library      = Nothing,
                      executables  = []
146
                     }
147

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
emptyBuildInfo :: BuildInfo
emptyBuildInfo = BuildInfo {
                      buildDepends   = [],
                      modules        = [],
		      exposedModules = [], -- Only used for libs
		      cSources       = [],
		      hsSourceDir    = ".", -- FIX: FileUtils.currentDir
                      extensions     = [],
                      extraLibs      = [],
                      includeDirs    = [],
                      includes       = [],
                      options        = []
                     }
                        
-- |Add options for a specific compiler. Convenience function.
setOptions :: CompilerFlavor -> [String] -> BuildInfo -> BuildInfo
setOptions c xs desc@BuildInfo{options=opts}
    = desc{options=(c,xs):opts}
ijones's avatar
ijones committed
166

ijones's avatar
ijones committed
167
168
169
170
171
172
173
174
-- |does this package have any libraries?
hasLibs :: PackageDescription -> Bool
hasLibs p = case library p of
            Just l  -> if null (cSources l) && null (modules l)
                       then False else True
            Nothing -> False


ijones's avatar
ijones committed
175
176
177
178
-- ------------------------------------------------------------
-- * Parsing
-- ------------------------------------------------------------

ijones's avatar
ijones committed
179
180
181
notImp :: String -> a
notImp s = error $ s ++ " not yet implemented"

182
-- |Parse the given package file.
183
parsePackageDesc :: FilePath -> IO PackageDescription
184
185
186
parsePackageDesc p = do h <- openFile p ReadMode
                        str <- hGetContents h
                        case parseDescription str of
md9ms's avatar
md9ms committed
187
                          Left  e -> error (showError e) -- FIXME
188
189
190
                          Right x@PackageDescription{library=Nothing,
                                                     executables=[]}
                              -> error "no library listed, and no executable stanza."
191
                          Right x -> return x
192

md9ms's avatar
md9ms committed
193
194
195
196
197
198
data PError = Parsec ParseError | FromString String
        deriving Show

instance Error PError where
        strMsg = FromString

md9ms's avatar
md9ms committed
199
200
201
showError (Parsec pe)    = show pe
showError (FromString s) = s

md9ms's avatar
md9ms committed
202
parseDescription :: String -> Either PError PackageDescription
203
204
205
206
207
208
209
parseDescription inp = do let (st:sts) = splitStanzas inp
                          pkg <- foldM parseBasicStanza emptyPackageDescription st
                          exes <- mapM parseExecutableStanza sts
                          return pkg{executables=exes}
  where -- The basic stanza, with library building info
        parseBasicStanza pkg (f@"name",      val) = return (setPkgName val pkg)
        parseBasicStanza pkg (f@"version",   val) =
md9ms's avatar
md9ms committed
210
211
          do v <- runP f parseVersion val
             return (setPkgVersion v pkg)
212
213
        parseBasicStanza pkg (f@"copyright", val) = return pkg{copyright=val}
        parseBasicStanza pkg (f@"license",   val) =
md9ms's avatar
md9ms committed
214
215
          do l <- runP f parseLicense val
             return pkg{license=l}
216
217
218
        parseBasicStanza pkg (f@"license-file", val) =
          do path <- runP f parseFilePath val
             return pkg{license=OtherLicense path}
219
220
221
222
223
224
225
226
        parseBasicStanza pkg (f@"maintainer", val) = return pkg{maintainer=val}
        parseBasicStanza pkg (f@"stability",  val) = return pkg{stability=val}
        parseBasicStanza pkg (field, val) =
          do let lib = fromMaybe emptyBuildInfo (library pkg)
             lib' <- parseExeHelp lib (field, val)
             return pkg{library=Just lib'}
        -- Stanzas for executables
        parseExecutableStanza (("executable",exeName):st) =
227
228
229
230
231
232
          case lookup "main-is" st of
            Just xs -> do path <- runP "main-is" parseFilePath xs
                          binfo <- foldM parseExeHelp emptyBuildInfo st
                          return $ Executable exeName path binfo
            Nothing -> throwError $ strMsg $
                "No 'Main-Is' field found for " ++ exeName ++ " stanza"
233
234
        parseExecutableStanza ((f,_):st) = throwError $ strMsg $
                "'Executable' stanza starts with field '" ++ f ++ "'"
235
        parseExeHelp binfo (f@"main-is", _) = return binfo
236
        parseExeHelp binfo (f@"extra-libs", val) =
md9ms's avatar
md9ms committed
237
          do xs <- runP f (parseCommaList word) val
238
239
             return binfo{extraLibs=xs}
        parseExeHelp binfo (f@"build-depends", val) =
md9ms's avatar
md9ms committed
240
          do xs <- runP f (parseCommaList parseDependency) val
241
             return binfo{buildDepends=xs}
md9ms's avatar
md9ms committed
242
        -- Paths and stuff
243
        parseExeHelp binfo (f@"c-sources", val) =
244
          do paths <- runP f (parseCommaList parseFilePath) val
245
246
             return binfo{cSources=paths}
        parseExeHelp binfo (f@"include-dirs", val) =
247
          do paths <- runP f (parseCommaList parseFilePath) val
248
249
             return binfo{includeDirs=paths}
        parseExeHelp binfo (f@"includes", val) =
250
          do paths <- runP f (parseCommaList parseFilePath) val
251
252
             return binfo{includes=paths}
        parseExeHelp binfo (f@"hs-source-dir", val) =
md9ms's avatar
md9ms committed
253
          do path <- runP f parseFilePath val
254
             return binfo{hsSourceDir=path}
md9ms's avatar
md9ms committed
255
        -- Module related
256
        parseExeHelp binfo (f@"modules", val) =
md9ms's avatar
md9ms committed
257
          do xs <- runP f (parseCommaList moduleName) val
258
259
             return binfo{modules=xs}
        parseExeHelp binfo (f@"exposed-modules", val) =
md9ms's avatar
md9ms committed
260
          do xs <- runP f (parseCommaList moduleName) val
261
262
             return binfo{exposedModules=xs}
        parseExeHelp binfo (f@"extensions", val) =
md9ms's avatar
md9ms committed
263
          do exts <- runP f (parseCommaList parseExtension) val
264
265
             return binfo{extensions=exts}
        parseExeHelp binfo (f, val) | "options-" `isPrefixOf` f =
md9ms's avatar
md9ms committed
266
267
268
          let compilers = [("ghc",GHC),("nhc",NHC),("hugs",Hugs)] -- FIXME
           in case lookup (drop 8 f) compilers of
                Just c -> do xs <- runP f (parseCommaList parseOption) val
269
                             return (setOptions c xs binfo)
md9ms's avatar
md9ms committed
270
                Nothing -> error $ "Unknown compiler (" ++ drop 8 f ++ ")"
271
        parseExeHelp binfo (field, val) = error $ "Unknown field :: " ++ field
md9ms's avatar
md9ms committed
272
273
274
275
276
        -- ...
        runP f p s = case parse p f s of
                       Left pe -> Left (Parsec pe)
                       Right a -> Right a

277
278
279
280
281
282
type Stanza = [(String,String)]

-- |Split a string into blank line-separated stanzas of
-- "Field: value" groups
splitStanzas :: String -> [Stanza]
splitStanzas = map merge . groupStanzas . filter validLine . lines
md9ms's avatar
md9ms committed
283
284
285
  where validLine s = case dropWhile isSpace s of
                        '-':'-':_ -> False      -- Comment
                        _         -> True
286
287
288
        groupStanzas [] = []
        groupStanzas xs = let (ys,zs) = break (all isSpace) xs
                           in ys : groupStanzas (dropWhile (all isSpace) zs)
md9ms's avatar
md9ms committed
289
290
291
292
293
294
295
296
        merge (x:(' ':s):ys) = case dropWhile isSpace s of
                                 "." -> merge ((x++"\n"):ys)
                                 s'  -> merge ((x++"\n"++s'):ys)
        merge (x:ys) = brk x : merge ys
        merge []     = []
        brk xs = case break (==':') xs of
                   (fld, ':':val) -> (map toLower fld, dropWhile isSpace val)
                   (fld, "")      -> error "FIXME"
ijones's avatar
ijones committed
297

298
-- |parse a module name
md9ms's avatar
md9ms committed
299
moduleName = many (alphaNum <|> oneOf "_'.") <?> "moduleName"
ijones's avatar
ijones committed
300

301
parseFilePath :: GenParser Char st FilePath
md9ms's avatar
md9ms committed
302
parseFilePath = parseReadS <|> (many1 (alphaNum <|> oneOf "-+/_."))
md9ms's avatar
md9ms committed
303
        <?> "parseFilePath"
304

md9ms's avatar
md9ms committed
305
306
307
308
309
310
311
parseReadS :: Read a => GenParser Char st a
parseReadS = do toks <- getInput
                case reads toks of
                  [(str,toks')] -> do setInput toks'
                                      return str
                  _             -> fail "Bad String"

312
parseDependency :: GenParser Char st Dependency
md9ms's avatar
md9ms committed
313
parseDependency = do name <- many1 (letter <|> digit <|> oneOf "-_")
314
                     skipMany parseWhite
315
                     ver <- parseVersionRange <|> return AnyVersion
316
317
                     skipMany parseWhite
                     return $ Dependency name ver
md9ms's avatar
md9ms committed
318
        <?> "parseDependency"
319

320
parseLicense :: GenParser Char st License
321
parseLicense = parseReadS
ijones's avatar
ijones committed
322

md9ms's avatar
md9ms committed
323
parseExtension :: GenParser Char st Extension
md9ms's avatar
md9ms committed
324
parseExtension = parseReadS
md9ms's avatar
md9ms committed
325

md9ms's avatar
md9ms committed
326
327
parseOption = many1 (letter <|> digit <|> oneOf "-+/\\._") -- FIXME

328
toStr c = c >>= \x -> return [x]
ijones's avatar
ijones committed
329
330

word :: GenParser Char st String
ijones's avatar
ijones committed
331
332
333
334
335
336
337
word = many1 letter <?> "word"

parseCommaList :: GenParser Char st a -- ^The parser for the stuff between commas
               -> GenParser Char st [a]
parseCommaList p
    = do words <- sepBy1 p separator
         return words
md9ms's avatar
md9ms committed
338
    where separator = spaces >> char ',' >> spaces
ijones's avatar
ijones committed
339
340

parseWhite = try parseSpaceNotNewline
341
            <|> (try (char '\n' >> parseWhite))
ijones's avatar
ijones committed
342
343
344
345
346
347

parseSpaceNotNewline = (satisfy isSpaceNotNewline <?> "space, not newline")
    where isSpaceNotNewline :: Char -> Bool
          isSpaceNotNewline '\n' = False
          isSpaceNotNewline n    = isSpace n

ijones's avatar
ijones committed
348
349
350
351
-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------
#ifdef DEBUG
352
353
354
355
356
357
358
359
360
361
362
363
364
testPkgDesc = unlines [
        "-- Required",
        "Name: Cabal",
        "Version: 0.1.1.1.1-rain",
        "License: LGPL",
        "Copyright: Free Text String",
        "-- Optional - may be in source?",
        "Stability: Free Text String",
        "Build-Depends: haskell-src, HUnit>=1.0.0-rain",
        "Modules: Distribution.Package, Distribution.Version, Distribution.Simple.GHCPackageConfig",
        "C-Sources: not/even/rain.c, such/small/hands",
        "HS-Source-Dir: src",
        "Exposed-Modules: Distribution.Void, Foo.Bar",
md9ms's avatar
md9ms committed
365
        "Extensions: OverlappingInstances, TypeSynonymInstances",
366
367
        "Extra-Libs: libfoo, bar, bang",
        "Include-Dirs: your/slightest, look/will",
md9ms's avatar
md9ms committed
368
        "Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
md9ms's avatar
md9ms committed
369
        "Options-ghc: -fTH",
370
371
372
373
        "Options-hugs: +TH",
        "",
        "-- Next is an executable",
        "Executable: somescript",
374
        "Main-is: SomeFile.hs",
375
376
377
        "Modules: Foo1, Util, Main",
        "HS-Source-Dir: scripts",
        "Extensions: OverlappingInstances"
378
        ]
ijones's avatar
ijones committed
379
380
381

testPkgDescAnswer = 
 PackageDescription {package = PackageIdentifier {pkgName = "Cabal",
ijones's avatar
ijones committed
382
                                                 pkgVersion = Version {versionBranch = [0,1,1,1,1],
md9ms's avatar
md9ms committed
383
                                                 versionTags = ["rain"]}},
ijones's avatar
ijones committed
384
                    license = LGPL,
ijones's avatar
ijones committed
385
                    copyright = "Free Text String",
ijones's avatar
ijones committed
386
                    maintainer = "",
ijones's avatar
ijones committed
387
                    stability = "Free Text String",
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403

                    library = Just $ BuildInfo {
                        buildDepends = [Dependency "haskell-src" AnyVersion,
                                        Dependency "HUnit"
                                         (UnionVersionRanges (ThisVersion (Version [1,0,0] ["rain"]))
                                          (LaterVersion (Version [1,0,0] ["rain"])))],

                        modules = ["Distribution.Package","Distribution.Version",
                                      "Distribution.Simple.GHCPackageConfig"],

                        cSources = ["not/even/rain.c", "such/small/hands"],
                        hsSourceDir = "src",
                        exposedModules = ["Distribution.Void", "Foo.Bar"],
                        extensions = [OverlappingInstances, TypeSynonymInstances],
                        extraLibs = ["libfoo", "bar", "bang"],
                        includeDirs = ["your/slightest", "look/will"],
md9ms's avatar
md9ms committed
404
                        includes = ["/easily/unclose", "/me", "funky, path\\name"],
405
406
                        options = [(Hugs,["+TH"]), (GHC,["-fTH"])] -- Note reversed order
                    },
407
408
                    executables = [Executable "somescript" "SomeFile.hs" (
                      emptyBuildInfo{
409
410
411
412
                        modules = ["Foo1","Util","Main"],
                        hsSourceDir = "scripts",
                        extensions = [OverlappingInstances]
                      })]
ijones's avatar
ijones committed
413
414
}

ijones's avatar
ijones committed
415
hunitTests :: [Test]
416
417
418
419
420
hunitTests = [TestLabel "newline before word (parsewhite)" $ TestCase $
              do assertRight "newline before word 1"
                  "foo" (parse (skipMany parseWhite>>char '\n'>>word) "" "   \n  \nfoo")
                 assertRight "newline before word 2"
                  "foo" (parse (skipMany parseWhite>>char '\n'>>word) "" "   \n \t    \n  \nfoo"),
ijones's avatar
ijones committed
421
422

              TestLabel "skip spaces not newlines" $ TestCase $
423
424
425
426
427
428
429
430
              do assertRight "spaces with newlines"
                  "foo" (parse (skipMany parseWhite>>word) "" "   \n  foo")
                 assertRight "spaces with newlines"
                  "foo" (parse (skipMany parseWhite>>word) "" "   \n \t\n   foo")
                 assertRight "no preceding spaces"
                  "foo" (parse (skipMany parseWhite>>word) "" "foo")
                 assertBool "newline before data without in-between spaces"
                  (isError (parse (skipMany parseWhite>>word) "" "   \n  \nfoo")),
ijones's avatar
ijones committed
431

md9ms's avatar
md9ms committed
432
433
434
435
436
437
--              TestLabel "basic fields" $ TestCase $
--              do let p1 = parse (do w1 <- parseField "Foo" False parseVersion
--                                    skipMany parseWhite
--                                    w2 <- parseField "Bar" True word
--                                    return (w1, w2)
--                                ) ""
md9ms's avatar
md9ms committed
438
--                     knownVal1 = (Version {versionBranch = [3,2], versionTags = ["one"]},"boo")
md9ms's avatar
md9ms committed
439
440
441
442
443
444
445
446
447
448
449
450
--                 assertRight "basic spaces 1"
--                   knownVal1 (p1 "Foo: 3.2-one\nBar: boo")
--                 assertRight "basic spaces 2"
--                   knownVal1 (p1 "Foo: 3.2-one \t   \nBar: boo")
--                 assertRight "basic spaces 3"
--                   knownVal1 (p1 "Foo : 3.2-one \t   \nBar:    boo  ")
--                 assertRight "basic spaces 3"
--                   knownVal1 (p1 "Foo:3.2-one \t   \nBar:    boo  ")
--                 assertRight "basic spaces with newline"
--                   knownVal1 (p1 "Foo:\n 3.2-one \t   \nBar:    boo  ")
--                 assertRight "basic spaces with newline"
--                   knownVal1 (p1 "Foo:\n 3.2-one \t \n  \nBar:    boo  "),
ijones's avatar
ijones committed
451

md9ms's avatar
md9ms committed
452
453
454
455
              TestLabel "license parsers" $ TestCase $
                 sequence_ [assertRight ("license " ++ show lVal) lVal
                                        (parse parseLicense "" (show lVal))
                           | lVal <- [GPL,LGPL,BSD3,BSD4]],
ijones's avatar
ijones committed
456
457
458
459

              TestLabel "Required fields" $ TestCase $
                 do assertRight "some fields"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
460
                                                        (Version [0,0] ["asdf"]))}
ijones's avatar
ijones committed
461
462
463
464
                       (parseDescription "Name: foo\nVersion: 0.0-asdf")

                    assertRight "more fields foo"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
465
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
466
467
468
469
470
                                               license=GPL}
                       (parseDescription "Name: foo\nVersion:0.0-asdf\nLicense: GPL")

                    assertRight "required fields for foo"
                       emptyPackageDescription{package=(PackageIdentifier "foo"
md9ms's avatar
md9ms committed
471
                                                        (Version [0,0]["asdf"])),
ijones's avatar
ijones committed
472
473
474
                                        license=GPL, copyright="2004 isaac jones"}
                       (parseDescription "Name: foo\nVersion:0.0-asdf\nCopyright: 2004 isaac jones\nLicense: GPL"),
                                          
475
             TestCase $ assertRight "no library" Nothing
476
                        (library `liftM` parseDescription "Name: foo\nVersion: 1\nLicense: GPL\nMaintainer: someone\n\nExecutable: script\nMain-is: SomeFile.hs\n"),
ijones's avatar
ijones committed
477
478
479
480

             TestLabel "Package description" $ TestCase $ 
                assertRight "entire package description" testPkgDescAnswer
                                                         (parseDescription testPkgDesc)
md9ms's avatar
md9ms committed
481

ijones's avatar
ijones committed
482
483
             ]

ijones's avatar
ijones committed
484

ijones's avatar
ijones committed
485
486
487
488
489
490
491
492
493
494
assertRight :: (Eq val) => String -> val -> (Either a val) -> Assertion
assertRight mes expected actual
    =  assertBool mes
           (case actual of
             (Right v) -> v == expected
             _         -> False)

isError (Left _) = True
isError _        = False

ijones's avatar
ijones committed
495
test = runTestTT (TestList hunitTests)
ijones's avatar
ijones committed
496
#endif