-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Build.PackageInfoModule
-- Copyright   :
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Generating the PackageInfo_pkgname module.
--
-- This is a module that Cabal generates for the benefit of packages. It
-- enables them to find their package informations.
module Distribution.Simple.Build.PackageInfoModule
  ( generatePackageInfoModule
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Package
import Distribution.PackageDescription
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Utils.ShortText
import Distribution.Version

import qualified Distribution.Simple.Build.PackageInfoModule.Z as Z

-- ------------------------------------------------------------

-- * Building Paths_<pkg>.hs

-- ------------------------------------------------------------

generatePackageInfoModule :: PackageDescription -> LocalBuildInfo -> String
generatePackageInfoModule :: PackageDescription -> LocalBuildInfo -> String
generatePackageInfoModule PackageDescription
pkg_descr LocalBuildInfo
lbi =
  Z -> String
Z.render
    Z.Z
      { zPackageName :: String
Z.zPackageName = PackageName -> String
showPkgName (PackageName -> String) -> PackageName -> String
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg_descr
      , zVersionDigits :: String
Z.zVersionDigits = [Int] -> String
forall a. Show a => a -> String
show ([Int] -> String) -> [Int] -> String
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionNumbers (Version -> [Int]) -> Version -> [Int]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg_descr
      , zSynopsis :: String
Z.zSynopsis = ShortText -> String
fromShortText (ShortText -> String) -> ShortText -> String
forall a b. (a -> b) -> a -> b
$ PackageDescription -> ShortText
synopsis PackageDescription
pkg_descr
      , zCopyright :: String
Z.zCopyright = ShortText -> String
fromShortText (ShortText -> String) -> ShortText -> String
forall a b. (a -> b) -> a -> b
$ PackageDescription -> ShortText
copyright PackageDescription
pkg_descr
      , zHomepage :: String
Z.zHomepage = ShortText -> String
fromShortText (ShortText -> String) -> ShortText -> String
forall a b. (a -> b) -> a -> b
$ PackageDescription -> ShortText
homepage PackageDescription
pkg_descr
      , zSupportsNoRebindableSyntax :: Bool
Z.zSupportsNoRebindableSyntax = Bool
supports_rebindable_syntax
      }
  where
    supports_rebindable_syntax :: Bool
supports_rebindable_syntax = Version -> Bool
ghc_newer_than ([Int] -> Version
mkVersion [Int
7, Int
0, Int
1])

    ghc_newer_than :: Version -> Bool
ghc_newer_than Version
minVersion =
      case CompilerFlavor -> Compiler -> Maybe Version
compilerCompatVersion CompilerFlavor
GHC (LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi) of
        Maybe Version
Nothing -> Bool
False
        Just Version
version -> Version
version Version -> VersionRange -> Bool
`withinRange` Version -> VersionRange
orLaterVersion Version
minVersion

showPkgName :: PackageName -> String
showPkgName :: PackageName -> String
showPkgName = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
fixchar (String -> String)
-> (PackageName -> String) -> PackageName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
unPackageName

fixchar :: Char -> Char
fixchar :: Char -> Char
fixchar Char
'-' = Char
'_'
fixchar Char
c = Char
c