Distribution/PackageDescription.hs

   1 {-# OPTIONS -cpp #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Distribution.PackageDescription
   5 -- Copyright   :  Isaac Jones 2003-2005
   6 --
   7 -- Maintainer  :  Isaac Jones <ijones@syntaxpolice.org>
   8 -- Stability   :  alpha
   9 -- Portability :  portable
  10 --
  11 -- Package description and parsing.
  12
  13 {- All rights reserved.
  14
  15 Redistribution and use in source and binary forms, with or without
  16 modification, are permitted provided that the following conditions are
  17 met:
  18
  19     * Redistributions of source code must retain the above copyright
  20       notice, this list of conditions and the following disclaimer.
  21
  22     * Redistributions in binary form must reproduce the above
  23       copyright notice, this list of conditions and the following
  24       disclaimer in the documentation and/or other materials provided
  25       with the distribution.
  26
  27     * Neither the name of Isaac Jones nor the names of other
  28       contributors may be used to endorse or promote products derived
  29       from this software without specific prior written permission.
  30
  31 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  32 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  33 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  34 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  35 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  36 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  37 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  38 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  39 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  40 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  41 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
  42
  43 module Distribution.PackageDescription (
  44         -- * Package descriptions
  45         PackageDescription(..),
  46         emptyPackageDescription,
  47         readPackageDescription,
  48         parseDescription,
  49         StanzaField(..),
  50         LineNo,
  51         basicStanzaFields,
  52         writePackageDescription,
  53         showPackageDescription,
  54         sanityCheckPackage, errorOut,
  55         setupMessage,
  56         Library(..),
  57         withLib,
  58         hasLibs,
  59         libModules,
  60         Executable(..),
  61         withExe,
  62         exeModules,
  63         -- * Build information
  64         BuildInfo(..),
  65         emptyBuildInfo,
  66         -- ** Supplementary build information
  67         HookedBuildInfo,
  68         emptyHookedBuildInfo,
  69         readHookedBuildInfo,
  70         parseHookedBuildInfo,
  71         writeHookedBuildInfo,
  72         showHookedBuildInfo,
  73         updatePackageDescription,
  74         -- * Utilities
  75         ParseResult(..),
  76         PError, PWarning, showError,
  77         hcOptions,
  78         autogenModuleName,
  79         haddockName,
  80 #ifdef DEBUG
  81         hunitTests,
  82         test
  83 #endif
  84   ) where
  85
  86 import Control.Monad(liftM, foldM, when)
  87 import Data.Char
  88 import Data.Maybe(fromMaybe, isNothing, catMaybes)
  89 import Data.List (nub,lookup)
  90 import Text.PrettyPrint.HughesPJ
  91 import System.Directory(doesFileExist)
  92 import System.Environment(getProgName)
  93 import System.IO(hPutStrLn, stderr)
  94 import System.Exit
  95
  96 import Distribution.ParseUtils
  97 import Distribution.Package(PackageIdentifier(..),showPackageId,
  98                             parsePackageName)
  99 import Distribution.Version(Version(..), VersionRange(..), withinRange,
 100                             showVersion, parseVersion, showVersionRange, parseVersionRange)
 101 import Distribution.License(License(..))
 102 import Distribution.Version(Dependency(..))
 103 import Distribution.Compiler(CompilerFlavor(..))
 104 import Distribution.Simple.Utils(currentDir, die, dieWithLocation, warn)
 105 import Language.Haskell.Extension(Extension(..))
 106
 107 import Distribution.Compat.ReadP as ReadP hiding (get)
 108 import Distribution.Compat.FilePath(joinFileExt)
 109
 110 #ifdef DEBUG
 111 import HUnit (Test(..), assertBool, Assertion, runTestTT, Counts, assertEqual)
 112 import Distribution.ParseUtils  (runP)
 113 #endif
 114
 115 -- |Fix. Figure out a way to get this from .cabal file
 116 cabalVersion :: Version
 117 cabalVersion = Version [1,1,6] []
 118
 119 -- | This data type is the internal representation of the file @pkg.cabal@.
 120 -- It contains two kinds of information about the package: information
 121 -- which is needed for all packages, such as the package name and version, and
 122 -- information which is needed for the simple build system only, such as
 123 -- the compiler options and library name.
 124 --
 125 data PackageDescription
 126     =  PackageDescription {
 127         -- the following are required by all packages:
 128         package        :: PackageIdentifier,
 129         license        :: License,
 130         licenseFile    :: FilePath,
 131         copyright      :: String,
 132         maintainer     :: String,
 133         author         :: String,
 134         stability      :: String,
 135         testedWith     :: [(CompilerFlavor,VersionRange)],
 136         homepage       :: String,
 137         pkgUrl         :: String,
 138         synopsis       :: String, -- ^A one-line summary of this package
 139         description    :: String, -- ^A more verbose description of this package
 140         category       :: String,
 141         buildDepends   :: [Dependency],
 142         descCabalVersion :: VersionRange, -- ^If this package depends on a specific version of Cabal, give that here.
 143         -- components
 144         library        :: Maybe Library,
 145         executables    :: [Executable],
 146         dataFiles      :: [FilePath],
 147         extraSrcFiles  :: [FilePath],
 148         extraTmpFiles  :: [FilePath]
 149     }
 150     deriving (Show, Read, Eq)
 151
 152 data Library = Library {
 153         exposedModules    :: [String],
 154         libBuildInfo      :: BuildInfo
 155     }
 156     deriving (Show, Eq, Read)
 157
 158 emptyLibrary :: Library
 159 emptyLibrary = Library [] emptyBuildInfo
 160
 161 emptyPackageDescription :: PackageDescription
 162 emptyPackageDescription
 163     =  PackageDescription {package      = PackageIdentifier "" (Version [] []),
 164                       license      = AllRightsReserved,
 165                       licenseFile  = "",
 166                       descCabalVersion = AnyVersion,
 167                       copyright    = "",
 168                       maintainer   = "",
 169                       author       = "",
 170                       stability    = "",
 171                       testedWith   = [],
 172                       buildDepends = [],
 173                       homepage     = "",
 174                       pkgUrl       = "",
 175                       synopsis     = "",
 176                       description  = "",
 177                       category     = "",
 178                       library      = Nothing,
 179                       executables  = [],
 180                       dataFiles    = [],
 181                       extraSrcFiles = [],
 182                       extraTmpFiles = []
 183                      }
 184
 185 -- |Get all the module names from the libraries in this package
 186 libModules :: PackageDescription -> [String]
 187 libModules PackageDescription{library=lib}
 188     = maybe [] exposedModules lib
 189        ++ maybe [] (otherModules . libBuildInfo) lib
 190
 191 -- |Get all the module names from the exes in this package
 192 exeModules :: PackageDescription -> [String]
 193 exeModules PackageDescription{executables=execs}
 194     = concatMap (otherModules . buildInfo) execs
 195
 196 -- |does this package have any libraries?
 197 hasLibs :: PackageDescription -> Bool
 198 hasLibs p = maybe False (buildable . libBuildInfo) (library p)
 199
 200 -- |'Maybe' version of 'hasLibs'
 201 maybeHasLibs :: PackageDescription -> Maybe Library
 202 maybeHasLibs p =
 203    library p >>= (\lib -> toMaybe (buildable (libBuildInfo lib)) lib)
 204
 205 -- Consider refactoring into executable and library versions.
 206 data BuildInfo = BuildInfo {
 207         buildable         :: Bool,      -- ^ component is buildable here
 208         ccOptions         :: [String],  -- ^ options for C compiler
 209         ldOptions         :: [String],  -- ^ options for linker
 210         frameworks        :: [String], -- ^support frameworks for Mac OS X
 211         cSources          :: [FilePath],
 212         hsSourceDirs      :: [FilePath], -- ^ where to look for the haskell module hierarchy
 213         otherModules      :: [String], -- ^ non-exposed or non-main modules
 214         extensions        :: [Extension],
 215         extraLibs         :: [String], -- ^ what libraries to link with when compiling a program that uses your package
 216         extraLibDirs      :: [String],
 217         includeDirs       :: [FilePath], -- ^directories to find .h files
 218         includes          :: [FilePath], -- ^ The .h files to be found in includeDirs
 219         installIncludes   :: [FilePath], -- ^ .h files to install with the package
 220         options           :: [(CompilerFlavor,[String])],
 221         ghcProfOptions       :: [String]
 222     }
 223     deriving (Show,Read,Eq)
 224
 225 emptyBuildInfo :: BuildInfo
 226 emptyBuildInfo = BuildInfo {
 227                       buildable         = True,
 228                       ccOptions         = [],
 229                       ldOptions         = [],
 230                       frameworks        = [],
 231                       cSources          = [],
 232                       hsSourceDirs      = [currentDir],
 233                       otherModules      = [],
 234                       extensions        = [],
 235                       extraLibs         = [],
 236                       extraLibDirs      = [],
 237                       includeDirs       = [],
 238                       includes          = [],
 239                       installIncludes   = [],
 240                       options           = [],
 241                       ghcProfOptions       = []
 242                      }
 243
 244 data Executable = Executable {
 245         exeName    :: String,
 246         modulePath :: FilePath,
 247         buildInfo  :: BuildInfo
 248     }
 249     deriving (Show, Read, Eq)
 250
 251 emptyExecutable :: Executable
 252 emptyExecutable = Executable {
 253                       exeName = "",
 254                       modulePath = "",
 255                       buildInfo = emptyBuildInfo
 256                      }
 257
 258 -- | Perform the action on each buildable 'Executable' in the package
 259 -- description.
 260 withExe :: PackageDescription -> (Executable -> IO a) -> IO ()
 261 withExe pkg_descr f =
 262   sequence_ [f exe | exe <- executables pkg_descr, buildable (buildInfo exe)]
 263
 264 type HookedBuildInfo = (Maybe BuildInfo, [(String, BuildInfo)])
 265
 266 emptyHookedBuildInfo :: HookedBuildInfo
 267 emptyHookedBuildInfo = (Nothing, [])
 268
 269 -- ------------------------------------------------------------
 270 -- * Utils
 271 -- ------------------------------------------------------------
 272
 273 -- |If the package description has a library section, call the given
 274 --  function with the library build info as argument.
 275 withLib :: PackageDescription -> a -> (Library -> IO a) -> IO a
 276 withLib pkg_descr a f =
 277    maybe (return a) f (maybeHasLibs pkg_descr)
 278
 279 setupMessage :: String -> PackageDescription -> IO ()
 280 setupMessage msg pkg_descr =
 281    putStrLn (msg ++ ' ':showPackageId (package pkg_descr) ++ "...")
 282
 283 -- |Update the given package description with the output from the
 284 -- pre-hooks.
 285
 286 updatePackageDescription :: HookedBuildInfo -> PackageDescription -> PackageDescription
 287 updatePackageDescription (mb_lib_bi, exe_bi) p
 288     = p{ executables = updateExecutables exe_bi    (executables p)
 289        , library     = updateLibrary     mb_lib_bi (library     p)
 290        }
 291     where
 292       updateLibrary :: Maybe BuildInfo -> Maybe Library -> Maybe Library
 293       updateLibrary (Just bi) (Just lib) = Just (lib{libBuildInfo = unionBuildInfo bi (libBuildInfo lib)})
 294       updateLibrary Nothing   mb_lib     = mb_lib
 295
 296        --the lib only exists in the buildinfo file.  FIX: Is this
 297        --wrong?  If there aren't any exposedModules, then the library
 298        --won't build anyway.  add to sanity checker?
 299       updateLibrary (Just bi) Nothing     = Just emptyLibrary{libBuildInfo=bi}
 300
 301       updateExecutables :: [(String, BuildInfo)] -- ^[(exeName, new buildinfo)]
 302                         -> [Executable]          -- ^list of executables to update
 303                         -> [Executable]          -- ^list with exeNames updated
 304       updateExecutables exe_bi' executables' = foldr updateExecutable executables' exe_bi'
 305
 306       updateExecutable :: (String, BuildInfo) -- ^(exeName, new buildinfo)
 307                        -> [Executable]        -- ^list of executables to update
 308                        -> [Executable]        -- ^libst with exeName updated
 309       updateExecutable _                 []         = []
 310       updateExecutable exe_bi'@(name,bi) (exe:exes)
 311         | exeName exe == name = exe{buildInfo = unionBuildInfo bi (buildInfo exe)} : exes
 312         | otherwise           = exe : updateExecutable exe_bi' exes
 313
 314 unionBuildInfo :: BuildInfo -> BuildInfo -> BuildInfo
 315 unionBuildInfo b1 b2
 316     = b1{buildable         = buildable b1 && buildable b2,
 317          ccOptions         = combine ccOptions,
 318          ldOptions         = combine ldOptions,
 319          frameworks        = combine frameworks,
 320          cSources          = combine cSources,
 321          hsSourceDirs      = combine hsSourceDirs,
 322          otherModules      = combine otherModules,
 323          extensions        = combine extensions,
 324          extraLibs         = combine extraLibs,
 325          extraLibDirs      = combine extraLibDirs,
 326          includeDirs       = combine includeDirs,
 327          includes          = combine includes,
 328          installIncludes   = combine installIncludes,
 329          options           = combine options
 330         }
 331       where
 332       combine :: (Eq a) => (BuildInfo -> [a]) -> [a]
 333       combine f = nub $ f b1 ++ f b2
 334
 335 -- |Select options for a particular Haskell compiler.
 336 hcOptions :: CompilerFlavor -> [(CompilerFlavor, [String])] -> [String]
 337 hcOptions hc hc_opts = [opt | (hc',opts) <- hc_opts, hc' == hc, opt <- opts]
 338
 339 -- |The name of the auto-generated module associated with a package
 340 autogenModuleName :: PackageDescription -> String
 341 autogenModuleName pkg_descr =
 342     "Paths_" ++ map fixchar (pkgName (package pkg_descr))
 343   where fixchar '-' = '_'
 344         fixchar c   = c
 345
 346 haddockName :: PackageDescription -> FilePath
 347 haddockName pkg_descr =
 348    joinFileExt (pkgName (package pkg_descr)) "haddock"
 349
 350 -- ------------------------------------------------------------
 351 -- * Parsing & Pretty printing
 352 -- ------------------------------------------------------------
 353
 354 -- the strings for the required fields are necessary here, and so we
 355 -- don't repeat ourselves, I name them:
 356
 357 reqNameName       = "name"
 358 reqNameVersion    = "version"
 359 reqNameCopyright  = "copyright"
 360 reqNameMaintainer = "maintainer"
 361 reqNameSynopsis   = "synopsis"
 362
 363 basicStanzaFields :: [StanzaField PackageDescription]
 364 basicStanzaFields =
 365  [ simpleField reqNameName
 366                            text                   parsePackageName
 367                            (pkgName . package)    (\name pkg -> pkg{package=(package pkg){pkgName=name}})
 368  , simpleField reqNameVersion
 369                            (text . showVersion)   parseVersion
 370                            (pkgVersion . package) (\ver pkg -> pkg{package=(package pkg){pkgVersion=ver}})
 371  , simpleField "cabal-version"
 372                            (text . showVersionRange) parseVersionRange
 373                            descCabalVersion       (\v pkg -> pkg{descCabalVersion=v})
 374  , simpleField "license"
 375                            (text . show)          parseLicenseQ
 376                            license                (\l pkg -> pkg{license=l})
 377  , simpleField "license-file"
 378                            showFilePath           parseFilePathQ
 379                            licenseFile            (\l pkg -> pkg{licenseFile=l})
 380  , simpleField reqNameCopyright
 381                            showFreeText           (munch (const True))
 382                            copyright              (\val pkg -> pkg{copyright=val})
 383  , simpleField reqNameMaintainer
 384                            showFreeText           (munch (const True))
 385                            maintainer             (\val pkg -> pkg{maintainer=val})
 386  , commaListField  "build-depends"
 387                            showDependency         parseDependency
 388                            buildDepends           (\xs    pkg -> pkg{buildDepends=xs})
 389  , simpleField "stability"
 390                            showFreeText           (munch (const True))
 391                            stability              (\val pkg -> pkg{stability=val})
 392  , simpleField "homepage"
 393                            showFreeText           (munch (const True))
 394                            homepage               (\val pkg -> pkg{homepage=val})
 395  , simpleField "package-url"
 396                            showFreeText           (munch (const True))
 397                            pkgUrl                 (\val pkg -> pkg{pkgUrl=val})
 398  , simpleField reqNameSynopsis
 399                            showFreeText           (munch (const True))
 400                            synopsis               (\val pkg -> pkg{synopsis=val})
 401  , simpleField "description"
 402                            showFreeText           (munch (const True))
 403                            description            (\val pkg -> pkg{description=val})
 404  , simpleField "category"
 405                            showFreeText           (munch (const True))
 406                            category               (\val pkg -> pkg{category=val})
 407  , simpleField "author"
 408                            showFreeText           (munch (const True))
 409                            author                 (\val pkg -> pkg{author=val})
 410  , listField "tested-with"
 411                            showTestedWith         parseTestedWithQ
 412                            testedWith             (\val pkg -> pkg{testedWith=val})
 413  , listField "data-files"  showFilePath           parseFilePathQ
 414                            dataFiles              (\val pkg -> pkg{dataFiles=val})
 415  , listField "extra-source-files" showFilePath    parseFilePathQ
 416                            extraSrcFiles          (\val pkg -> pkg{extraSrcFiles=val})
 417  , listField "extra-tmp-files" showFilePath       parseFilePathQ
 418                            extraTmpFiles          (\val pkg -> pkg{extraTmpFiles=val})
 419  ]
 420
 421 executableStanzaFields :: [StanzaField Executable]
 422 executableStanzaFields =
 423  [ simpleField "executable"
 424                            showFreeText       (munch (const True))
 425                            exeName            (\xs    exe -> exe{exeName=xs})
 426  , simpleField "main-is"
 427                            showFilePath       parseFilePathQ
 428                            modulePath         (\xs    exe -> exe{modulePath=xs})
 429  ]
 430
 431 binfoFields :: [StanzaField BuildInfo]
 432 binfoFields =
 433  [ simpleField "buildable"
 434                            (text . show)      parseReadS
 435                            buildable          (\val binfo -> binfo{buildable=val})
 436  , listField "cc-options"
 437                            showToken          parseTokenQ
 438                            ccOptions          (\val binfo -> binfo{ccOptions=val})
 439  , listField "ld-options"
 440                            showToken          parseTokenQ
 441                            ldOptions          (\val binfo -> binfo{ldOptions=val})
 442  , listField "frameworks"
 443                            showToken          parseTokenQ
 444                            frameworks         (\val binfo -> binfo{frameworks=val})
 445  , listField   "c-sources"
 446                            showFilePath       parseFilePathQ
 447                            cSources           (\paths binfo -> binfo{cSources=paths})
 448  , listField   "extensions"
 449                            (text . show)      parseExtensionQ
 450                            extensions         (\exts  binfo -> binfo{extensions=exts})
 451  , listField   "extra-libraries"
 452                            showToken          parseTokenQ
 453                            extraLibs          (\xs    binfo -> binfo{extraLibs=xs})
 454  , listField   "extra-lib-dirs"
 455                            showFilePath       parseFilePathQ
 456                            extraLibDirs       (\xs    binfo -> binfo{extraLibDirs=xs})
 457  , listField   "includes"
 458                            showFilePath       parseFilePathQ
 459                            includes           (\paths binfo -> binfo{includes=paths})
 460  , listField   "install-includes"
 461                            showFilePath       parseFilePathQ
 462                            includes           (\paths binfo -> binfo{installIncludes=paths})
 463  , listField   "include-dirs"
 464                            showFilePath       parseFilePathQ
 465                            includeDirs        (\paths binfo -> binfo{includeDirs=paths})
 466  , listField   "hs-source-dirs"
 467                            showFilePath       parseFilePathQ
 468                            hsSourceDirs       (\paths binfo -> binfo{hsSourceDirs=paths})
 469  , listField   "other-modules"
 470                            text               parseModuleNameQ
 471                            otherModules       (\val binfo -> binfo{otherModules=val})
 472  , listField   "ghc-prof-options"
 473                            text               parseTokenQ
 474                            ghcProfOptions        (\val binfo -> binfo{ghcProfOptions=val})
 475  , optsField   "ghc-options"  GHC
 476                            options            (\path  binfo -> binfo{options=path})
 477  , optsField   "hugs-options" Hugs
 478                            options            (\path  binfo -> binfo{options=path})
 479  , optsField   "nhc-options"  NHC
 480                            options            (\path  binfo -> binfo{options=path})
 481  , optsField   "jhc-options"  JHC
 482                            options            (\path  binfo -> binfo{options=path})
 483  ]
 484
 485
 486 -- --------------------------------------------
 487 -- ** Parsing
 488
 489 -- | Given a parser and a filename, return the parse of the file,
 490 -- after checking if the file exists.
 491 readAndParseFile ::  (String -> ParseResult a) -> FilePath -> IO a
 492 readAndParseFile parser fpath = do
 493   exists <- doesFileExist fpath
 494   when (not exists) (die $ "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue.")
 495   str <- readFile fpath
 496   case parser str of
 497     ParseFailed e -> do
 498         let (lineNo, message) = locatedErrorMsg e
 499         dieWithLocation fpath lineNo message
 500     ParseOk ws x -> do
 501         mapM_ warn ws
 502         return x
 503
 504 -- |Parse the given package file.
 505 readPackageDescription :: FilePath -> IO PackageDescription
 506 readPackageDescription = readAndParseFile parseDescription
 507
 508 readHookedBuildInfo :: FilePath -> IO HookedBuildInfo
 509 readHookedBuildInfo = readAndParseFile parseHookedBuildInfo
 510
 511 parseDescription :: String -> ParseResult PackageDescription
 512 parseDescription inp = do (st:sts) <- splitStanzas inp
 513                           pkg <- foldM (parseBasicStanza basicStanzaFields) emptyPackageDescription st
 514                           exes <- mapM parseExecutableStanza sts
 515                           return pkg{executables=exes}
 516   where -- The basic stanza, with library building info
 517         parseBasicStanza ((StanzaField name _ set):fields) pkg (lineNo, f, val)
 518           | name == f = set lineNo val pkg
 519           | otherwise = parseBasicStanza fields pkg (lineNo, f, val)
 520           {-
 521      , listField   "exposed-modules"
 522                            text               parseModuleNameQ
 523                            (\p -> maybe [] exposedModules (library p))
 524                            (\xs    pkg -> let lib = fromMaybe emptyLibrary (library pkg) in
 525                                               pkg{library = Just lib{exposedModules=xs}})
 526 -}
 527         parseBasicStanza [] pkg (lineNo, f, val)
 528           | "exposed-modules" == f = do
 529                mods <- runP lineNo f (parseOptCommaList parseModuleNameQ) val
 530                return pkg{library=Just lib{exposedModules=mods}}
 531           | otherwise = do
 532                bi <- parseBInfoField binfoFields (libBuildInfo lib) (lineNo, f, val)
 533                return pkg{library=Just lib{libBuildInfo=bi}}
 534           where
 535             lib = fromMaybe emptyLibrary (library pkg)
 536
 537         parseExecutableStanza st@((lineNo, "executable",eName):_) =
 538           case lookupField "main-is" st of
 539             Just (_,_) -> foldM (parseExecutableField executableStanzaFields) emptyExecutable st
 540             Nothing    -> syntaxError lineNo $ "No 'Main-Is' field found for " ++ eName ++ " stanza"
 541         parseExecutableStanza ((lineNo, f,_):_) =
 542           syntaxError lineNo $ "'Executable' stanza starting with field '" ++ f ++ "'"
 543         parseExecutableStanza _ = error "This shouldn't happen!"
 544
 545         parseExecutableField ((StanzaField name _ set):fields) exe (lineNo, f, val)
 546           | name == f = set lineNo val exe
 547           | otherwise = parseExecutableField fields exe (lineNo, f, val)
 548         parseExecutableField [] exe (lineNo, f, val) = do
 549           binfo <- parseBInfoField binfoFields (buildInfo exe) (lineNo, f, val)
 550           return exe{buildInfo=binfo}
 551
 552         -- ...
 553         lookupField :: String -> Stanza -> Maybe (LineNo,String)
 554         lookupField x sts = lookup x (map (\(n,f,v) -> (f,(n,v))) sts)
 555
 556
 557 parseHookedBuildInfo :: String -> ParseResult HookedBuildInfo
 558 parseHookedBuildInfo inp = do
 559   stanzas@(mLibStr:exes) <- splitStanzas inp
 560   mLib <- parseLib mLibStr
 561   biExes <- mapM parseExe (maybe stanzas (const exes) mLib)
 562   return (mLib, biExes)
 563   where
 564     parseLib :: Stanza -> ParseResult (Maybe BuildInfo)
 565     parseLib (bi@((_, inFieldName, _):_))
 566         | map toLower inFieldName /= "executable" = liftM Just (parseBI bi)
 567     parseLib _ = return Nothing
 568     parseExe :: Stanza -> ParseResult (String, BuildInfo)
 569     parseExe ((lineNo, inFieldName, mName):bi)
 570         | map toLower inFieldName == "executable"
 571             = do bis <- parseBI bi
 572                  return (mName, bis)
 573         | otherwise = syntaxError lineNo "expecting 'executable' at top of stanza"
 574     parseExe [] = syntaxError 0 "error in parsing buildinfo file. Expected executable stanza"
 575     parseBI :: Stanza -> ParseResult BuildInfo
 576     parseBI st = foldM (parseBInfoField binfoFields) emptyBuildInfo st
 577
 578 parseBInfoField :: [StanzaField a] -> a -> (LineNo, String, String) -> ParseResult a
 579 parseBInfoField ((StanzaField name _ set):fields) binfo (lineNo, f, val)
 580           | name == f = set lineNo val binfo
 581           | otherwise = parseBInfoField fields binfo (lineNo, f, val)
 582 -- ignore "x-" extension fields without a warning
 583 parseBInfoField [] binfo (lineNo, 'x':'-':f, _) = return binfo
 584 parseBInfoField [] binfo (lineNo, f, _) = do
 585           warning $ "Unknown field '" ++ f ++ "'"
 586           return binfo
 587
 588 -- --------------------------------------------
 589 -- ** Pretty printing
 590
 591 writePackageDescription :: FilePath -> PackageDescription -> IO ()
 592 writePackageDescription fpath pkg = writeFile fpath (showPackageDescription pkg)
 593
 594 showPackageDescription :: PackageDescription -> String
 595 showPackageDescription pkg = render $
 596   ppFields pkg basicStanzaFields $$
 597   (case library pkg of
 598      Nothing  -> empty
 599      Just lib ->
 600         text "exposed-modules" <> colon <+> fsep (punctuate comma (map text (exposedModules lib))) $$
 601         ppFields (libBuildInfo lib) binfoFields) $$
 602   vcat (map ppExecutable (executables pkg))
 603   where
 604     ppExecutable exe =
 605       space $$
 606       ppFields exe executableStanzaFields $$
 607       ppFields (buildInfo exe) binfoFields
 608
 609     ppFields _ [] = empty
 610     ppFields pkg' ((StanzaField name get _):flds) =
 611            ppField name (get pkg') $$ ppFields pkg' flds
 612
 613 ppField name field = text name <> colon <+> field
 614
 615 writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
 616 writeHookedBuildInfo fpath pbi = writeFile fpath (showHookedBuildInfo pbi)
 617
 618 showHookedBuildInfo :: HookedBuildInfo -> String
 619 showHookedBuildInfo (mb_lib_bi, ex_bi) = render $
 620   (case mb_lib_bi of
 621      Nothing -> empty
 622      Just bi -> ppFields bi binfoFields) $$
 623   vcat (map ppExeBuildInfo ex_bi)
 624   where
 625     ppExeBuildInfo (name, bi) =
 626       space $$
 627       text "executable:" <+> text name $$
 628       ppFields bi binfoFields
 629
 630     ppFields _  [] = empty
 631     ppFields bi ((StanzaField name get _):flds) =
 632            ppField name (get bi) $$ ppFields bi flds
 633
 634
 635 -- ------------------------------------------------------------
 636 -- * Sanity Checking
 637 -- ------------------------------------------------------------
 638
 639 -- |Sanity check this description file.
 640
 641 -- FIX: add a sanity check for missing haskell files? That's why its
 642 -- in the IO monad.
 643
 644 sanityCheckPackage :: PackageDescription -> IO ([String] -- Warnings
 645                                                ,[String])-- Errors
 646 sanityCheckPackage pkg_descr
 647     = let libSane   = sanityCheckLib (library pkg_descr)
 648           nothingToDo = checkSanity
 649                         (null (executables pkg_descr) && isNothing (library pkg_descr))
 650                         "No executables and no library found. Nothing to do."
 651           noModules = checkSanity (hasMods pkg_descr)
 652                       "No exposed modules or executables in this package."
 653           allRights = checkSanity (license pkg_descr == AllRightsReserved)
 654                       "Package is copyright All Rights Reserved"
 655           noLicenseFile = checkSanity (null $ licenseFile pkg_descr)
 656                           "No license-file field."
 657           goodCabal = let v = (descCabalVersion pkg_descr)
 658                           in checkSanity (not $ cabalVersion  `withinRange` v)
 659                                  ("This package requires Cabal verion: " ++ (showVersionRange v) ++ ".")
 660
 661          in return $ (catMaybes [nothingToDo, noModules,
 662                                  allRights, noLicenseFile]
 663                      ,catMaybes $ libSane:goodCabal:(checkMissingFields pkg_descr))
 664
 665 -- |Output warnings and errors. Exit if any errors.
 666 errorOut :: [String]  -- ^Warnings
 667          -> [String]  -- ^errors
 668          -> IO ()
 669 errorOut warnings errors = do
 670   mapM warn warnings
 671   when (not (null errors)) $ do
 672     pname <- getProgName
 673     mapM (hPutStrLn stderr . ((pname ++ ": Error: ") ++)) errors
 674     exitWith (ExitFailure 1)
 675
 676 toMaybe :: Bool -> a -> Maybe a
 677 toMaybe b x = if b then Just x else Nothing
 678
 679 checkMissingFields :: PackageDescription -> [Maybe String]
 680 checkMissingFields pkg_descr =
 681     [missingField (pkgName . package)    reqNameName
 682     ,missingField (versionBranch .pkgVersion .package) reqNameVersion
 683     ]
 684     where missingField :: (PackageDescription -> [a]) -- Field accessor
 685                        -> String -- Name of field
 686                        -> Maybe String -- error message
 687           missingField f n
 688               = toMaybe (null (f pkg_descr)) ("Missing field: " ++ n)
 689
 690 sanityCheckLib :: Maybe Library -> Maybe String
 691 sanityCheckLib ml =
 692    ml >>= (\l ->
 693       toMaybe (null $ exposedModules l)
 694               ("Non-empty library, but empty exposed modules list. " ++
 695                "Cabal may not build this library correctly"))
 696
 697 checkSanity :: Bool -> String -> Maybe String
 698 checkSanity = toMaybe
 699
 700 hasMods :: PackageDescription -> Bool
 701 hasMods pkg_descr =
 702    null (executables pkg_descr) &&
 703       maybe True (null . exposedModules) (library pkg_descr)
 704
 705
 706 -- ------------------------------------------------------------
 707 -- * Testing
 708 -- ------------------------------------------------------------
 709 #ifdef DEBUG
 710 testPkgDesc :: String
 711 testPkgDesc = unlines [
 712         "-- Required",
 713         "Name: Cabal",
 714         "Version: 0.1.1.1.1-rain",
 715         "License: LGPL",
 716         "License-File: foo",
 717         "Copyright: Free Text String",
 718         "Cabal-version: >1.1.1",
 719         "-- Optional - may be in source?",
 720         "Author: Happy Haskell Hacker",
 721         "Homepage: http://www.haskell.org/foo",
 722         "Package-url: http://www.haskell.org/foo",
 723         "Synopsis: a nice package!",
 724         "Description: a really nice package!",
 725         "Category: tools",
 726         "buildable: True",
 727         "CC-OPTIONS: -g -o",
 728         "LD-OPTIONS: -BStatic -dn",
 729         "Frameworks: foo",
 730         "Tested-with: GHC",
 731         "Stability: Free Text String",
 732         "Build-Depends: haskell-src, HUnit>=1.0.0-rain",
 733         "Other-Modules: Distribution.Package, Distribution.Version,",
 734         "                Distribution.Simple.GHCPackageConfig",
 735         "Other-files: file1, file2",
 736         "Extra-Tmp-Files:    file1, file2",
 737         "C-Sources: not/even/rain.c, such/small/hands",
 738         "HS-Source-Dirs: src, src2",
 739         "Exposed-Modules: Distribution.Void, Foo.Bar",
 740         "Extensions: OverlappingInstances, TypeSynonymInstances",
 741         "Extra-Libraries: libfoo, bar, bang",
 742         "Extra-Lib-Dirs: \"/usr/local/libs\"",
 743         "Include-Dirs: your/slightest, look/will",
 744         "Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
 745         "Install-Includes: /easily/unclose, /me, \"funky, path\\\\name\"",
 746         "GHC-Options: -fTH -fglasgow-exts",
 747         "Hugs-Options: +TH",
 748         "Nhc-Options: ",
 749         "Jhc-Options: ",
 750         "",
 751         "-- Next is an executable",
 752         "Executable: somescript",
 753         "Main-is: SomeFile.hs",
 754         "Other-Modules: Foo1, Util, Main",
 755         "HS-Source-Dir: scripts",
 756         "Extensions: OverlappingInstances",
 757         "GHC-Options: ",
 758         "Hugs-Options: ",
 759         "Nhc-Options: ",
 760         "Jhc-Options: "
 761         ]
 762
 763 testPkgDescAnswer :: PackageDescription
 764 testPkgDescAnswer =
 765  PackageDescription {package = PackageIdentifier {pkgName = "Cabal",
 766                                                  pkgVersion = Version {versionBranch = [0,1,1,1,1],
 767                                                  versionTags = ["rain"]}},
 768                     license = LGPL,
 769                     licenseFile = "foo",
 770                     copyright = "Free Text String",
 771                     author  = "Happy Haskell Hacker",
 772                     homepage = "http://www.haskell.org/foo",
 773                     pkgUrl   = "http://www.haskell.org/foo",
 774                     synopsis = "a nice package!",
 775                     description = "a really nice package!",
 776                     category = "tools",
 777                                descCabalVersion=LaterVersion (Version [1,1,1] []),
 778                     buildDepends = [Dependency "haskell-src" AnyVersion,
 779                                      Dependency "HUnit"
 780                                      (UnionVersionRanges (ThisVersion (Version [1,0,0] ["rain"]))
 781                                       (LaterVersion (Version [1,0,0] ["rain"])))],
 782                     testedWith=[(GHC, AnyVersion)],
 783                     maintainer = "",
 784                     stability = "Free Text String",
 785                     extraTmpFiles=["file1", "file2"],
 786                     extraSrcFiles=["file1", "file2"],
 787                     dataFiles=[],
 788
 789                     library = Just $ Library {
 790                         exposedModules = ["Distribution.Void", "Foo.Bar"],
 791                         libBuildInfo=BuildInfo {
 792                            buildable = True,
 793                            ccOptions = ["-g", "-o"],
 794                            ldOptions = ["-BStatic", "-dn"],
 795                            frameworks = ["foo"],
 796                            cSources = ["not/even/rain.c", "such/small/hands"],
 797                            hsSourceDirs = ["src", "src2"],
 798                            otherModules = ["Distribution.Package",
 799                                            "Distribution.Version",
 800                                            "Distribution.Simple.GHCPackageConfig"],
 801                            extensions = [OverlappingInstances, TypeSynonymInstances],
 802                            extraLibs = ["libfoo", "bar", "bang"],
 803                            extraLibDirs = ["/usr/local/libs"],
 804                            includeDirs = ["your/slightest", "look/will"],
 805                            includes = ["/easily/unclose", "/me", "funky, path\\name"],
 806                            installIncludes = ["/easily/unclose", "/me", "funky, path\\name"],
 807                            -- Note reversed order:
 808                            ghcProfOptions = [],
 809                            options = [(JHC,[]),(NHC, []), (Hugs,["+TH"]), (GHC,["-fTH","-fglasgow-exts"])]}
 810                     },
 811                     executables = [Executable "somescript"
 812                        "SomeFile.hs" (
 813                       emptyBuildInfo{
 814                         otherModules=["Foo1","Util","Main"],
 815                         hsSourceDirs = ["scripts"],
 816                         extensions = [OverlappingInstances],
 817                         options = [(JHC,[]),(NHC,[]),(Hugs,[]),(GHC,[])]
 818                       })]
 819 }
 820
 821 hunitTests :: [Test]
 822 hunitTests = [
 823               TestLabel "license parsers" $ TestCase $
 824                  sequence_ [assertParseOk ("license " ++ show lVal) lVal
 825                                         (runP 1 "license" parseLicenseQ (show lVal))
 826                            | lVal <- [GPL,LGPL,BSD3,BSD4]],
 827
 828               TestLabel "Required fields" $ TestCase $
 829                  do assertParseOk "some fields"
 830                        emptyPackageDescription{package=(PackageIdentifier "foo"
 831                                                         (Version [0,0] ["asdf"]))}
 832                        (parseDescription "Name: foo\nVersion: 0.0-asdf")
 833
 834                     assertParseOk "more fields foo"
 835                        emptyPackageDescription{package=(PackageIdentifier "foo"
 836                                                         (Version [0,0]["asdf"])),
 837                                                license=GPL}
 838                        (parseDescription "Name: foo\nVersion:0.0-asdf\nLicense: GPL")
 839
 840                     assertParseOk "required fields for foo"
 841                        emptyPackageDescription{package=(PackageIdentifier "foo"
 842                                                         (Version [0,0]["asdf"])),
 843                                         license=GPL, copyright="2004 isaac jones"}
 844                        (parseDescription "Name: foo\nVersion:0.0-asdf\nCopyright: 2004 isaac jones\nLicense: GPL"),
 845
 846              TestCase $ assertParseOk "no library" Nothing
 847                         (library `liftM` parseDescription "Name: foo\nVersion: 1\nLicense: GPL\nMaintainer: someone\n\nExecutable: script\nMain-is: SomeFile.hs\n"),
 848
 849              TestLabel "Package description" $ TestCase $
 850                 assertParseOk "entire package description" testPkgDescAnswer
 851                                                          (parseDescription testPkgDesc),
 852              TestLabel "Package description pretty" $ TestCase $
 853                 case parseDescription testPkgDesc of
 854                  ParseFailed _ -> assertBool "can't parse description" False
 855                  ParseOk _ d -> case parseDescription $ showPackageDescription d of
 856                                 ParseFailed _ ->
 857                                     assertBool "can't parse description after pretty print!" False
 858                                 ParseOk _ d' ->
 859                                     assertBool ("parse . show . parse not identity."
 860                                                 ++"   Incorrect fields:"
 861                                                 ++ (show $ comparePackageDescriptions d d'))
 862                                                (d == d'),
 863             TestLabel "Sanity checker" $ TestCase $ do
 864               (warns, ers) <- sanityCheckPackage emptyPackageDescription
 865               assertEqual "Wrong number of errors"   2 (length ers)
 866               assertEqual "Wrong number of warnings" 4 (length warns)
 867             ]
 868
 869 -- |Compare two package descriptions and see which fields aren't the same.
 870 comparePackageDescriptions :: PackageDescription
 871                            -> PackageDescription
 872                            -> [String]      -- ^Errors
 873 comparePackageDescriptions p1 p2
 874     = catMaybes $ myCmp package "package" : myCmp license "license": myCmp licenseFile "licenseFile":  myCmp copyright "copyright":  myCmp maintainer "maintainer":  myCmp author "author":  myCmp stability "stability":  myCmp testedWith "testedWith":  myCmp homepage "homepage":  myCmp pkgUrl "pkgUrl":  myCmp synopsis "synopsis":  myCmp description "description":  myCmp category "category":  myCmp buildDepends "buildDepends":  myCmp library "library":  myCmp executables "executables": myCmp descCabalVersion "cabal-version":[]
 875
 876
 877       where myCmp :: (Eq a, Show a) => (PackageDescription -> a)
 878                   -> String       -- Error message
 879                   -> Maybe String --
 880             myCmp f er = let e1 = f p1
 881                              e2 = f p2
 882                           in toMaybe (e1 /= e2)
 883                                      (er ++ " Expected: " ++ show e1
 884                                               ++ " Got: " ++ show e2)
 885
 886 -- |Assert that the 2nd value parses correctly and matches the first value
 887 assertParseOk :: (Eq val) => String -> val -> ParseResult val -> Assertion
 888 assertParseOk mes expected actual
 889     =  assertBool mes
 890            (case actual of
 891              ParseOk _ v -> v == expected
 892              _         -> False)
 893
 894 test :: IO Counts
 895 test = runTestTT (TestList hunitTests)
 896 #endif