diff --git a/cabal2nix/cabal2nix.cabal b/cabal2nix/cabal2nix.cabal index 4f03d3e83..0a6f8c6cb 100644 --- a/cabal2nix/cabal2nix.cabal +++ b/cabal2nix/cabal2nix.cabal @@ -21,6 +21,8 @@ extra-source-files: README.md CHANGELOG.md test/golden-test-cases/*.cabal test/golden-test-cases/*.nix.golden + test/golden-test-cases-granular/*.cabal + test/golden-test-cases-granular/*.nix.golden cabal-version: 1.24 source-repository head @@ -44,7 +46,9 @@ library Distribution.Nixpkgs.Haskell.FromCabal.PostProcess Distribution.Nixpkgs.Haskell.Hackage Distribution.Nixpkgs.Haskell.OrphanInstances + Distribution.Nixpkgs.Haskell.PackageNix Distribution.Nixpkgs.Haskell.PackageSourceSpec + Distribution.Nixpkgs.Haskell.TargetDerivations Distribution.Nixpkgs.Haskell.Platform other-modules: Paths_cabal2nix hs-source-dirs: src diff --git a/cabal2nix/hackage2nix/Main.hs b/cabal2nix/hackage2nix/Main.hs index 5c0b7f643..5ff8f55e3 100644 --- a/cabal2nix/hackage2nix/Main.hs +++ b/cabal2nix/hackage2nix/Main.hs @@ -155,21 +155,24 @@ main = do attr :: String attr = if isInDefaultPackageSet then unPackageName name else mangle pkgId - drv :: Derivation - drv = fromGenericPackageDescription haskellResolver nixpkgsResolver targetPlatform (compilerInfo config) flagAssignment [] descr - & src .~ urlDerivationSource ("mirror://hackage/" ++ display pkgId ++ ".tar.gz") tarballSHA256 - & editedCabalFile .~ cabalSHA256 - -- If a list of platforms is set in the hackage2nix configuration file, prefer that. - -- Otherwise a list defined by PostProcess or Nothing is used. - & metaSection.platforms %~ (Map.lookup name (supportedPlatforms config) <|>) - & metaSection.badPlatforms %~ (Map.lookup name (unsupportedPlatforms config) <|>) - & metaSection.hydraPlatforms %~ (if isHydraEnabled then id else const (Just Set.empty)) - & metaSection.broken ||~ isBroken - & metaSection.maintainers .~ Map.findWithDefault Set.empty name globalPackageMaintainers - & metaSection.homepage .~ "" + overrideDrv :: Derivation -> Derivation + overrideDrv drv' = drv' + & src .~ urlDerivationSource ("mirror://hackage/" ++ display pkgId ++ ".tar.gz") tarballSHA256 + & editedCabalFile .~ cabalSHA256 + -- If a list of platforms is set in the hackage2nix configuration file, prefer that. + -- Otherwise a list defined by PostProcess or Nothing is used. + & metaSection.platforms %~ (Map.lookup name (supportedPlatforms config) <|>) + & metaSection.badPlatforms %~ (Map.lookup name (unsupportedPlatforms config) <|>) + & metaSection.hydraPlatforms %~ (if isHydraEnabled then id else const (Just Set.empty)) + & metaSection.broken ||~ isBroken + & metaSection.maintainers .~ Map.findWithDefault Set.empty name globalPackageMaintainers + & metaSection.homepage .~ "" + + drv :: PackageNix + drv = fromGenericPackageDescription overrideDrv haskellResolver nixpkgsResolver targetPlatform (compilerInfo config) flagAssignment SingleDerivation [] descr overrides :: Doc - overrides = fcat $ punctuate space [ pPrint b <> semi | b <- Set.toList (view (dependencies . each) drv `Set.union` view extraFunctionArgs drv), not (isFromHackage b) ] + overrides = fcat $ punctuate space [ pPrint b <> semi | b <- Set.toList (view (allDependencies . each) drv `Set.union` view allExtraFunctionArgs drv), not (isFromHackage b) ] return $ render $ nest 2 $ hang (doubleQuotes (text attr) <+> equals <+> text "callPackage") 2 (parens (pPrint drv)) <+> (braces overrides <> semi) diff --git a/cabal2nix/src/Cabal2nix.hs b/cabal2nix/src/Cabal2nix.hs index 47799be1b..2d90d850e 100644 --- a/cabal2nix/src/Cabal2nix.hs +++ b/cabal2nix/src/Cabal2nix.hs @@ -60,6 +60,7 @@ data Options = Options , optHackageDb :: Maybe FilePath , optNixShellOutput :: Bool , optFlags :: [String] + , optOutputGranularity :: OutputGranularity , optCompiler :: CompilerId , optSystem :: Platform , optSubpath :: Maybe FilePath @@ -111,6 +112,8 @@ options = do <- switch (long "shell" <> help "generate output suitable for nix-shell") optFlags <- many (strOption $ short 'f' <> long "flag" <> help "Cabal flag (may be specified multiple times)") + optOutputGranularity + <- flag SingleDerivation PerTarget $ long "granular-output" <> help "Generate an attrset with a derivation for each build target" optCompiler <- option parseCabal (long "compiler" <> help "compiler to use when evaluating the Cabal file" <> value buildCompilerId <> showDefaultWith prettyShow) optSystem @@ -173,7 +176,7 @@ hpackOverrides :: Derivation -> Derivation hpackOverrides = over phaseOverrides (++ "prePatch = \"hpack\";") . set (libraryDepends . tool . contains (PP.pkg "hpack")) True -cabal2nix' :: Options -> IO (Either Doc Derivation) +cabal2nix' :: Options -> IO (Either Doc PackageNix) cabal2nix' opts@Options{..} = do pkg <- getPackage optHpack optFetchSubmodules optHackageDb optHackageSnapshot $ Source { @@ -186,7 +189,7 @@ cabal2nix' opts@Options{..} = do } processPackage opts pkg -cabal2nixWithDB :: DB.HackageDB -> Options -> IO (Either Doc Derivation) +cabal2nixWithDB :: DB.HackageDB -> Options -> IO (Either Doc PackageNix) cabal2nixWithDB db opts@Options{..} = do when (isJust optHackageDb) $ hPutStrLn stderr "WARN: HackageDB provided directly; ignoring --hackage-db" when (isJust optHackageSnapshot) $ hPutStrLn stderr "WARN: HackageDB provided directly; ignoring --hackage-snapshot" @@ -201,7 +204,7 @@ cabal2nixWithDB db opts@Options{..} = do } processPackage opts pkg -processPackage :: Options -> Package -> IO (Either Doc Derivation) +processPackage :: Options -> Package -> IO (Either Doc PackageNix) processPackage Options{..} pkg = do let withHpackOverrides :: Derivation -> Derivation @@ -210,26 +213,31 @@ processPackage Options{..} pkg = do flags :: FlagAssignment flags = configureCabalFlags (packageId (pkgCabal pkg)) `mappend` readFlagList optFlags - deriv :: Derivation - deriv = withHpackOverrides $ fromGenericPackageDescription (const True) - optNixpkgsIdentifier - optSystem - (unknownCompilerInfo optCompiler NoAbiTag) - flags - [] - (pkgCabal pkg) - & src .~ pkgSource pkg - & subpath .~ fromMaybe "." optSubpath - & runHaddock %~ (optHaddock &&) - & jailbreak .~ optJailbreak - & hyperlinkSource .~ optHyperlinkSource - & enableLibraryProfiling .~ (fromMaybe False optEnableProfiling || optEnableLibraryProfiling) - & enableExecutableProfiling .~ (fromMaybe False optEnableProfiling || optEnableExecutableProfiling) - & metaSection.maintainers .~ Set.fromList (map (review ident) optMaintainer) --- & metaSection.platforms .~ Set.fromList optPlatform - & doCheck &&~ optDoCheck - & doBenchmark ||~ optDoBenchmark - & extraFunctionArgs %~ Set.union (Set.fromList ("inherit lib":map (fromString . ("inherit " ++)) optExtraArgs)) + overrideDrv :: Derivation -> Derivation + overrideDrv drv = withHpackOverrides $ drv + & src .~ pkgSource pkg + & subpath .~ fromMaybe "." optSubpath + & runHaddock %~ (optHaddock &&) + & jailbreak .~ optJailbreak + & hyperlinkSource .~ optHyperlinkSource + & enableLibraryProfiling .~ (fromMaybe False optEnableProfiling || optEnableLibraryProfiling) + & enableExecutableProfiling .~ (fromMaybe False optEnableProfiling || optEnableExecutableProfiling) + & metaSection.maintainers .~ Set.fromList (map (review ident) optMaintainer) + -- & metaSection.platforms .~ Set.fromList optPlatform + & doCheck &&~ optDoCheck + & doBenchmark ||~ optDoBenchmark + & extraFunctionArgs %~ Set.union (Set.fromList ("inherit lib":map (fromString . ("inherit " ++)) optExtraArgs)) + + deriv :: PackageNix + deriv = fromGenericPackageDescription overrideDrv + (const True) + optNixpkgsIdentifier + optSystem + (unknownCompilerInfo optCompiler NoAbiTag) + flags + optOutputGranularity + [] + (pkgCabal pkg) shell :: Doc shell = vcat diff --git a/cabal2nix/src/Distribution/Nixpkgs/Haskell.hs b/cabal2nix/src/Distribution/Nixpkgs/Haskell.hs index c6421a26b..601fb3b75 100644 --- a/cabal2nix/src/Distribution/Nixpkgs/Haskell.hs +++ b/cabal2nix/src/Distribution/Nixpkgs/Haskell.hs @@ -1,8 +1,12 @@ module Distribution.Nixpkgs.Haskell ( module Distribution.Nixpkgs.Haskell.BuildInfo , module Distribution.Nixpkgs.Haskell.Derivation + , module Distribution.Nixpkgs.Haskell.TargetDerivations + , module Distribution.Nixpkgs.Haskell.PackageNix ) where import Distribution.Nixpkgs.Haskell.BuildInfo import Distribution.Nixpkgs.Haskell.Derivation +import Distribution.Nixpkgs.Haskell.TargetDerivations +import Distribution.Nixpkgs.Haskell.PackageNix diff --git a/cabal2nix/src/Distribution/Nixpkgs/Haskell/ComponentDerivations.hs b/cabal2nix/src/Distribution/Nixpkgs/Haskell/ComponentDerivations.hs new file mode 100644 index 000000000..69471ccd3 --- /dev/null +++ b/cabal2nix/src/Distribution/Nixpkgs/Haskell/ComponentDerivations.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module Distribution.Nixpkgs.Haskell.ComponentDerivations + ( ComponentDerivations, libraries, executables, testExecutables, benchExecutables, nullComponentDerivations ) + where + +import Prelude hiding ((<>)) + +import Control.DeepSeq +import Control.Lens +import Data.List ( isPrefixOf ) +import Data.Map ( Map ) +import qualified Data.Map as Map +import Data.Set ( Set ) +import qualified Data.Set as Set +import Data.Set.Lens +import Distribution.Nixpkgs.Fetch +import Distribution.Nixpkgs.Haskell.BuildInfo +import Distribution.Nixpkgs.Haskell.Derivation +import Distribution.Nixpkgs.Haskell.OrphanInstances ( ) +import Distribution.Nixpkgs.Meta +import Distribution.Package +import Distribution.PackageDescription ( FlagAssignment, unFlagName, unFlagAssignment ) +import GHC.Generics ( Generic ) +import Language.Nix +import Language.Nix.PrettyPrinting + +-- | A represtation of Nix expressions for building Haskell packages with component granularity. + diff --git a/cabal2nix/src/Distribution/Nixpkgs/Haskell/Derivation.hs b/cabal2nix/src/Distribution/Nixpkgs/Haskell/Derivation.hs index aa489f6cf..e435c64aa 100644 --- a/cabal2nix/src/Distribution/Nixpkgs/Haskell/Derivation.hs +++ b/cabal2nix/src/Distribution/Nixpkgs/Haskell/Derivation.hs @@ -4,11 +4,14 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} module Distribution.Nixpkgs.Haskell.Derivation - ( Derivation, nullDerivation, pkgid, revision, src, subpath, isLibrary, isExecutable + ( Derivation, SingleDerivation + , singleDerivation, nullSingleDerivation + , nullDerivation, pkgid, revision, src, subpath, isLibrary, isExecutable , extraFunctionArgs, libraryDepends, executableDepends, testDepends, configureFlags - , cabalFlags, runHaddock, jailbreak, doCheck, doBenchmark, testTarget, hyperlinkSource, enableSplitObjs - , enableLibraryProfiling, enableExecutableProfiling, phaseOverrides, editedCabalFile, metaSection - , dependencies, setupDepends, benchmarkDepends, enableSeparateDataOutput, extraAttributes + , cabalFlags, runHaddock, jailbreak, doCheck, doBenchmark, buildTarget, testTarget, hyperlinkSource + , enableSplitObjs , enableLibraryProfiling, enableExecutableProfiling, phaseOverrides + , editedCabalFile, metaSection , dependencies, setupDepends, benchmarkDepends, enableSeparateDataOutput + , extraAttributes, inputs ) where @@ -56,6 +59,7 @@ data Derivation = MkDerivation , _jailbreak :: Bool , _doCheck :: Bool , _doBenchmark :: Bool + , _buildTarget :: String , _testTarget :: String , _hyperlinkSource :: Bool , _enableLibraryProfiling :: Bool @@ -79,16 +83,17 @@ nullDerivation = MkDerivation , _extraFunctionArgs = error "undefined Derivation.extraFunctionArgs" , _extraAttributes = error "undefined Derivation.extraAttributes" , _setupDepends = error "undefined Derivation.setupDepends" - , _libraryDepends = error "undefined Derivation.libraryDepends" - , _executableDepends = error "undefined Derivation.executableDepends" - , _testDepends = error "undefined Derivation.testDepends" - , _benchmarkDepends = error "undefined Derivation.benchmarkDepends" + , _libraryDepends = mempty + , _executableDepends = mempty + , _testDepends = mempty + , _benchmarkDepends = mempty , _configureFlags = error "undefined Derivation.configureFlags" , _cabalFlags = error "undefined Derivation.cabalFlags" , _runHaddock = error "undefined Derivation.runHaddock" , _jailbreak = error "undefined Derivation.jailbreak" , _doCheck = error "undefined Derivation.doCheck" , _doBenchmark = error "undefined Derivation.doBenchmark" + , _buildTarget = error "undefined Derivation.buildTarget" , _testTarget = error "undefined Derivation.testTarget" , _hyperlinkSource = error "undefined Derivation.hyperlinkSource" , _enableLibraryProfiling = error "undefined Derivation.enableLibraryProfiling" @@ -110,7 +115,7 @@ instance Package Derivation where instance NFData Derivation instance Pretty Derivation where - pPrint drv@MkDerivation {..} = funargs (map text ("mkDerivation" : toAscList inputs)) $$ vcat + pPrint MkDerivation {..} = vcat [ text "mkDerivation" <+> lbrace , nest 2 $ vcat [ attr "pname" $ doubleQuotes $ pPrint (packageName _pkgid) @@ -135,6 +140,7 @@ instance Pretty Derivation where , boolattr "jailbreak" _jailbreak _jailbreak , boolattr "doCheck" (not _doCheck) _doCheck , boolattr "doBenchmark" _doBenchmark _doBenchmark + , onlyIf (not (null _buildTarget)) $ attr "buildTarget" $ string _buildTarget , onlyIf (not (null _testTarget)) $ attr "testTarget" $ string _testTarget , boolattr "hyperlinkSource" (not _hyperlinkSource) _hyperlinkSource , onlyIf (not (null _phaseOverrides)) $ vcat ((map text . lines) _phaseOverrides) @@ -144,16 +150,35 @@ instance Pretty Derivation where , rbrace ] where - inputs :: Set String - inputs = Set.unions [ Set.map (view (localName . ident)) _extraFunctionArgs - , setOf (dependencies . each . folded . localName . ident) drv - , case derivKind _src of - Nothing -> mempty - Just derivKind' -> Set.fromList [derivKindFunction derivKind' | not isHackagePackage] - ] - renderedFlags = [ text "-f" <> (if enable then empty else char '-') <> text (unFlagName f) | (f, enable) <- unFlagAssignment _cabalFlags ] ++ map text (toAscList _configureFlags) - isHackagePackage = "mirror://hackage/" `isPrefixOf` derivUrl _src postUnpack = string $ "sourceRoot+=/" ++ _subpath ++ "; echo source root reset to $sourceRoot" + +inputs :: Derivation -> Set String +inputs drv@MkDerivation {..} = Set.unions + [ Set.map (view (localName . ident)) _extraFunctionArgs + , setOf (dependencies . each . folded . localName . ident) drv + , case derivKind _src of + Nothing -> mempty + Just derivKind' -> Set.fromList [derivKindFunction derivKind' | not isHackagePackage] + ] + where + isHackagePackage = "mirror://hackage/" `isPrefixOf` derivUrl _src + +newtype SingleDerivation = SingleDerivation + { _singleDerivation :: Derivation } + deriving (Show, Generic) + +makeLenses ''SingleDerivation + +nullSingleDerivation :: SingleDerivation +nullSingleDerivation = SingleDerivation + { _singleDerivation = error "undefined SingleDerivation.derivation" + } + +instance NFData SingleDerivation + +instance Pretty SingleDerivation where + pPrint SingleDerivation {..} = funargs (map text ("mkDerivation" : toAscList (inputs _singleDerivation))) $$ + pPrint _singleDerivation diff --git a/cabal2nix/src/Distribution/Nixpkgs/Haskell/FromCabal.hs b/cabal2nix/src/Distribution/Nixpkgs/Haskell/FromCabal.hs index 7f278b593..6a628c1a4 100644 --- a/cabal2nix/src/Distribution/Nixpkgs/Haskell/FromCabal.hs +++ b/cabal2nix/src/Distribution/Nixpkgs/Haskell/FromCabal.hs @@ -3,7 +3,7 @@ {-# LANGUAGE RecordWildCards #-} module Distribution.Nixpkgs.Haskell.FromCabal - ( HaskellResolver, NixpkgsResolver + ( HaskellResolver, NixpkgsResolver, OutputGranularity (..) , fromGenericPackageDescription , finalizeGenericPackageDescription , fromPackageDescription ) where @@ -12,6 +12,7 @@ import Data.Maybe import Data.Set ( Set ) import qualified Data.Set as Set import Distribution.Compiler +import Distribution.Pretty import Distribution.Nixpkgs.Haskell import qualified Distribution.Nixpkgs.Haskell as Nix import Distribution.Nixpkgs.Haskell.Constraint @@ -36,13 +37,30 @@ import Distribution.Types.UnqualComponentName as Cabal import Distribution.Utils.ShortText ( fromShortText ) import Distribution.Version import Language.Nix +import Distribution.Nixpkgs.Fetch (DerivKind(DerivKindHg)) +import Text.PrettyPrint (render) type HaskellResolver = PackageVersionConstraint -> Bool type NixpkgsResolver = Identifier -> Maybe Binding -fromGenericPackageDescription :: HaskellResolver -> NixpkgsResolver -> Platform -> CompilerInfo -> FlagAssignment -> [Constraint] -> GenericPackageDescription -> Derivation -fromGenericPackageDescription haskellResolver nixpkgsResolver arch compiler flags constraints genDesc = - fromPackageDescription haskellResolver nixpkgsResolver missingDeps flags descr +data OutputGranularity + = SingleDerivation + -- One derivation per target, where libraries are not excluded from executables' libraryDepends + | PerTarget + +fromGenericPackageDescription + :: (Derivation -> Derivation) + -> HaskellResolver + -> NixpkgsResolver + -> Platform + -> CompilerInfo + -> FlagAssignment + -> OutputGranularity + -> [Constraint] + -> GenericPackageDescription + -> PackageNix +fromGenericPackageDescription overrideDrv haskellResolver nixpkgsResolver arch compiler flags granularity constraints genDesc = + fromPackageDescription overrideDrv haskellResolver nixpkgsResolver missingDeps flags granularity descr where (descr, missingDeps) = finalizeGenericPackageDescription haskellResolver arch compiler flags constraints genDesc @@ -92,54 +110,121 @@ finalizeGenericPackageDescription haskellResolver arch compiler flags constraint Right (d,_) -> (d,m) Right (d,_) -> (d,[]) -fromPackageDescription :: HaskellResolver -> NixpkgsResolver -> [Dependency] -> FlagAssignment -> PackageDescription -> Derivation -fromPackageDescription haskellResolver nixpkgsResolver missingDeps flags PackageDescription {..} = normalize $ postProcess $ nullDerivation - & isLibrary .~ isJust library - & pkgid .~ package - & revision .~ xrev - & isLibrary .~ isJust library - & isExecutable .~ not (null executables) - & extraFunctionArgs .~ mempty - & extraAttributes .~ mempty - & libraryDepends .~ foldMap (convertBuildInfo . libBuildInfo) (maybeToList library ++ subLibraries) - & executableDepends .~ mconcat (map (convertBuildInfo . buildInfo) executables) - & testDepends .~ mconcat (map (convertBuildInfo . testBuildInfo) testSuites) - & benchmarkDepends .~ mconcat (map (convertBuildInfo . benchmarkBuildInfo) benchmarks) - & Nix.setupDepends .~ maybe mempty convertSetupBuildInfo setupBuildInfo - & configureFlags .~ mempty - & cabalFlags .~ flags - & runHaddock .~ doHaddockPhase - & jailbreak .~ False - & doCheck .~ True - & doBenchmark .~ False - & testTarget .~ mempty - & hyperlinkSource .~ True - & enableSplitObjs .~ True - & enableLibraryProfiling .~ False - & enableExecutableProfiling .~ False - & enableSeparateDataOutput .~ not (null dataFiles) - & subpath .~ "." - & phaseOverrides .~ mempty - & editedCabalFile .~ (if xrev > 0 - then fromMaybe (error (display package ++ ": X-Cabal-File-Hash field is missing")) (lookup "X-Cabal-File-Hash" customFieldsPD) - else "") - & metaSection .~ ( Nix.nullMeta +fromPackageDescription + :: (Derivation -> Derivation) + -> HaskellResolver + -> NixpkgsResolver + -> [Dependency] + -> FlagAssignment + -> OutputGranularity + -> PackageDescription + -> PackageNix +fromPackageDescription overrideDrv haskellResolver nixpkgsResolver missingDeps flags granularity packageDescription@PackageDescription {..} + = case granularity of + SingleDerivation -> singleDerivationPackage + PerTarget -> multiDerivationPackage + where + singleDerivationPackage :: PackageNix + singleDerivationPackage = nullSingleDrvPackage + & derivation .~ processDrv (baseDerivation + & isLibrary .~ isJust library + & isExecutable .~ not (null executables) + & libraryDepends .~ foldMap (convertSingleDerivationBuildInfo . libBuildInfo) (allLibraries packageDescription) + & executableDepends .~ mconcat (map (convertSingleDerivationBuildInfo . buildInfo) executables) + & testDepends .~ mconcat (map (convertSingleDerivationBuildInfo . testBuildInfo) testSuites) + & benchmarkDepends .~ mconcat (map (convertSingleDerivationBuildInfo . benchmarkBuildInfo) benchmarks)) + + processDrv :: Derivation -> Derivation + processDrv = overrideDrv . normalize . postProcess + + multiDerivationPackage :: PackageNix + multiDerivationPackage = nullTargetDrvsPackage + & targetDrvs .~ (nullTargetDerivations + & libraries .~ fmap (processDrv . toLibraryDerivation) (allLibraries packageDescription) + & exes .~ fmap (processDrv . toExecutableDerivation) executables + & testExes .~ fmap (processDrv . toTestDerivation) testSuites + & benchExes .~ fmap (processDrv . toBenchDerivation) benchmarks) + + toLibraryDerivation :: Library -> Derivation + toLibraryDerivation lib = baseDerivation + & pkgid .~ case libName lib of + LMainLibName -> baseDerivation^.pkgid + LSubLibName subLibName -> (baseDerivation^.pkgid) { pkgName = unqualComponentNameToPackageName subLibName } + & isLibrary .~ True + & isExecutable .~ False + & doCheck .~ False + & libraryDepends .~ convertComponentDerivationBuildInfo (libBuildInfo lib) + & buildTarget .~ render (case libName lib of + LMainLibName -> pretty $ packageName (baseDerivation^.pkgid) + name@LSubLibName {} -> prettyLibraryNameComponent name) + + toExecutableDerivation :: Executable -> Derivation + toExecutableDerivation executable = baseDerivation + & pkgid .~ (baseDerivation^.pkgid) { pkgName = unqualComponentNameToPackageName (exeName executable) } + & isLibrary .~ False + & isExecutable .~ True + & executableDepends .~ convertComponentDerivationBuildInfo (buildInfo executable) + & buildTarget .~ unUnqualComponentName (exeName executable) + + toTestDerivation :: TestSuite -> Derivation + toTestDerivation testSuite = baseDerivation + & pkgid .~ (baseDerivation^.pkgid) { pkgName = unqualComponentNameToPackageName (testName testSuite) } + & isLibrary .~ False + & isExecutable .~ True + & testDepends .~ convertComponentDerivationBuildInfo (testBuildInfo testSuite) + & buildTarget .~ unUnqualComponentName (testName testSuite) + + toBenchDerivation :: Benchmark -> Derivation + toBenchDerivation benchmark = baseDerivation + & pkgid .~ (baseDerivation^.pkgid) { pkgName = unqualComponentNameToPackageName (benchmarkName benchmark) } + & isLibrary .~ False + & isExecutable .~ True + & doBenchmark .~ True + & benchmarkDepends .~ convertComponentDerivationBuildInfo (benchmarkBuildInfo benchmark) + & buildTarget .~ unUnqualComponentName (benchmarkName benchmark) + + baseDerivation :: Derivation + baseDerivation = nullDerivation + & pkgid .~ package + & revision .~ xrev + & extraFunctionArgs .~ mempty + & extraAttributes .~ mempty + & Nix.setupDepends .~ maybe mempty convertSetupBuildInfo setupBuildInfo + & configureFlags .~ mempty + & cabalFlags .~ flags + & runHaddock .~ doHaddockPhase + & jailbreak .~ False + & doCheck .~ True + & doBenchmark .~ False + & buildTarget .~ mempty + & testTarget .~ mempty + & hyperlinkSource .~ True + & enableSplitObjs .~ True + & enableLibraryProfiling .~ False + & enableExecutableProfiling .~ False + & enableSeparateDataOutput .~ not (null dataFiles) + & subpath .~ "." + & phaseOverrides .~ mempty + & editedCabalFile .~ (if xrev > 0 + then fromMaybe (error (display package ++ ": X-Cabal-File-Hash field is missing")) (lookup "X-Cabal-File-Hash" customFieldsPD) + else "") + & metaSection .~ ( Nix.nullMeta #if MIN_VERSION_Cabal(3,2,0) - & Nix.homepage .~ stripRedundanceSpaces (fromShortText homepage) - & Nix.description .~ stripRedundanceSpaces (fromShortText synopsis) + & Nix.homepage .~ stripRedundanceSpaces (fromShortText homepage) + & Nix.description .~ stripRedundanceSpaces (fromShortText synopsis) #else - & Nix.homepage .~ stripRedundanceSpaces homepage - & Nix.description .~ stripRedundanceSpaces synopsis + & Nix.homepage .~ stripRedundanceSpaces homepage + & Nix.description .~ stripRedundanceSpaces synopsis #endif - & Nix.license .~ nixLicense - & Nix.platforms .~ Nothing - & Nix.badPlatforms .~ Nothing - & Nix.hydraPlatforms .~ (if isFreeLicense nixLicense then Nothing else Just Set.empty) - & Nix.mainProgram .~ nixMainProgram - & Nix.maintainers .~ mempty - & Nix.broken .~ not (null missingDeps) - ) - where + & Nix.license .~ nixLicense + & Nix.platforms .~ Nothing + & Nix.badPlatforms .~ Nothing + & Nix.hydraPlatforms .~ (if isFreeLicense nixLicense then Nothing else Just Set.empty) + & Nix.mainProgram .~ nixMainProgram + & Nix.maintainers .~ mempty + & Nix.broken .~ not (null missingDeps) + ) + xrev = maybe 0 read (lookup "x-revision" customFieldsPD) nixLicense :: Nix.License @@ -190,10 +275,16 @@ fromPackageDescription haskellResolver nixpkgsResolver missingDeps flags Package | Just l <- library = not (null (exposedModules l)) | otherwise = True - convertBuildInfo :: Cabal.BuildInfo -> Nix.BuildInfo - convertBuildInfo Cabal.BuildInfo {..} | not buildable = mempty - convertBuildInfo Cabal.BuildInfo {..} = mempty - & haskell .~ Set.fromList [ resolveInHackage (toNixName x) | (Dependency x _ _) <- targetBuildDepends, x `notElem` internalLibNames ] + convertSingleDerivationBuildInfo :: Cabal.BuildInfo -> Nix.BuildInfo + convertSingleDerivationBuildInfo = convertBuildInfo (`notElem` internalLibNames) + + convertComponentDerivationBuildInfo :: Cabal.BuildInfo -> Nix.BuildInfo + convertComponentDerivationBuildInfo = convertBuildInfo $ const True + + convertBuildInfo :: (PackageName -> Bool) -> Cabal.BuildInfo -> Nix.BuildInfo + convertBuildInfo _ Cabal.BuildInfo {..} | not buildable = mempty + convertBuildInfo buildDependsFilterPredicate Cabal.BuildInfo {..} = mempty + & haskell .~ Set.fromList [ resolveInHackage (toNixName x) | (Dependency x _ _) <- targetBuildDepends, buildDependsFilterPredicate x ] & system .~ Set.fromList [ resolveInNixpkgs y | x <- extraLibs, y <- libNixName x ] & pkgconfig .~ Set.fromList [ resolveInNixpkgs y | PkgconfigDependency x _ <- pkgconfigDepends, y <- libNixName (unPkgconfigName x) ] & tool .~ Set.fromList (map resolveInHackageThenNixpkgs . concatMap buildToolNixName diff --git a/cabal2nix/src/Distribution/Nixpkgs/Haskell/PackageNix.hs b/cabal2nix/src/Distribution/Nixpkgs/Haskell/PackageNix.hs new file mode 100644 index 000000000..956e8f3bb --- /dev/null +++ b/cabal2nix/src/Distribution/Nixpkgs/Haskell/PackageNix.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module Distribution.Nixpkgs.Haskell.PackageNix + ( PackageNix, derivation, singleDrv, targetDrvs, nullSingleDrvPackage, nullTargetDrvsPackage + , allDependencies, allExtraFunctionArgs + ) where + +import Control.DeepSeq +import Control.Lens +import Data.Set ( Set ) +import Distribution.Nixpkgs.Haskell.BuildInfo +import Distribution.Nixpkgs.Haskell.Derivation +import Distribution.Nixpkgs.Haskell.TargetDerivations +import GHC.Generics ( Generic ) +import Language.Nix +import Language.Nix.PrettyPrinting + +data PackageNix + = SingleDerivation { _singleDrv :: SingleDerivation } + | TargetDerivations { _targetDrvs :: TargetDerivations } + deriving (Show, Generic) + +instance NFData PackageNix + +makeLenses ''PackageNix + +derivation :: Traversal' PackageNix Derivation +derivation f SingleDerivation {..} = do + singleDrv' <- singleDerivation f _singleDrv + pure SingleDerivation { _singleDrv = singleDrv' } +derivation f TargetDerivations {..} = do + targetDrvs' <- targetDerivations f _targetDrvs + pure TargetDerivations { _targetDrvs = targetDrvs' } + +allDependencies :: Traversal' PackageNix BuildInfo +allDependencies f SingleDerivation {..} = do + singleDrv' <- (singleDerivation . dependencies) f _singleDrv + pure SingleDerivation { _singleDrv = singleDrv' } +allDependencies f TargetDerivations {..} = do + targetDrvs' <- (targetDerivations . dependencies) f _targetDrvs + pure TargetDerivations { _targetDrvs = targetDrvs' } + +allExtraFunctionArgs :: Traversal' PackageNix (Set Binding) +allExtraFunctionArgs f SingleDerivation {..} = do + singleDrv' <- (singleDerivation . extraFunctionArgs) f _singleDrv + pure SingleDerivation { _singleDrv = singleDrv' } +allExtraFunctionArgs f TargetDerivations {..} = do + targetDrvs' <- (targetDerivations . extraFunctionArgs) f _targetDrvs + pure TargetDerivations { _targetDrvs = targetDrvs' } + +instance Pretty PackageNix where + pPrint SingleDerivation {..} = pPrint _singleDrv + pPrint TargetDerivations {..} = pPrint _targetDrvs + +nullSingleDrvPackage :: PackageNix +nullSingleDrvPackage = SingleDerivation { _singleDrv = nullSingleDerivation } + +nullTargetDrvsPackage :: PackageNix +nullTargetDrvsPackage = TargetDerivations { _targetDrvs = nullTargetDerivations } diff --git a/cabal2nix/src/Distribution/Nixpkgs/Haskell/TargetDerivations.hs b/cabal2nix/src/Distribution/Nixpkgs/Haskell/TargetDerivations.hs new file mode 100644 index 000000000..240ba1f06 --- /dev/null +++ b/cabal2nix/src/Distribution/Nixpkgs/Haskell/TargetDerivations.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +module Distribution.Nixpkgs.Haskell.TargetDerivations + ( TargetDerivations, targetDerivations, allDerivations, libraries, exes, testExes, benchExes + , nullTargetDerivations + ) + where + +import Prelude hiding ((<>)) + +import Control.DeepSeq +import Control.Lens +import Data.Set ( Set ) +import qualified Data.Set as Set +import Distribution.Nixpkgs.Haskell.OrphanInstances ( ) +import Distribution.Package +import GHC.Generics ( Generic ) +import Distribution.Nixpkgs.Haskell.Derivation +import Language.Nix.PrettyPrinting + +-- | A represtation of Nix expressions for building individual targets within a Haskell package. + +data TargetDerivations = TargetDerivations + { _libraries :: [Derivation] + , _exes :: [Derivation] + , _testExes :: [Derivation] + , _benchExes :: [Derivation] + } + deriving (Show, Generic) + +instance NFData TargetDerivations + +makeLenses ''TargetDerivations + +makeLensesFor [("_libraries", "allDerivations"), ("_exes", "allDerivations"), ("_testExes", "allDerivations"), ("_benchExes", "allDerivations")] ''TargetDerivations + +targetDerivations :: Traversal' TargetDerivations Derivation +targetDerivations f (TargetDerivations {..}) = do + libs <- traverse f _libraries + exes' <- traverse f _exes + testExes' <- traverse f _testExes + benchExes' <- traverse f _benchExes + pure TargetDerivations + { _libraries = libs + , _exes = exes' + , _testExes = testExes' + , _benchExes = benchExes' + } + +nullTargetDerivations :: TargetDerivations +nullTargetDerivations = TargetDerivations + { _libraries = mempty + , _exes = mempty + , _testExes = mempty + , _benchExes = mempty + } + +allInputs :: TargetDerivations -> Set String +allInputs TargetDerivations {..} = Set.filter (`notElem` internalLibNames) $ Set.unions $ mconcat + [ inputs <$> _libraries + , inputs <$> _exes + , inputs <$> _testExes + , inputs <$> _benchExes + ] + where + internalLibNames :: [String] + internalLibNames = drvName <$> _libraries + +instance Pretty TargetDerivations where + pPrint targetDrvs = funargs (map text ("mkDerivation" : toAscList (allInputs targetDrvs))) $$ vcat + [ text "let" + , nest 2 $ vcat $ derivationAttr <$> targetDrvs^.libraries + , text "in" <+> lbrace $$ nest 2 (vcat + [ attr "libraries" $ hcat + [ lbrace + , text "inherit" + , text " " + , hcat (pPrint . packageName <$> targetDrvs^.libraries) + , semi + , rbrace + ] + , attr "exes" $ derivationAttrs $ targetDrvs^.exes + , attr "testExes" $ derivationAttrs $ targetDrvs^.testExes + , attr "benchExes" $ derivationAttrs $ targetDrvs^.benchExes + , nest (-2) rbrace + ]) + ] + +derivationAttr :: Derivation -> Doc +derivationAttr drv = attr (drvName drv) $ pPrint drv + +derivationAttrs :: [Derivation] -> Doc +derivationAttrs [] = lbrace <+> rbrace +derivationAttrs drvs = vcat + [ lbrace + , vcat (derivationAttr <$> drvs) + , rbrace + ] + +drvName :: Derivation -> String +drvName drv = unPackageName $ packageName $ drv^.pkgid diff --git a/cabal2nix/test/Main.hs b/cabal2nix/test/Main.hs index d4a6e4e96..a85dd8854 100644 --- a/cabal2nix/test/Main.hs +++ b/cabal2nix/test/Main.hs @@ -8,6 +8,7 @@ import Distribution.Nixpkgs.Fetch import Distribution.Nixpkgs.Haskell.Derivation import Distribution.Nixpkgs.Haskell.FromCabal import Distribution.Nixpkgs.Haskell.FromCabal.Flags +import Distribution.Nixpkgs.Haskell.PackageNix import Control.Lens import Control.Monad @@ -42,33 +43,39 @@ main = do Nothing -> fail "cannot find 'cabal2nix' in $PATH" Just exe -> pure exe testCases <- listDirectoryFilesBySuffix ".cabal" "test/golden-test-cases" + granularCases <- listDirectoryFilesBySuffix ".cabal" "test/golden-test-cases-granular" defaultMain $ testGroup "regression-tests" - [ testGroup "cabal2nix library" (map testLibrary testCases) + [ testGroup "cabal2nix library" (map (testLibrary SingleDerivation) testCases) + , testGroup "cabal2nix granular-output" (map (testLibrary PerTarget) granularCases) , testGroup "cabal2nix executable" (map (testExecutable cabal2nix) testCases) ] -testLibrary :: String -> TestTree -testLibrary cabalFile = do +testLibrary :: OutputGranularity -> String -> TestTree +testLibrary outputGranularity cabalFile = do let nixFile = cabalFile `replaceExtension` "nix" goldenFile = nixFile `addExtension` "golden" - cabal2nix :: GenericPackageDescription -> Derivation + overrideDrv :: Derivation -> Derivation + overrideDrv drv = drv + & src .~ DerivationSource + { derivKind = Just (DerivKindUrl DontUnpackArchive ) + , derivUrl = "mirror://hackage/foo.tar.gz" + , derivRevision = "" + , derivHash = "deadbeef" + , derivSubmodule = Nothing + } + & extraFunctionArgs %~ Set.union (Set.singleton "inherit lib") + cabal2nix :: GenericPackageDescription -> PackageNix cabal2nix gpd = fromGenericPackageDescription + overrideDrv (const True) (\i -> Just (binding # (i, path # [ident # "pkgs", i]))) (Platform X86_64 Linux) (unknownCompilerInfo (CompilerId GHC (mkVersion [8,2])) NoAbiTag) (configureCabalFlags (packageId gpd)) + outputGranularity [] gpd - & src .~ DerivationSource - { derivKind = Just (DerivKindUrl DontUnpackArchive ) - , derivUrl = "mirror://hackage/foo.tar.gz" - , derivRevision = "" - , derivHash = "deadbeef" - , derivSubmodule = Nothing - } - & extraFunctionArgs %~ Set.union (Set.singleton "inherit lib") goldenVsFileDiff nixFile (\ref new -> ["diff", "-u", ref, new]) diff --git a/cabal2nix/test/golden-test-cases-granular/.gitignore b/cabal2nix/test/golden-test-cases-granular/.gitignore new file mode 100644 index 000000000..40c431b6e --- /dev/null +++ b/cabal2nix/test/golden-test-cases-granular/.gitignore @@ -0,0 +1 @@ +/*.nix diff --git a/cabal2nix/test/golden-test-cases-granular/ttrie.cabal b/cabal2nix/test/golden-test-cases-granular/ttrie.cabal new file mode 100644 index 000000000..3d5e3bbb5 --- /dev/null +++ b/cabal2nix/test/golden-test-cases-granular/ttrie.cabal @@ -0,0 +1,68 @@ +name: ttrie +version: 0.1.2.1 +synopsis: Contention-free STM hash map +description: + A contention-free STM hash map. + \"Contention-free\" means that the map will never cause spurious conflicts. + A transaction operating on the map will only ever have to retry if + another transaction is operating on the same key at the same time. + . + This is an implementation of the /transactional trie/, + which is basically a /lock-free concurrent hash trie/ lifted into STM. + For a detailed discussion, including an evaluation of its performance, + see Chapter 4 of . +homepage: http://github.com/mcschroeder/ttrie +bug-reports: http://github.com/mcschroeder/ttrie/issues +license: MIT +license-file: LICENSE +author: Michael Schröder +maintainer: mc.schroeder@gmail.com +copyright: (c) 2014-2015 Michael Schröder +category: Concurrency +build-type: Simple +extra-source-files: README.md, benchmarks/run.sh +cabal-version: >=1.10 + +extra-source-files: changelog.md + +source-repository head + type: git + location: https://github.com/mcschroeder/ttrie.git + +library + hs-source-dirs: src + exposed-modules: Control.Concurrent.STM.Map + other-modules: Data.SparseArray + default-language: Haskell2010 + ghc-options: -Wall + build-depends: base >=4.7 && <5 + , atomic-primops >=0.6 + , hashable >=1.2 + , primitive >=0.5 + , stm >=2 + +test-suite map-properties + hs-source-dirs: tests + main-is: MapProperties.hs + type: exitcode-stdio-1.0 + + build-depends: + base + , QuickCheck >=2.5 + , test-framework >=0.8 + , test-framework-quickcheck2 >=0.3 + , containers >=0.5 + , hashable >=1.2 + , stm + , ttrie + +benchmark bench + hs-source-dirs: benchmarks + main-is: Bench.hs + other-modules: BenchGen + type: exitcode-stdio-1.0 + default-language: Haskell2010 + ghc-options: -O2 -threaded -with-rtsopts=-N + build-depends: + base, async, bifunctors, containers, criterion-plus, deepseq, mwc-random, primitive, stm, stm-containers, stm-stats, text, transformers, ttrie, unordered-containers, vector + diff --git a/cabal2nix/test/golden-test-cases-granular/ttrie.nix.golden b/cabal2nix/test/golden-test-cases-granular/ttrie.nix.golden new file mode 100644 index 000000000..044cd4ad8 --- /dev/null +++ b/cabal2nix/test/golden-test-cases-granular/ttrie.nix.golden @@ -0,0 +1,60 @@ +{ mkDerivation, async, atomic-primops, base, bifunctors, containers +, criterion-plus, deepseq, hashable, lib, mwc-random, primitive +, QuickCheck, stm, stm-containers, stm-stats, test-framework +, test-framework-quickcheck2, text, transformers +, unordered-containers, vector +}: +let + ttrie = mkDerivation { + pname = "ttrie"; + version = "0.1.2.1"; + sha256 = "deadbeef"; + libraryHaskellDepends = [ + atomic-primops base hashable primitive stm + ]; + doCheck = false; + buildTarget = "ttrie"; + homepage = "http://github.com/mcschroeder/ttrie"; + description = "Contention-free STM hash map"; + license = lib.licenses.mit; + }; +in { + libraries = {inherit ttrie;}; + exes = { }; + testExes = { + map-properties = mkDerivation { + pname = "map-properties"; + version = "0.1.2.1"; + sha256 = "deadbeef"; + isLibrary = false; + isExecutable = true; + testHaskellDepends = [ + base containers hashable QuickCheck stm test-framework + test-framework-quickcheck2 ttrie + ]; + buildTarget = "map-properties"; + homepage = "http://github.com/mcschroeder/ttrie"; + description = "Contention-free STM hash map"; + license = lib.licenses.mit; + }; + }; + benchExes = { + bench = mkDerivation { + pname = "bench"; + version = "0.1.2.1"; + sha256 = "deadbeef"; + isLibrary = false; + isExecutable = true; + benchmarkHaskellDepends = [ + async base bifunctors containers criterion-plus deepseq mwc-random + primitive stm stm-containers stm-stats text transformers ttrie + unordered-containers vector + ]; + doBenchmark = true; + buildTarget = "bench"; + homepage = "http://github.com/mcschroeder/ttrie"; + description = "Contention-free STM hash map"; + license = lib.licenses.mit; + }; + }; +}