{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Distribution.Nixpkgs.Haskell.FromCabal
  ( HaskellResolver, NixpkgsResolver
  , fromGenericPackageDescription , finalizeGenericPackageDescription , fromPackageDescription
  ) where

import Control.Lens
import Data.Maybe
import Data.Set ( Set )
import qualified Data.Set as Set
import Distribution.Compiler
import Distribution.Nixpkgs.Haskell
import qualified Distribution.Nixpkgs.Haskell as Nix
import Distribution.Nixpkgs.Haskell.Constraint
import Distribution.Nixpkgs.Haskell.FromCabal.License
import Distribution.Nixpkgs.Haskell.FromCabal.Name
import Distribution.Nixpkgs.Haskell.FromCabal.Normalize
import Distribution.Nixpkgs.Haskell.FromCabal.PostProcess (postProcess)
import qualified Distribution.Nixpkgs.License as Nix
import qualified Distribution.Nixpkgs.Meta as Nix
import Distribution.Package
import Distribution.PackageDescription
import qualified Distribution.PackageDescription as Cabal
import Distribution.PackageDescription.Configuration as Cabal
import Distribution.System
import Distribution.Types.PackageVersionConstraint
import Distribution.Text ( display )
import Distribution.Types.ComponentRequestedSpec as Cabal
import Distribution.Types.ExeDependency as Cabal
import Distribution.Types.LegacyExeDependency as Cabal
import Distribution.Types.PkgconfigDependency as Cabal
import Distribution.Types.UnqualComponentName as Cabal
import Distribution.Utils.ShortText ( fromShortText )
import Distribution.Version
import Language.Nix

type HaskellResolver = PackageVersionConstraint -> Bool
type NixpkgsResolver = Identifier -> Maybe Binding

fromGenericPackageDescription :: HaskellResolver -> NixpkgsResolver -> Platform -> CompilerInfo -> FlagAssignment -> [Constraint] -> GenericPackageDescription -> Derivation
fromGenericPackageDescription :: HaskellResolver
-> NixpkgsResolver
-> Platform
-> CompilerInfo
-> FlagAssignment
-> [Constraint]
-> GenericPackageDescription
-> Derivation
fromGenericPackageDescription HaskellResolver
haskellResolver NixpkgsResolver
nixpkgsResolver Platform
arch CompilerInfo
compiler FlagAssignment
flags [Constraint]
constraints GenericPackageDescription
genDesc =
  HaskellResolver
-> NixpkgsResolver
-> [Dependency]
-> FlagAssignment
-> PackageDescription
-> Derivation
fromPackageDescription HaskellResolver
haskellResolver NixpkgsResolver
nixpkgsResolver [Dependency]
missingDeps FlagAssignment
flags PackageDescription
descr
    where
      (PackageDescription
descr, [Dependency]
missingDeps) = HaskellResolver
-> Platform
-> CompilerInfo
-> FlagAssignment
-> [Constraint]
-> GenericPackageDescription
-> (PackageDescription, [Dependency])
finalizeGenericPackageDescription HaskellResolver
haskellResolver Platform
arch CompilerInfo
compiler FlagAssignment
flags [Constraint]
constraints GenericPackageDescription
genDesc

finalizeGenericPackageDescription :: HaskellResolver -> Platform -> CompilerInfo -> FlagAssignment -> [Constraint] -> GenericPackageDescription -> (PackageDescription, [Dependency])
finalizeGenericPackageDescription :: HaskellResolver
-> Platform
-> CompilerInfo
-> FlagAssignment
-> [Constraint]
-> GenericPackageDescription
-> (PackageDescription, [Dependency])
finalizeGenericPackageDescription HaskellResolver
haskellResolver Platform
arch CompilerInfo
compiler FlagAssignment
flags [Constraint]
constraints GenericPackageDescription
genDesc =
  let
    -- finalizePD incooperates the 'LibraryName' of a dependency
    -- which we always ignore, so the Cabal-compatible resolver
    -- is a simple wrapper around our 'HaskellResolver'
    makeCabalResolver :: HaskellResolver -> Dependency -> Bool
    makeCabalResolver :: HaskellResolver -> Dependency -> Bool
makeCabalResolver HaskellResolver
r (Dependency PackageName
n VersionRange
v NonEmptySet LibraryName
_) = HaskellResolver
r (PackageName -> VersionRange -> Constraint
PackageVersionConstraint PackageName
n VersionRange
v)

    -- the finalizePD API changed in Cabal 3.4.0.0, so we need to do some plumbing.
    -- See https://github.com/haskell/cabal/issues/5570
#if MIN_VERSION_Cabal(3,4,0)
    makeCabalConstraints :: [Constraint] -> [PackageVersionConstraint]
    makeCabalConstraints :: [Constraint] -> [Constraint]
makeCabalConstraints = forall a. a -> a
id
#else
    makeCabalConstraints :: [Constraint] -> [Dependency]
    makeCabalConstraints = map $ \(PackageVersionConstraint n v) -> Dependency n v mempty
#endif

    -- We have to call the Cabal finalizer several times with different resolver
    -- functions, and this convenience function makes our code shorter.
    finalize :: HaskellResolver -> Either [Dependency] (PackageDescription,FlagAssignment)
    finalize :: HaskellResolver
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalize HaskellResolver
resolver = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [Constraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD FlagAssignment
flags ComponentRequestedSpec
requestedComponents (HaskellResolver -> Dependency -> Bool
makeCabalResolver HaskellResolver
resolver) Platform
arch CompilerInfo
compiler ([Constraint] -> [Constraint]
makeCabalConstraints [Constraint]
constraints) GenericPackageDescription
genDesc

    requestedComponents :: ComponentRequestedSpec
    requestedComponents :: ComponentRequestedSpec
requestedComponents = ComponentRequestedSpec
                          { testsRequested :: Bool
testsRequested      = Bool
True
                          , benchmarksRequested :: Bool
benchmarksRequested = Bool
True
                          }

    jailbroken :: HaskellResolver -> HaskellResolver
    jailbroken :: HaskellResolver -> HaskellResolver
jailbroken HaskellResolver
resolver (PackageVersionConstraint PackageName
pkg VersionRange
_) = HaskellResolver
resolver (PackageName -> VersionRange -> Constraint
PackageVersionConstraint PackageName
pkg VersionRange
anyVersion)

    withInternalLibs :: HaskellResolver -> HaskellResolver
    withInternalLibs :: HaskellResolver -> HaskellResolver
withInternalLibs HaskellResolver
resolver Constraint
c = Constraint -> PackageName
constraintPkgName Constraint
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
internalNames Bool -> Bool -> Bool
|| HaskellResolver
resolver Constraint
c

    internalNames :: [PackageName]
    internalNames :: [PackageName]
internalNames =    [ UnqualComponentName -> PackageName
unqualComponentNameToPackageName UnqualComponentName
n | (UnqualComponentName
n,CondTree ConfVar [Dependency] Library
_) <- GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries GenericPackageDescription
genDesc ]
                    forall a. [a] -> [a] -> [a]
++ [ UnqualComponentName -> PackageName
unqualComponentNameToPackageName UnqualComponentName
n | LSubLibName UnqualComponentName
n <- Library -> LibraryName
libName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Library]
subLibraries (GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
genDesc) ]

  in case HaskellResolver
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalize (HaskellResolver -> HaskellResolver
jailbroken (HaskellResolver -> HaskellResolver
withInternalLibs HaskellResolver
haskellResolver)) of
    Left [Dependency]
m -> case HaskellResolver
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalize (forall a b. a -> b -> a
const Bool
True) of
                Left [Dependency]
_      -> forall a. HasCallStack => String -> a
error (String
"Cabal cannot finalize " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
display (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
genDesc))
                Right (PackageDescription
d,FlagAssignment
_) -> (PackageDescription
d,[Dependency]
m)
    Right (PackageDescription
d,FlagAssignment
_)  -> (PackageDescription
d,[])

fromPackageDescription :: HaskellResolver -> NixpkgsResolver -> [Dependency] -> FlagAssignment -> PackageDescription -> Derivation
fromPackageDescription :: HaskellResolver
-> NixpkgsResolver
-> [Dependency]
-> FlagAssignment
-> PackageDescription
-> Derivation
fromPackageDescription HaskellResolver
haskellResolver NixpkgsResolver
nixpkgsResolver [Dependency]
missingDeps FlagAssignment
flags PackageDescription {String
[String]
[(String, String)]
[(CompilerFlavor, VersionRange)]
[Benchmark]
[Executable]
[ForeignLib]
[Library]
[TestSuite]
[SourceRepo]
[SymbolicPath PackageDir LicenseFile]
Maybe Library
Maybe SetupBuildInfo
Maybe BuildType
Either License License
PackageIdentifier
CabalSpecVersion
ShortText
author :: PackageDescription -> ShortText
benchmarks :: PackageDescription -> [Benchmark]
bugReports :: PackageDescription -> ShortText
buildTypeRaw :: PackageDescription -> Maybe BuildType
category :: PackageDescription -> ShortText
copyright :: PackageDescription -> ShortText
customFieldsPD :: PackageDescription -> [(String, String)]
dataDir :: PackageDescription -> String
dataFiles :: PackageDescription -> [String]
description :: PackageDescription -> ShortText
executables :: PackageDescription -> [Executable]
extraDocFiles :: PackageDescription -> [String]
extraSrcFiles :: PackageDescription -> [String]
extraTmpFiles :: PackageDescription -> [String]
foreignLibs :: PackageDescription -> [ForeignLib]
homepage :: PackageDescription -> ShortText
library :: PackageDescription -> Maybe Library
licenseFiles :: PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseRaw :: PackageDescription -> Either License License
maintainer :: PackageDescription -> ShortText
package :: PackageDescription -> PackageIdentifier
pkgUrl :: PackageDescription -> ShortText
setupBuildInfo :: PackageDescription -> Maybe SetupBuildInfo
sourceRepos :: PackageDescription -> [SourceRepo]
specVersion :: PackageDescription -> CabalSpecVersion
stability :: PackageDescription -> ShortText
synopsis :: PackageDescription -> ShortText
testSuites :: PackageDescription -> [TestSuite]
testedWith :: PackageDescription -> [(CompilerFlavor, VersionRange)]
extraDocFiles :: [String]
extraTmpFiles :: [String]
extraSrcFiles :: [String]
dataDir :: String
dataFiles :: [String]
benchmarks :: [Benchmark]
testSuites :: [TestSuite]
foreignLibs :: [ForeignLib]
executables :: [Executable]
subLibraries :: [Library]
library :: Maybe Library
setupBuildInfo :: Maybe SetupBuildInfo
buildTypeRaw :: Maybe BuildType
customFieldsPD :: [(String, String)]
category :: ShortText
description :: ShortText
synopsis :: ShortText
sourceRepos :: [SourceRepo]
bugReports :: ShortText
pkgUrl :: ShortText
homepage :: ShortText
testedWith :: [(CompilerFlavor, VersionRange)]
stability :: ShortText
author :: ShortText
maintainer :: ShortText
copyright :: ShortText
licenseFiles :: [SymbolicPath PackageDir LicenseFile]
licenseRaw :: Either License License
package :: PackageIdentifier
specVersion :: CabalSpecVersion
subLibraries :: PackageDescription -> [Library]
..} = Derivation -> Derivation
normalize forall a b. (a -> b) -> a -> b
$ Derivation -> Derivation
postProcess forall a b. (a -> b) -> a -> b
$ Derivation
nullDerivation
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
isLibrary forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a -> Bool
isJust Maybe Library
library
    forall a b. a -> (a -> b) -> b
& Lens' Derivation PackageIdentifier
pkgid forall s t a b. ASetter s t a b -> b -> s -> t
.~ PackageIdentifier
package
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Int
revision forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
xrev
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
isLibrary forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a -> Bool
isJust Maybe Library
library
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
isExecutable forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Executable]
executables)
    forall a b. a -> (a -> b) -> b
& Lens' Derivation (Set Binding)
extraFunctionArgs forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& Lens' Derivation (Map String String)
extraAttributes forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& Lens' Derivation BuildInfo
libraryDepends forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (BuildInfo -> BuildInfo
convertBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo) (forall a. Maybe a -> [a]
maybeToList Maybe Library
library forall a. [a] -> [a] -> [a]
++ [Library]
subLibraries)
    forall a b. a -> (a -> b) -> b
& Lens' Derivation BuildInfo
executableDepends forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (BuildInfo -> BuildInfo
convertBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo) [Executable]
executables)
    forall a b. a -> (a -> b) -> b
& Lens' Derivation BuildInfo
testDepends forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (BuildInfo -> BuildInfo
convertBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo) [TestSuite]
testSuites)
    forall a b. a -> (a -> b) -> b
& Lens' Derivation BuildInfo
benchmarkDepends forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (BuildInfo -> BuildInfo
convertBuildInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
benchmarkBuildInfo) [Benchmark]
benchmarks)
    forall a b. a -> (a -> b) -> b
& Lens' Derivation BuildInfo
Nix.setupDepends forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty SetupBuildInfo -> BuildInfo
convertSetupBuildInfo Maybe SetupBuildInfo
setupBuildInfo
    forall a b. a -> (a -> b) -> b
& Lens' Derivation (Set String)
configureFlags forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& Lens' Derivation FlagAssignment
cabalFlags forall s t a b. ASetter s t a b -> b -> s -> t
.~ FlagAssignment
flags
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
runHaddock forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
doHaddockPhase
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
jailbreak forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
doCheck forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
doBenchmark forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
    forall a b. a -> (a -> b) -> b
& Lens' Derivation String
testTarget forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
hyperlinkSource forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
enableSplitObjs forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
enableLibraryProfiling forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
enableExecutableProfiling forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Bool
enableSeparateDataOutput forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dataFiles)
    forall a b. a -> (a -> b) -> b
& Lens' Derivation String
subpath forall s t a b. ASetter s t a b -> b -> s -> t
.~ String
"."
    forall a b. a -> (a -> b) -> b
& Lens' Derivation String
phaseOverrides forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& Lens' Derivation String
editedCabalFile forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if Int
xrev forall a. Ord a => a -> a -> Bool
> Int
0
                             then forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error (forall a. Pretty a => a -> String
display PackageIdentifier
package forall a. [a] -> [a] -> [a]
++ String
": X-Cabal-File-Hash field is missing")) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"X-Cabal-File-Hash" [(String, String)]
customFieldsPD)
                             else String
"")
    forall a b. a -> (a -> b) -> b
& Lens' Derivation Meta
metaSection forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Meta
Nix.nullMeta
#if MIN_VERSION_Cabal(3,2,0)
                     forall a b. a -> (a -> b) -> b
& Lens' Meta String
Nix.homepage forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> String
stripRedundanceSpaces (ShortText -> String
fromShortText ShortText
homepage)
                     forall a b. a -> (a -> b) -> b
& Lens' Meta String
Nix.description forall s t a b. ASetter s t a b -> b -> s -> t
.~ String -> String
stripRedundanceSpaces (ShortText -> String
fromShortText ShortText
synopsis)
#else
                     & Nix.homepage .~ stripRedundanceSpaces homepage
                     & Nix.description .~ stripRedundanceSpaces synopsis
#endif
                     forall a b. a -> (a -> b) -> b
& Lens' Meta License
Nix.license forall s t a b. ASetter s t a b -> b -> s -> t
.~ License
nixLicense
                     forall a b. a -> (a -> b) -> b
& Lens' Meta (Maybe (Set NixpkgsPlatform))
Nix.platforms forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
                     forall a b. a -> (a -> b) -> b
& Lens' Meta (Maybe (Set NixpkgsPlatform))
Nix.badPlatforms forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
                     forall a b. a -> (a -> b) -> b
& Lens' Meta (Maybe (Set NixpkgsPlatform))
Nix.hydraPlatforms forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if License -> Bool
isFreeLicense License
nixLicense then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a. Set a
Set.empty)
                     forall a b. a -> (a -> b) -> b
& Lens' Meta (Maybe String)
Nix.mainProgram forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe String
nixMainProgram
                     forall a b. a -> (a -> b) -> b
& Lens' Meta (Set Identifier)
Nix.maintainers forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty
                     forall a b. a -> (a -> b) -> b
& Lens' Meta Bool
Nix.broken forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
missingDeps)
                     )
  where
    xrev :: Int
xrev = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 forall a. Read a => String -> a
read (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"x-revision" [(String, String)]
customFieldsPD)

    nixLicense :: Nix.License
    nixLicense :: License
nixLicense =  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> License
fromSPDXLicense License -> License
fromCabalLicense Either License License
licenseRaw

    -- return the name of the executable if there is exactly one. If more,
    -- it is hard to decide automatically which should be the default/main one.
    nixMainProgram :: Maybe String
    nixMainProgram :: Maybe String
nixMainProgram =
      case forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo) [Executable]
executables of
        [Executable
mainProgram] -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> String
unUnqualComponentName forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
mainProgram
        [Executable]
_ -> forall a. Maybe a
Nothing

    resolveInHackage :: Identifier -> Binding
    resolveInHackage :: Identifier -> Binding
resolveInHackage Identifier
i | (Identifier
iforall s a. s -> Getting a s a -> a
^.Iso' Identifier String
ident) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ PackageName -> String
unPackageName PackageName
n | (Dependency PackageName
n VersionRange
_ NonEmptySet LibraryName
_) <- [Dependency]
missingDeps ] = Identifier -> Binding
bindNull Identifier
i
                       | Bool
otherwise = Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"self",Identifier
i])   -- TODO: "self" shouldn't be hardcoded.

    -- TODO: This is all very confusing. Haskell packages refer to the Nixpkgs
    -- derivation 'foo' as 'pkgs.foo', because they live in the 'haskellPackages'
    -- name space -- not on the top level. Therefore, we built our Nixpkgs lookup
    -- function so that top level names are returned as 'pkgs.foo'. As a result, we
    -- end up pre-pending that path to all kinds of names all over the place. I
    -- suppose the correct approach would be to assume that the lookup function
    -- returns names that live in the top-level and to adapt the code in
    -- PostProcess.hs et all to that fact.
    goodScopes :: Set [Identifier]
    goodScopes :: Set [Identifier]
goodScopes = forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map (Identifier
"pkgs"forall a. a -> [a] -> [a]
:) [[], [Identifier
"xorg"], [Identifier
"xlibs"], [Identifier
"gnome2"], [Identifier
"gnome"], [Identifier
"gnome3"], [Identifier
"kde4"]])

    resolveInNixpkgs :: Identifier -> Binding
    resolveInNixpkgs :: Identifier -> Binding
resolveInNixpkgs Identifier
i
      | Identifier
i forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Identifier
"clang",Identifier
"lldb",Identifier
"llvm"] = Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"self",Identifier
"llvmPackages",Identifier
i])     -- TODO: evil!
      | Identifier
i forall a. Eq a => a -> a -> Bool
== Identifier
"gtk2"                      = Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"pkgs",Identifier
"gtk2"])               -- TODO: these cases should not be necessary
      | Identifier
i forall a. Eq a => a -> a -> Bool
== Identifier
"gtk3"                      = Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"pkgs",Identifier
"gtk3"])
      | Identifier
i forall a. Eq a => a -> a -> Bool
== Identifier
"gtksourceview3"            = Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"pkgs",Identifier
"gtksourceview3"])
      | Identifier
i forall a. Eq a => a -> a -> Bool
== Identifier
"vte_291"                   = Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"pkgs",Identifier
"vte"])
      | Just Binding
p <- NixpkgsResolver
nixpkgsResolver Identifier
i, forall a. [a] -> [a]
init (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' Binding Path
reference forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' Path [Identifier]
path) Binding
p) forall a. Ord a => a -> Set a -> Bool
`Set.member` Set [Identifier]
goodScopes = Binding
p
      | Bool
otherwise                        = Identifier -> Binding
bindNull Identifier
i

    resolveInHackageThenNixpkgs :: Identifier -> Binding
    resolveInHackageThenNixpkgs :: Identifier -> Binding
resolveInHackageThenNixpkgs Identifier
i | HaskellResolver
haskellResolver (PackageName -> VersionRange -> Constraint
PackageVersionConstraint (String -> PackageName
mkPackageName (Identifier
iforall s a. s -> Getting a s a -> a
^.Iso' Identifier String
ident)) VersionRange
anyVersion) = Identifier -> Binding
resolveInHackage Identifier
i
                                  | Bool
otherwise = Identifier -> Binding
resolveInNixpkgs Identifier
i

    internalLibNames :: [PackageName]
    internalLibNames :: [PackageName]
internalLibNames = [ UnqualComponentName -> PackageName
unqualComponentNameToPackageName UnqualComponentName
n | LSubLibName UnqualComponentName
n <- Library -> LibraryName
libName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Library]
subLibraries ]

    doHaddockPhase :: Bool
    doHaddockPhase :: Bool
doHaddockPhase | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageName]
internalLibNames) = Bool
False
                   | Just Library
l <- Maybe Library
library           = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Library -> [ModuleName]
exposedModules Library
l))
                   | Bool
otherwise                   = Bool
True

    convertBuildInfo :: Cabal.BuildInfo -> Nix.BuildInfo
    convertBuildInfo :: BuildInfo -> BuildInfo
convertBuildInfo Cabal.BuildInfo {Bool
[String]
[(String, String)]
[Language]
[Extension]
[Dependency]
[ExeDependency]
[LegacyExeDependency]
[Mixin]
[ModuleName]
[PkgconfigDependency]
[SymbolicPath PackageDir SourceDir]
Maybe Language
PerCompilerFlavor [String]
asmOptions :: BuildInfo -> [String]
asmSources :: BuildInfo -> [String]
autogenIncludes :: BuildInfo -> [String]
autogenModules :: BuildInfo -> [ModuleName]
buildToolDepends :: BuildInfo -> [ExeDependency]
buildTools :: BuildInfo -> [LegacyExeDependency]
cSources :: BuildInfo -> [String]
ccOptions :: BuildInfo -> [String]
cmmOptions :: BuildInfo -> [String]
cmmSources :: BuildInfo -> [String]
cppOptions :: BuildInfo -> [String]
customFieldsBI :: BuildInfo -> [(String, String)]
cxxOptions :: BuildInfo -> [String]
cxxSources :: BuildInfo -> [String]
defaultExtensions :: BuildInfo -> [Extension]
defaultLanguage :: BuildInfo -> Maybe Language
extraBundledLibs :: BuildInfo -> [String]
extraDynLibFlavours :: BuildInfo -> [String]
extraFrameworkDirs :: BuildInfo -> [String]
extraGHCiLibs :: BuildInfo -> [String]
extraLibDirs :: BuildInfo -> [String]
extraLibFlavours :: BuildInfo -> [String]
extraLibs :: BuildInfo -> [String]
frameworks :: BuildInfo -> [String]
hsSourceDirs :: BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsc2hsOptions :: BuildInfo -> [String]
includeDirs :: BuildInfo -> [String]
includes :: BuildInfo -> [String]
installIncludes :: BuildInfo -> [String]
jsSources :: BuildInfo -> [String]
ldOptions :: BuildInfo -> [String]
mixins :: BuildInfo -> [Mixin]
oldExtensions :: BuildInfo -> [Extension]
options :: BuildInfo -> PerCompilerFlavor [String]
otherExtensions :: BuildInfo -> [Extension]
otherLanguages :: BuildInfo -> [Language]
otherModules :: BuildInfo -> [ModuleName]
pkgconfigDepends :: BuildInfo -> [PkgconfigDependency]
profOptions :: BuildInfo -> PerCompilerFlavor [String]
sharedOptions :: BuildInfo -> PerCompilerFlavor [String]
staticOptions :: BuildInfo -> PerCompilerFlavor [String]
targetBuildDepends :: BuildInfo -> [Dependency]
virtualModules :: BuildInfo -> [ModuleName]
mixins :: [Mixin]
targetBuildDepends :: [Dependency]
customFieldsBI :: [(String, String)]
staticOptions :: PerCompilerFlavor [String]
sharedOptions :: PerCompilerFlavor [String]
profOptions :: PerCompilerFlavor [String]
options :: PerCompilerFlavor [String]
installIncludes :: [String]
autogenIncludes :: [String]
includes :: [String]
includeDirs :: [String]
extraLibDirs :: [String]
extraDynLibFlavours :: [String]
extraLibFlavours :: [String]
extraBundledLibs :: [String]
extraGHCiLibs :: [String]
extraLibs :: [String]
oldExtensions :: [Extension]
otherExtensions :: [Extension]
defaultExtensions :: [Extension]
otherLanguages :: [Language]
defaultLanguage :: Maybe Language
autogenModules :: [ModuleName]
virtualModules :: [ModuleName]
otherModules :: [ModuleName]
hsSourceDirs :: [SymbolicPath PackageDir SourceDir]
jsSources :: [String]
cxxSources :: [String]
cSources :: [String]
cmmSources :: [String]
asmSources :: [String]
extraFrameworkDirs :: [String]
frameworks :: [String]
pkgconfigDepends :: [PkgconfigDependency]
hsc2hsOptions :: [String]
ldOptions :: [String]
cxxOptions :: [String]
ccOptions :: [String]
cmmOptions :: [String]
asmOptions :: [String]
cppOptions :: [String]
buildToolDepends :: [ExeDependency]
buildTools :: [LegacyExeDependency]
buildable :: Bool
buildable :: BuildInfo -> Bool
..} | Bool -> Bool
not Bool
buildable = forall a. Monoid a => a
mempty
    convertBuildInfo Cabal.BuildInfo {Bool
[String]
[(String, String)]
[Language]
[Extension]
[Dependency]
[ExeDependency]
[LegacyExeDependency]
[Mixin]
[ModuleName]
[PkgconfigDependency]
[SymbolicPath PackageDir SourceDir]
Maybe Language
PerCompilerFlavor [String]
mixins :: [Mixin]
targetBuildDepends :: [Dependency]
customFieldsBI :: [(String, String)]
staticOptions :: PerCompilerFlavor [String]
sharedOptions :: PerCompilerFlavor [String]
profOptions :: PerCompilerFlavor [String]
options :: PerCompilerFlavor [String]
installIncludes :: [String]
autogenIncludes :: [String]
includes :: [String]
includeDirs :: [String]
extraLibDirs :: [String]
extraDynLibFlavours :: [String]
extraLibFlavours :: [String]
extraBundledLibs :: [String]
extraGHCiLibs :: [String]
extraLibs :: [String]
oldExtensions :: [Extension]
otherExtensions :: [Extension]
defaultExtensions :: [Extension]
otherLanguages :: [Language]
defaultLanguage :: Maybe Language
autogenModules :: [ModuleName]
virtualModules :: [ModuleName]
otherModules :: [ModuleName]
hsSourceDirs :: [SymbolicPath PackageDir SourceDir]
jsSources :: [String]
cxxSources :: [String]
cSources :: [String]
cmmSources :: [String]
asmSources :: [String]
extraFrameworkDirs :: [String]
frameworks :: [String]
pkgconfigDepends :: [PkgconfigDependency]
hsc2hsOptions :: [String]
ldOptions :: [String]
cxxOptions :: [String]
ccOptions :: [String]
cmmOptions :: [String]
asmOptions :: [String]
cppOptions :: [String]
buildToolDepends :: [ExeDependency]
buildTools :: [LegacyExeDependency]
buildable :: Bool
asmOptions :: BuildInfo -> [String]
asmSources :: BuildInfo -> [String]
autogenIncludes :: BuildInfo -> [String]
autogenModules :: BuildInfo -> [ModuleName]
buildToolDepends :: BuildInfo -> [ExeDependency]
buildTools :: BuildInfo -> [LegacyExeDependency]
cSources :: BuildInfo -> [String]
ccOptions :: BuildInfo -> [String]
cmmOptions :: BuildInfo -> [String]
cmmSources :: BuildInfo -> [String]
cppOptions :: BuildInfo -> [String]
customFieldsBI :: BuildInfo -> [(String, String)]
cxxOptions :: BuildInfo -> [String]
cxxSources :: BuildInfo -> [String]
defaultExtensions :: BuildInfo -> [Extension]
defaultLanguage :: BuildInfo -> Maybe Language
extraBundledLibs :: BuildInfo -> [String]
extraDynLibFlavours :: BuildInfo -> [String]
extraFrameworkDirs :: BuildInfo -> [String]
extraGHCiLibs :: BuildInfo -> [String]
extraLibDirs :: BuildInfo -> [String]
extraLibFlavours :: BuildInfo -> [String]
extraLibs :: BuildInfo -> [String]
frameworks :: BuildInfo -> [String]
hsSourceDirs :: BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsc2hsOptions :: BuildInfo -> [String]
includeDirs :: BuildInfo -> [String]
includes :: BuildInfo -> [String]
installIncludes :: BuildInfo -> [String]
jsSources :: BuildInfo -> [String]
ldOptions :: BuildInfo -> [String]
mixins :: BuildInfo -> [Mixin]
oldExtensions :: BuildInfo -> [Extension]
options :: BuildInfo -> PerCompilerFlavor [String]
otherExtensions :: BuildInfo -> [Extension]
otherLanguages :: BuildInfo -> [Language]
otherModules :: BuildInfo -> [ModuleName]
pkgconfigDepends :: BuildInfo -> [PkgconfigDependency]
profOptions :: BuildInfo -> PerCompilerFlavor [String]
sharedOptions :: BuildInfo -> PerCompilerFlavor [String]
staticOptions :: BuildInfo -> PerCompilerFlavor [String]
targetBuildDepends :: BuildInfo -> [Dependency]
virtualModules :: BuildInfo -> [ModuleName]
buildable :: BuildInfo -> Bool
..} = forall a. Monoid a => a
mempty
      forall a b. a -> (a -> b) -> b
& Lens' BuildInfo (Set Binding)
haskell forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Ord a => [a] -> Set a
Set.fromList [ Identifier -> Binding
resolveInHackage (PackageName -> Identifier
toNixName PackageName
x) | (Dependency PackageName
x VersionRange
_ NonEmptySet LibraryName
_) <- [Dependency]
targetBuildDepends, PackageName
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageName]
internalLibNames ]
      forall a b. a -> (a -> b) -> b
& Lens' BuildInfo (Set Binding)
system forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Ord a => [a] -> Set a
Set.fromList [ Identifier -> Binding
resolveInNixpkgs Identifier
y | String
x <- [String]
extraLibs, Identifier
y <- String -> [Identifier]
libNixName String
x ]
      forall a b. a -> (a -> b) -> b
& Lens' BuildInfo (Set Binding)
pkgconfig forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Ord a => [a] -> Set a
Set.fromList [ Identifier -> Binding
resolveInNixpkgs Identifier
y | PkgconfigDependency PkgconfigName
x PkgconfigVersionRange
_ <- [PkgconfigDependency]
pkgconfigDepends, Identifier
y <- String -> [Identifier]
libNixName (PkgconfigName -> String
unPkgconfigName PkgconfigName
x) ]
      forall a b. a -> (a -> b) -> b
& Lens' BuildInfo (Set Binding)
tool forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map Identifier -> Binding
resolveInHackageThenNixpkgs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [Identifier]
buildToolNixName
              forall a b. (a -> b) -> a -> b
$ [ PackageName -> String
unPackageName PackageName
x | ExeDependency PackageName
x UnqualComponentName
_ VersionRange
_ <- [ExeDependency]
buildToolDepends ] forall a. [a] -> [a] -> [a]
++ [ String
x | LegacyExeDependency String
x VersionRange
_ <- [LegacyExeDependency]
buildTools ])

    convertSetupBuildInfo :: Cabal.SetupBuildInfo -> Nix.BuildInfo
    convertSetupBuildInfo :: SetupBuildInfo -> BuildInfo
convertSetupBuildInfo SetupBuildInfo
bi = forall a. Monoid a => a
mempty
      forall a b. a -> (a -> b) -> b
& Lens' BuildInfo (Set Binding)
haskell forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Ord a => [a] -> Set a
Set.fromList [ Identifier -> Binding
resolveInHackage (PackageName -> Identifier
toNixName PackageName
x) | (Dependency PackageName
x VersionRange
_ NonEmptySet LibraryName
_) <- SetupBuildInfo -> [Dependency]
Cabal.setupDepends SetupBuildInfo
bi ]

bindNull :: Identifier -> Binding
bindNull :: Identifier -> Binding
bindNull Identifier
i = Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Identifier
i, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"null"])

stripRedundanceSpaces :: String -> String
stripRedundanceSpaces :: String -> String
stripRedundanceSpaces = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words