{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Distribution.Nixpkgs.Haskell.FromCabal.PostProcess ( postProcess, pkg ) where

import Control.Lens
import Control.Monad.Trans.State
import Data.List.Split
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Map.Lens
import Data.Set ( Set )
import qualified Data.Set as Set
import Distribution.Nixpkgs.Haskell
import Distribution.Nixpkgs.Meta
import Distribution.Nixpkgs.License
import Distribution.Package
import Distribution.Types.PackageVersionConstraint
import Distribution.Text
import Distribution.Version
import Language.Nix

postProcess :: Derivation -> Derivation
postProcess :: Derivation -> Derivation
postProcess Derivation
deriv =
 forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id [ Derivation -> Derivation
f | (PackageVersionConstraint PackageName
n VersionRange
vr, Derivation -> Derivation
f) <- [(PackageVersionConstraint, Derivation -> Derivation)]
hooks, forall pkg. Package pkg => pkg -> PackageName
packageName Derivation
deriv forall a. Eq a => a -> a -> Bool
== PackageName
n, forall pkg. Package pkg => pkg -> Version
packageVersion Derivation
deriv Version -> VersionRange -> Bool
`withinRange` VersionRange
vr ]
 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derivation -> Derivation
fixGtkBuilds
 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derivation -> Derivation
fixBuildDependsForTools
 forall a b. (a -> b) -> a -> b
$ Derivation
deriv

fixGtkBuilds :: Derivation -> Derivation
fixGtkBuilds :: Derivation -> Derivation
fixGtkBuilds Derivation
drv = Derivation
drv forall a b. a -> (a -> b) -> b
& Traversal' Derivation BuildInfo
dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding -> Bool
collidesWithHaskellName)
                       forall a b. a -> (a -> b) -> b
& Traversal' Derivation BuildInfo
dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding -> Bool
collidesWithHaskellName)
                       forall a b. a -> (a -> b) -> b
& Traversal' Derivation BuildInfo
dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binding -> Bool
collidesWithHaskellName)
  where
    collidesWithHaskellName :: Binding -> Bool
    collidesWithHaskellName :: Binding -> Bool
collidesWithHaskellName Binding
b = case Map Identifier Path
buildDeps forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Binding Identifier
localName Binding
b of
      Maybe Path
Nothing -> Bool
False -- totally uncollided
      Just Path
p  -> Path
p forall a. Eq a => a -> a -> Bool
/= forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Binding Path
reference Binding
b -- identical is not collision, and important to preserve for cross

    myName :: Identifier
    myName :: Identifier
myName = Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# PackageName -> String
unPackageName (forall pkg. Package pkg => pkg -> PackageName
packageName Derivation
drv)

    buildDeps :: Map Identifier Path
    buildDeps :: Map Identifier Path
buildDeps = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Identifier
myName (forall i a s. IndexedGetting i (Map i a) s a -> s -> Map i a
toMapOf (Traversal' Derivation BuildInfo
dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
haskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' Binding (Identifier, Path)
binding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
ifolded) Derivation
drv)

-- Per https://github.com/haskell/cabal/issues/5412 hvr considers
-- `build-depends` providing executables an accident, and fragile one at that,
-- unworthy of any compatibility hacks. But while he and the other Hackage
-- maintainers is dedicated to fixing executables and libraries on Hackage, test
-- suites and benchmarks are not a priority, as it is trivial to skip building
-- test-suites with cabal-install. Nix however wishes to build test suites much
-- more widely, so skipping those components is not an option.
--
-- Between that, and Stack not changing behavior as of
-- https://github.com/commercialhaskell/stack/pull/4132, it seems likely that
-- for a while packages scraped from Hackage will continue to improperly use
-- `build-depends: package-for-tool` instead of `build-tool-depends` (which does
-- also work for Stack). Until that changes, we provide do this to work around
-- those package's brokenness.
fixBuildDependsForTools :: Derivation -> Derivation
fixBuildDependsForTools :: Derivation -> Derivation
fixBuildDependsForTools = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id
  [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall s a. State s a -> s -> (a, s)
runState forall a b. (a -> b) -> a -> b
$ do
      Bool
needs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' Derivation BuildInfo
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
haskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains Binding
p
      forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens' Derivation BuildInfo
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains Binding
p forall s (m :: * -> *).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= Bool
needs
  | (ALens' Derivation BuildInfo
c :: ALens' Derivation BuildInfo) <- [ Lens' Derivation BuildInfo
testDepends, Lens' Derivation BuildInfo
benchmarkDepends ]
  , Binding
p <- Identifier -> Binding
self forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Identifier
"hspec-discover"
                  , Identifier
"tasty-discover"
                  , Identifier
"hsx2hs"
                  , Identifier
"markdown-unlit"
                  ]
  ]

hooks :: [(PackageVersionConstraint, Derivation -> Derivation)]
hooks :: [(PackageVersionConstraint, Derivation -> Derivation)]
hooks =
  [ (PackageVersionConstraint
"Agda < 2.5", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
executableDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"emacs")) Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
agdaPostInstall)
  , (PackageVersionConstraint
"Agda >= 2.5 && < 2.6", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
executableDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"emacs")) Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
agda25PostInstall)
  , (PackageVersionConstraint
"Agda >= 2.6", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
executableDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"emacs")) Bool
True)
  , (PackageVersionConstraint
"alex < 3.1.5",  forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"perl")) Bool
True)
  , (PackageVersionConstraint
"alex",  forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
executableDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
self Identifier
"happy")) Bool
True)
  , (PackageVersionConstraint
"alsa-core", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"linux"))))
  , (PackageVersionConstraint
"bindings-GLFW", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [String -> Binding
bind String
"pkgs.xorg.libXext", String -> Binding
bind String
"pkgs.xorg.libXfixes"])))
  , (PackageVersionConstraint
"bindings-lxc", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"linux"))))
  , (PackageVersionConstraint
"bustle", Derivation -> Derivation
bustleOverrides)
  , (PackageVersionConstraint
"Cabal", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- test suite doesn't work in Nix
  , (PackageVersionConstraint
"Cabal >2.2", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
setupDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
haskell) (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [Identifier -> Binding
self Identifier
"mtl", Identifier -> Binding
self Identifier
"parsec"]))) -- https://github.com/haskell/cabal/issues/5391
  , (PackageVersionConstraint
"cabal-helper", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- https://github.com/DanielG/cabal-helper/issues/17
  , (PackageVersionConstraint
"cabal-install", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
cabalInstallPostInstall)
  , (PackageVersionConstraint
"cabal2nix > 2", Derivation -> Derivation
cabal2nixOverrides)
  , (PackageVersionConstraint
"darcs", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
darcsInstallPostInstall forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)
  , (PackageVersionConstraint
"dbus", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- don't execute tests that try to access the network
  , (PackageVersionConstraint
"dhall", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- attempts to access the network
  , (PackageVersionConstraint
"dns", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
testTarget String
"spec")      -- don't execute tests that try to access the network
  , (PackageVersionConstraint
"eventstore", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"x86_64"))))
  , (PackageVersionConstraint
"freenect < 1.2.1", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Derivation (Set String)
configureFlags (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [String
"--extra-include-dirs=${pkgs.freenect}/include/libfreenect", String
"--extra-lib-dirs=${pkgs.freenect}/lib"])))
  , (PackageVersionConstraint
"fltkhs", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"fltk14")) Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig) (forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Identifier] -> Set Binding
pkgs [Identifier
"libGLU", Identifier
"libGL"]))) -- TODO: fltk14 belongs into the *setup* dependencies.
  , (PackageVersionConstraint
"gf", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
gfPhaseOverrides forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)
  , (PackageVersionConstraint
"gi-cairo", Derivation -> Derivation
giCairoPhaseOverrides)                     -- https://github.com/haskell-gi/haskell-gi/issues/36
  , (PackageVersionConstraint
"gi-gdk", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
runHaddock Bool
True )
  , (PackageVersionConstraint
"gi-gio", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
runHaddock Bool
True )
  , (PackageVersionConstraint
"gi-glib", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
runHaddock Bool
True )
  , (PackageVersionConstraint
"gi-gst", String -> Derivation -> Derivation
giGstLibOverrides String
"gstreamer")               -- https://github.com/haskell-gi/haskell-gi/issues/36
  , (PackageVersionConstraint
"gi-gstaudio", String -> Derivation -> Derivation
giGstLibOverrides String
"gst-plugins-base")   -- https://github.com/haskell-gi/haskell-gi/issues/36
  , (PackageVersionConstraint
"gi-gstbase", String -> Derivation -> Derivation
giGstLibOverrides String
"gst-plugins-base")    -- https://github.com/haskell-gi/haskell-gi/issues/36
  , (PackageVersionConstraint
"gi-gstvideo", String -> Derivation -> Derivation
giGstLibOverrides String
"gst-plugins-base")   -- https://github.com/haskell-gi/haskell-gi/issues/36
  , (PackageVersionConstraint
"gi-gtk", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
runHaddock Bool
True )
  , (PackageVersionConstraint
"gi-pango", Derivation -> Derivation
giCairoPhaseOverrides)                     -- https://github.com/haskell-gi/haskell-gi/issues/36
  , (PackageVersionConstraint
"gi-pango", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
runHaddock Bool
True )
  , (PackageVersionConstraint
"gi-pangocairo", Derivation -> Derivation
giCairoPhaseOverrides)                     -- https://github.com/haskell-gi/haskell-gi/issues/36
  , (PackageVersionConstraint
"gi-vte", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
runHaddock Bool
True )
  , (PackageVersionConstraint
"gio", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains Binding
"system-glib = pkgs.glib") Bool
True)
  , (PackageVersionConstraint
"git", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)          -- https://github.com/vincenthz/hit/issues/33
  , (PackageVersionConstraint
"git-annex >= 6.20170925 && < 6.20171214", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)      -- some versions of git-annex require their test suite to be run inside of a git checkout
  , (PackageVersionConstraint
"git-annex", Derivation -> Derivation
gitAnnexHook)
  , (PackageVersionConstraint
"github-backup", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
executableDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"git")) Bool
True)
  , (PackageVersionConstraint
"GLFW", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [String -> Binding
bind String
"pkgs.xorg.libXext", String -> Binding
bind String
"pkgs.xorg.libXfixes"])))
  , (PackageVersionConstraint
"GlomeVec", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (String -> Binding
bind String
"self.llvmPackages.llvm")) Bool
True)
  , (PackageVersionConstraint
"graphviz", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"graphviz")) Bool
True)
  , (PackageVersionConstraint
"gtk3", Derivation -> Derivation
gtk3Hook)
  , (PackageVersionConstraint
"gtkglext", Derivation -> Derivation
gtkglextHook)
  , (PackageVersionConstraint
"haddock", Derivation -> Derivation
haddockHook) -- https://github.com/haskell/haddock/issues/511
  , (PackageVersionConstraint
"hakyll", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"util-linux")) Bool
True) -- test suite depends on "rev"
  , (PackageVersionConstraint
"haskell-src-exts", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)
  , (PackageVersionConstraint
"hfsevents", Derivation -> Derivation
hfseventsOverrides)
  , (PackageVersionConstraint
"HFuse", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
hfusePreConfigure)
  , (PackageVersionConstraint
"hlibgit2 >= 0.18.0.14", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"git")) Bool
True)
  , (PackageVersionConstraint
"hmatrix < 0.18.1.1", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
"preConfigure = \"sed -i hmatrix.cabal -e '/\\\\/usr\\\\//D'\";")
  , (PackageVersionConstraint
"holy-project", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)         -- attempts to access the network
  , (PackageVersionConstraint
"hoogle", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
testTarget String
"--test-option=--no-net")
  , (PackageVersionConstraint
"hsignal < 0.2.7.4", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
"prePatch = \"rm -v Setup.lhs\";") -- https://github.com/amcphail/hsignal/issues/1
  , (PackageVersionConstraint
"hslua < 0.9.3", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
pkg Identifier
"lua") (Identifier -> Binding
pkg Identifier
"lua5_1")))
  , (PackageVersionConstraint
"hslua >= 0.9.3 && < 2.0.0", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
pkg Identifier
"lua") (Identifier -> Binding
pkg Identifier
"lua5_3")))
  , (PackageVersionConstraint
"hspec-core >= 2.4.4", Derivation -> Derivation
hspecCoreOverrides)
  , (PackageVersionConstraint
"http-client", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)          -- attempts to access the network
  , (PackageVersionConstraint
"http-client-openssl >= 0.2.0.1", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- attempts to access the network
  , (PackageVersionConstraint
"http-client-tls >= 0.2.2", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- attempts to access the network
  , (PackageVersionConstraint
"http-conduit", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)         -- attempts to access the network
  , (PackageVersionConstraint
"imagemagick", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"imagemagick")) Bool
True) -- https://github.com/NixOS/cabal2nix/issues/136
  , (PackageVersionConstraint
"include-file <= 0.1.0.2", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
haskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
self Identifier
"random")) Bool
True) -- https://github.com/Daniel-Diaz/include-file/issues/1
  , (PackageVersionConstraint
"js-jquery", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)            -- attempts to access the network
  , (PackageVersionConstraint
"libconfig", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (Binding -> Binding -> Set Binding -> Set Binding
replace Binding
"config = null" (Identifier -> Binding
pkg Identifier
"libconfig")))
  , (PackageVersionConstraint
"libxml", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation (Set String)
configureFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains String
"--extra-include-dir=${libxml2.dev}/include/libxml2") Bool
True)
  , (PackageVersionConstraint
"liquid-fixpoint", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"z3")) Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"nettools")) Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"git")) Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)
  , (PackageVersionConstraint
"liquidhaskell", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"z3")) Bool
True)
  , (PackageVersionConstraint
"lua >= 2.0.0 && < 2.2.0", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
pkg Identifier
"lua") (Identifier -> Binding
pkg Identifier
"lua5_3")))
  , (PackageVersionConstraint
"lua >= 2.2.0", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
pkg Identifier
"lua") (Identifier -> Binding
pkg Identifier
"lua5_4")))
  , (PackageVersionConstraint
"lzma-clib", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"windows"))) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
haskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
self Identifier
"only-buildable-on-windows")) Bool
False)
  , (PackageVersionConstraint
"MFlow < 4.6", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
self Identifier
"cpphs")) Bool
True)
  , (PackageVersionConstraint
"mwc-random", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)
  , (PackageVersionConstraint
"mysql", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"libmysqlclient")) Bool
True)
  , (PackageVersionConstraint
"network-attoparsec", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- test suite requires network access
  , (PackageVersionConstraint
"numeric-qq", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- test suite doesn't finish even after 1+ days
  , (PackageVersionConstraint
"opencv", Derivation -> Derivation
opencvOverrides)
  , (PackageVersionConstraint
"pandoc >= 1.16.0.2 && < 2.5", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- https://github.com/jgm/pandoc/issues/2709 and https://github.com/fpco/stackage/issues/1332
  , (PackageVersionConstraint
"pandoc < 2.6", Derivation -> Derivation
pandocPre26Overrides)
  , (PackageVersionConstraint
"pandoc >= 2.6", Derivation -> Derivation
pandocOverrides)
  , (PackageVersionConstraint
"pandoc-citeproc", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- https://github.com/jgm/pandoc-citeproc/issues/369
  , (PackageVersionConstraint
"purescript", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- test suite doesn't cope with Nix build env
  , (PackageVersionConstraint
"proto-lens-protobuf-types", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"protobuf")) Bool
True)
  , (PackageVersionConstraint
"proto-lens-protoc", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"protobuf")) Bool
True)
  , (PackageVersionConstraint
"qtah-cpp-qt5", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (String -> Binding
bind String
"pkgs.qt5.qtbase")) Bool
True)
  , (PackageVersionConstraint
"qtah-qt5", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (String -> Binding
bind String
"pkgs.qt5.qtbase")) Bool
True)
  , (PackageVersionConstraint
"readline", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Identifier] -> Set Binding
pkgs [Identifier
"readline", Identifier
"ncurses"])))
  , (PackageVersionConstraint
"req", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)  -- test suite requires network access
  , (PackageVersionConstraint
"sbv > 7", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"z3")) Bool
True)
  , (PackageVersionConstraint
"sdr", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"x86_64")))) -- https://github.com/adamwalker/sdr/issues/2
  , (PackageVersionConstraint
"shake-language-c", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- https://github.com/samplecount/shake-language-c/issues/26
  , (PackageVersionConstraint
"ssh", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False) -- test suite runs forever, probably can't deal with our lack of network access
  , (PackageVersionConstraint
"stack", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
stackOverrides forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)
  , (PackageVersionConstraint
"stripe-http-streams", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta Bool
broken) Bool
False)
  , (PackageVersionConstraint
"target", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"z3")) Bool
True)
  , (PackageVersionConstraint
"terminfo", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"ncurses")) Bool
True)
  , (PackageVersionConstraint
"text", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)         -- break infinite recursion
  , (PackageVersionConstraint
"tensorflow-proto", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"protobuf")) Bool
True)
  , (PackageVersionConstraint
"thyme", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
self Identifier
"cpphs")) Bool
True) -- required on Darwin
  , (PackageVersionConstraint
"twilio", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)         -- attempts to access the network
  , (PackageVersionConstraint
"tz", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
"preConfigure = \"export TZDIR=${pkgs.tzdata}/share/zoneinfo\";")
  , (PackageVersionConstraint
"udev", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"linux"))))
  , (PackageVersionConstraint
"websockets", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False)   -- https://github.com/jaspervdj/websockets/issues/104
  , (PackageVersionConstraint
"Win32", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"windows"))))
  , (PackageVersionConstraint
"Win32-shortcut", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"windows"))))
  , (PackageVersionConstraint
"wxc", Derivation -> Derivation
wxcHook)
  , (PackageVersionConstraint
"wxcore", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"wxGTK")) Bool
True)
  , (PackageVersionConstraint
"X11", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Binding
bind [String
"pkgs.xorg.libXinerama",String
"pkgs.xorg.libXext",String
"pkgs.xorg.libXrender",String
"pkgs.xorg.libXScrnSaver"])))
  , (PackageVersionConstraint
"xmonad >= 0.14.2", forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
xmonadPostInstall)
  , (PackageVersionConstraint
"zip-archive < 0.3.1", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
self Identifier
"zip") (Identifier -> Binding
pkg Identifier
"zip")))
  , (PackageVersionConstraint
"zip-archive >= 0.3.1 && < 0.3.2.3", forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool) (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [Identifier -> Binding
pkg Identifier
"zip", Identifier -> Binding
pkg Identifier
"unzip"])))   -- https://github.com/jgm/zip-archive/issues/35
  , (PackageVersionConstraint
"zip-archive >= 0.4", forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
testDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"which")) Bool
True)
  ]

pkg :: Identifier -> Binding
pkg :: Identifier -> Binding
pkg 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
"pkgs",Identifier
i])

self :: Identifier -> Binding
self :: Identifier -> Binding
self 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
"self",Identifier
i])

pkgs :: [Identifier] -> Set Binding
pkgs :: [Identifier] -> Set Binding
pkgs = forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Identifier -> Binding
pkg

bind :: String -> Binding
bind :: String -> Binding
bind String
s = 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]
is)
  where
    is :: [Identifier]
is = forall a b. (a -> b) -> [a] -> [b]
map (forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Iso' Identifier String
ident) (forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s)
    i :: Identifier
i = forall a. [a] -> a
last [Identifier]
is

-- | @replace old new bset@ replaces the Nix binding @old@ with @new@ in the
-- set of bindings @bset@. If @old@ is not found in @bset@, then the function
-- fails with an 'error'.
replace :: Binding -> Binding -> Set Binding -> Set Binding
replace :: Binding -> Binding -> Set Binding -> Set Binding
replace Binding
old Binding
new Set Binding
bs
  | Binding
old forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Binding
bs = forall a. Ord a => a -> Set a -> Set a
Set.insert Binding
new (forall a. Ord a => a -> Set a -> Set a
Set.delete Binding
old Set Binding
bs)
  | Bool
otherwise           = forall a. HasCallStack => String -> a
error ([String] -> String
unwords [ String
"post-process: cannot replace name binding"
                                         , forall a. Show a => a -> String
show Binding
old, String
"by", forall a. Show a => a -> String
show Binding
new
                                         , String
"because it's not found in set"
                                         , forall a. Show a => a -> String
show Set Binding
bs
                                         ])

gtk3Hook :: Derivation -> Derivation    -- https://github.com/NixOS/cabal2nix/issues/145
gtk3Hook :: Derivation -> Derivation
gtk3Hook = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"gtk3")) Bool
True
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig) (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Binding
b -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Binding Identifier
localName Binding
b forall a. Eq a => a -> a -> Bool
/= Identifier
"gtk3"))

haddockHook :: Derivation -> Derivation
haddockHook :: Derivation -> Derivation
haddockHook = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
doCheck Bool
False
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
"preCheck = \"unset GHC_PACKAGE_PATH\";"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Traversal' Derivation BuildInfo
dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
haskell) (forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\Binding
b -> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Binding Identifier
localName Binding
b forall a. Eq a => a -> a -> Bool
/= Identifier
"haddock-test"))
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta Bool
broken) Bool
False

gitAnnexHook :: Derivation -> Derivation
gitAnnexHook :: Derivation -> Derivation
gitAnnexHook = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
gitAnnexOverrides
             forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
executableDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (forall a. Ord a => Set a -> Set a -> Set a
Set.union Set Binding
buildInputs)
  where
    gitAnnexOverrides :: String
gitAnnexOverrides = [String] -> String
unlines
      [ String
"preConfigure = \"export HOME=$TEMPDIR; patchShebangs .\";"
      , String
"postBuild = ''"
      , String
"  ln -sf dist/build/git-annex/git-annex git-annex"
      , String
"  ln -sf git-annex git-annex-shell"
      , String
"'';"
      , String
"installPhase = \"make PREFIX=$out BUILDER=: install install-completions\";"
      , String
"checkPhase = ''PATH+=\":$PWD\" git-annex test'';"
      , String
"enableSharedExecutables = false;"
      ]
    buildInputs :: Set Binding
buildInputs = [Identifier] -> Set Binding
pkgs [Identifier
"git",Identifier
"rsync",Identifier
"gnupg",Identifier
"curl",Identifier
"wget",Identifier
"lsof",Identifier
"openssh",Identifier
"which",Identifier
"bup",Identifier
"perl"]

hfusePreConfigure :: String
hfusePreConfigure :: String
hfusePreConfigure = [String] -> String
unlines
  [ String
"preConfigure = ''"
  , String
"  sed -i -e \"s@  Extra-Lib-Dirs:         /usr/local/lib@  Extra-Lib-Dirs:         ${fuse}/lib@\" HFuse.cabal"
  , String
"'';"
  ]

gfPhaseOverrides :: String
gfPhaseOverrides :: String
gfPhaseOverrides = [String] -> String
unlines
  [ String
"postPatch = ''"
  , String
"  sed -i \"s|\\\"-s\\\"|\\\"\\\"|\" ./Setup.hs"
    -- Disable silent compilation. Compiling takes long, it is best to see some
    -- output, otherwise it looks like the build step has stalled.
  , String
"  sed -i \"s|numJobs (bf bi)++||\" ./Setup.hs"
    -- Parallel compilation fails. Disable it.
  , String
"'';"
  , String
"preBuild = ''export LD_LIBRARY_PATH=`pwd`/dist/build''${LD_LIBRARY_PATH:+:}$LD_LIBRARY_PATH'';"
    -- The build step itself, after having built the library, needs to be able
    -- to find the library it just built in order to compile grammar files.
  ]

wxcHook :: Derivation -> Derivation
wxcHook :: Derivation -> Derivation
wxcHook Derivation
drv = Derivation
drv forall a b. a -> (a -> b) -> b
& Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [Identifier -> Binding
pkg Identifier
"libGL", String -> Binding
bind String
"pkgs.xorg.libX11"])
                  forall a b. a -> (a -> b) -> b
& Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"wxGTK") forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
                  forall a b. a -> (a -> b) -> b
& Lens' Derivation String
phaseOverrides forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> String
wxcPostInstall (forall pkg. Package pkg => pkg -> Version
packageVersion Derivation
drv)
                  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
False
  where
    wxcPostInstall :: Version -> String
    wxcPostInstall :: Version -> String
wxcPostInstall Version
version = [String] -> String
unlines
      [ String
"postInstall = \"cp -v dist/build/libwxc.so." forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
display Version
version forall a. [a] -> [a] -> [a]
++ String
" $out/lib/libwxc.so\";"
      , String
"postPatch = \"sed -i -e '/ldconfig inst_lib_dir/d' Setup.hs\";"
      ]

cabalInstallPostInstall :: String
cabalInstallPostInstall :: String
cabalInstallPostInstall = [String] -> String
unlines
  [ String
"postInstall = ''"
  , String
"  mkdir -p $out/share/bash-completion"
  , String
"  mv bash-completion $out/share/bash-completion/completions"
  , String
"'';"
  ]

darcsInstallPostInstall :: String
darcsInstallPostInstall :: String
darcsInstallPostInstall = [String] -> String
unlines
  [ String
"postInstall = ''"
  , String
"  mkdir -p $out/share/bash-completion/completions"
  , String
"  mv contrib/darcs_completion $out/share/bash-completion/completions/darcs"
  , String
"'';"
  ]

xmonadPostInstall :: String
xmonadPostInstall :: String
xmonadPostInstall = [String] -> String
unlines
  [ String
"postInstall = ''"
  , String
"  install -D man/xmonad.1 ''${!outputDoc}/share/man/man1/xmonad.1"
  , String
"  install -D man/xmonad.hs ''${!outputDoc}/share/doc/$name/sample-xmonad.hs"
  , String
"'';"
  ]

agdaPostInstall :: String
agdaPostInstall :: String
agdaPostInstall = [String] -> String
unlines
  [ String
"postInstall = ''"
  , String
"  $out/bin/agda -c --no-main $(find $data/share -name Primitive.agda)"
  , String
"  $out/bin/agda-mode compile"
  , String
"'';"
  ]

agda25PostInstall :: String
agda25PostInstall :: String
agda25PostInstall = [String] -> String
unlines
  [ String
"postInstall = ''"
  , String
"  files=(\"$data/share/ghc-\"*\"/\"*\"-ghc-\"*\"/Agda-\"*\"/lib/prim/Agda/\"{Primitive.agda,Builtin\"/\"*.agda})"
  -- Separate loops to avoid internal error
  , String
"  for f in \"''${files[@]}\" ; do"
  , String
"    $out/bin/agda $f"
  , String
"  done"
  , String
"  for f in \"''${files[@]}\" ; do"
  , String
"    $out/bin/agda -c --no-main $f"
  , String
"  done"
  , String
"  $out/bin/agda-mode compile"
  , String
"'';"
  ]

stackOverrides :: String
stackOverrides :: String
stackOverrides = [String] -> String
unlines
  [ String
"preCheck = \"export HOME=$TMPDIR\";"
  , String
"postInstall = ''"
  , String
"  exe=$out/bin/stack"
  , String
"  mkdir -p $out/share/bash-completion/completions"
  , String
"  $exe --bash-completion-script $exe >$out/share/bash-completion/completions/stack"
  , String
"'';"
  ]

-- Replace a binding for <package> to one to pkgs.gst_all_1.<package>
giGstLibOverrides :: String -> Derivation -> Derivation
giGstLibOverrides :: String -> Derivation -> Derivation
giGstLibOverrides String
package
  = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
nullBinding (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
package)) (Iso' Binding (Identifier, Path)
binding forall t b. AReview t b -> b -> t
# (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
package, Iso' Path [Identifier]
path forall t b. AReview t b -> b -> t
# [Identifier
"pkgs",Identifier
"gst_all_1", Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
package])))

giCairoPhaseOverrides :: Derivation -> Derivation
giCairoPhaseOverrides :: Derivation -> Derivation
giCairoPhaseOverrides = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' Derivation String
phaseOverrides (forall a. [a] -> [a] -> [a]
++String
txt)
                      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"cairo")) Bool
True
  where
    txt :: String
txt = [String] -> String
unlines [ String
"preCompileBuildDriver = ''"
                  , String
"  PKG_CONFIG_PATH+=\":${cairo}/lib/pkgconfig\""
                  , String
"  setupCompileFlags+=\" $(pkg-config --libs cairo-gobject)\""
                  , String
"'';"
                  ]

hfseventsOverrides :: Derivation -> Derivation
hfseventsOverrides :: Derivation -> Derivation
hfseventsOverrides
  = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation Bool
isLibrary Bool
True
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
platforms) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton (Identifier -> NixpkgsPlatform
NixpkgsPlatformGroup (Iso' Identifier String
ident forall t b. AReview t b -> b -> t
# String
"darwin")))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
tool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (String -> Binding
bind String
"pkgs.darwin.apple_sdk.frameworks.CoreServices")) Bool
True
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains (String -> Binding
bind String
"pkgs.darwin.apple_sdk.frameworks.Cocoa")) Bool
True
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
haskell) (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map String -> Binding
bind [String
"self.base", String
"self.cereal", String
"self.mtl", String
"self.text", String
"self.bytestring"])))

opencvOverrides :: Derivation -> Derivation
opencvOverrides :: Derivation -> Derivation
opencvOverrides = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
"hardeningDisable = [ \"bindnow\" ];"
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
pkg Identifier
"opencv") (Identifier -> Binding
pkg Identifier
"opencv3"))

hspecCoreOverrides :: Derivation -> Derivation   -- https://github.com/hspec/hspec/issues/330
hspecCoreOverrides :: Derivation -> Derivation
hspecCoreOverrides = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
"testTarget = \"--test-option=--skip --test-option='Test.Hspec.Core.Runner.hspecResult runs specs in parallel'\";"

cabal2nixOverrides :: Derivation -> Derivation
cabal2nixOverrides :: Derivation -> Derivation
cabal2nixOverrides = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
  [ String
"preCheck = ''"
  , String
"  export PATH=\"$PWD/dist/build/cabal2nix:$PATH\""
  , String
"  export HOME=\"$TMPDIR/home\""
  , String
"'';"
  ]

gtkglextHook :: Derivation -> Derivation
gtkglextHook :: Derivation -> Derivation
gtkglextHook = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
system) (forall a. Ord a => Set a -> Set a -> Set a
Set.union (forall a. Ord a => [a] -> Set a
Set.fromList [Binding]
deps))
  where
    deps :: [Binding]
    deps :: [Binding]
deps = String -> Binding
bind forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ String
"pkgs.gtk2"
                    , String
"pkgs.libGLU"
                    , String
"pkgs.xorg.libSM"
                    , String
"pkgs.xorg.libICE"
                    , String
"pkgs.xorg.libXt"
                    , String
"pkgs.xorg.libXmu"
                    ]

pandocPre26Overrides :: Derivation -> Derivation
pandocPre26Overrides :: Derivation -> Derivation
pandocPre26Overrides = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
postInstall
  where
    postInstall :: String
postInstall = [String] -> String
unlines [ String
"postInstall = ''"
                          , String
"  mkdir -p $out/share"
                          , String
"  mv $data/*/*/man $out/share/"
                          , String
"'';"
                          ]

pandocOverrides :: Derivation -> Derivation
pandocOverrides :: Derivation -> Derivation
pandocOverrides = forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' Derivation String
phaseOverrides String
postInstall
  where
    postInstall :: String
postInstall = [String] -> String
unlines [ String
"postInstall = ''"
                          , String
"  mkdir -p $out/share/man/man1"
                          , String
"  mv \"man/\"*.1 $out/share/man/man1/"
                          , String
"'';"
                          ]

bustleOverrides :: Derivation -> Derivation
bustleOverrides :: Derivation -> Derivation
bustleOverrides = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
libraryDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains Binding
"system-glib = pkgs.glib") Bool
True
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation BuildInfo
executableDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildInfo (Set Binding)
pkgconfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Contains m => Index m -> Lens' m Bool
contains Binding
"gio-unix = null") Bool
False
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta License
license) (String -> License
Known String
"lib.licenses.lgpl21Plus")
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' Derivation Meta
metaSection forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Meta (Maybe (Set NixpkgsPlatform))
hydraPlatforms) forall a. Maybe a
Nothing

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