{-# 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.System
import Distribution.Text
import Distribution.Version
import Language.Nix

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

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

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

    buildDeps :: Map Identifier Path
    buildDeps :: Map Identifier Path
buildDeps = Identifier -> Map Identifier Path -> Map Identifier Path
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Identifier
myName (IndexedGetting Identifier (Map Identifier Path) Derivation Path
-> Derivation -> Map Identifier Path
forall i a s. IndexedGetting i (Map i a) s a -> s -> Map i a
toMapOf ((BuildInfo -> Const (Map Identifier Path) BuildInfo)
-> Derivation -> Const (Map Identifier Path) Derivation
Traversal' Derivation BuildInfo
dependencies ((BuildInfo -> Const (Map Identifier Path) BuildInfo)
 -> Derivation -> Const (Map Identifier Path) Derivation)
-> (Indexed Identifier Path (Const (Map Identifier Path) Path)
    -> BuildInfo -> Const (Map Identifier Path) BuildInfo)
-> IndexedGetting Identifier (Map Identifier Path) Derivation Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Const (Map Identifier Path) (Set Binding))
-> BuildInfo -> Const (Map Identifier Path) BuildInfo
Lens' BuildInfo (Set Binding)
haskell ((Set Binding -> Const (Map Identifier Path) (Set Binding))
 -> BuildInfo -> Const (Map Identifier Path) BuildInfo)
-> (Indexed Identifier Path (Const (Map Identifier Path) Path)
    -> Set Binding -> Const (Map Identifier Path) (Set Binding))
-> Indexed Identifier Path (Const (Map Identifier Path) Path)
-> BuildInfo
-> Const (Map Identifier Path) BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> [Binding])
-> Optic'
     (->) (Const (Map Identifier Path)) (Set Binding) [Binding]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Set Binding -> [Binding]
forall a. Set a -> [a]
Set.toList Optic' (->) (Const (Map Identifier Path)) (Set Binding) [Binding]
-> (Indexed Identifier Path (Const (Map Identifier Path) Path)
    -> [Binding] -> Const (Map Identifier Path) [Binding])
-> Indexed Identifier Path (Const (Map Identifier Path) Path)
-> Set Binding
-> Const (Map Identifier Path) (Set Binding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Binding -> Const (Map Identifier Path) Binding)
-> [Binding] -> Const (Map Identifier Path) [Binding]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Binding -> Const (Map Identifier Path) Binding)
 -> [Binding] -> Const (Map Identifier Path) [Binding])
-> (Indexed Identifier Path (Const (Map Identifier Path) Path)
    -> Binding -> Const (Map Identifier Path) Binding)
-> Indexed Identifier Path (Const (Map Identifier Path) Path)
-> [Binding]
-> Const (Map Identifier Path) [Binding]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Identifier, Path)
 -> Const (Map Identifier Path) (Identifier, Path))
-> Binding -> Const (Map Identifier Path) Binding
Iso' Binding (Identifier, Path)
binding (((Identifier, Path)
  -> Const (Map Identifier Path) (Identifier, Path))
 -> Binding -> Const (Map Identifier Path) Binding)
-> (Indexed Identifier Path (Const (Map Identifier Path) Path)
    -> (Identifier, Path)
    -> Const (Map Identifier Path) (Identifier, Path))
-> Indexed Identifier Path (Const (Map Identifier Path) Path)
-> Binding
-> Const (Map Identifier Path) Binding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indexed Identifier Path (Const (Map Identifier Path) Path)
-> (Identifier, Path)
-> Const (Map Identifier Path) (Identifier, Path)
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 = ((Derivation -> Derivation)
 -> (Derivation -> Derivation) -> Derivation -> Derivation)
-> (Derivation -> Derivation)
-> [Derivation -> Derivation]
-> Derivation
-> Derivation
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Derivation -> Derivation
forall a. a -> a
id
  [ (((), Derivation) -> Derivation)
-> (Derivation -> ((), Derivation)) -> Derivation -> Derivation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((), Derivation) -> Derivation
forall a b. (a, b) -> b
snd ((Derivation -> ((), Derivation)) -> Derivation -> Derivation)
-> (Derivation -> ((), Derivation)) -> Derivation -> Derivation
forall a b. (a -> b) -> a -> b
$ State Derivation () -> Derivation -> ((), Derivation)
forall s a. State s a -> s -> (a, s)
runState (State Derivation () -> Derivation -> ((), Derivation))
-> State Derivation () -> Derivation -> ((), Derivation)
forall a b. (a -> b) -> a -> b
$ do
      Bool
needs <- Getting Bool Derivation Bool -> StateT Derivation Identity Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool Derivation Bool -> StateT Derivation Identity Bool)
-> Getting Bool Derivation Bool -> StateT Derivation Identity Bool
forall a b. (a -> b) -> a -> b
$ ALens Derivation Derivation BuildInfo BuildInfo
-> Lens Derivation Derivation BuildInfo BuildInfo
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens Derivation Derivation BuildInfo BuildInfo
c ((BuildInfo -> Const Bool BuildInfo)
 -> Derivation -> Const Bool Derivation)
-> ((Bool -> Const Bool Bool) -> BuildInfo -> Const Bool BuildInfo)
-> Getting Bool Derivation Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Const Bool (Set Binding))
-> BuildInfo -> Const Bool BuildInfo
Lens' BuildInfo (Set Binding)
haskell ((Set Binding -> Const Bool (Set Binding))
 -> BuildInfo -> Const Bool BuildInfo)
-> ((Bool -> Const Bool Bool)
    -> Set Binding -> Const Bool (Set Binding))
-> (Bool -> Const Bool Bool)
-> BuildInfo
-> Const Bool BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Binding
Index (Set Binding)
p
      ALens Derivation Derivation BuildInfo BuildInfo
-> Lens Derivation Derivation BuildInfo BuildInfo
forall s t a b. ALens s t a b -> Lens s t a b
cloneLens ALens Derivation Derivation BuildInfo BuildInfo
c ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> (Bool -> Identity Bool)
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
tool ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Binding
Index (Set Binding)
p ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> State Derivation ()
forall s (m :: * -> *).
MonadState s m =>
ASetter' s Bool -> Bool -> m ()
||= Bool
needs
  | (ALens Derivation Derivation BuildInfo BuildInfo
c :: ALens' Derivation BuildInfo) <- [ ALens Derivation Derivation BuildInfo BuildInfo
Lens Derivation Derivation BuildInfo BuildInfo
testDepends, ALens Derivation Derivation BuildInfo BuildInfo
Lens Derivation Derivation BuildInfo BuildInfo
benchmarkDepends ]
  , Binding
p <- Identifier -> Binding
self (Identifier -> Binding) -> [Identifier] -> [Binding]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Identifier
"hspec-discover"
                  , Identifier
"tasty-discover"
                  , Identifier
"hsx2hs"
                  , Identifier
"markdown-unlit"
                  ]
  ]

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

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

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

bind :: String -> Binding
bind :: String -> Binding
bind String
s = Tagged (Identifier, Path) (Identity (Identifier, Path))
-> Tagged Binding (Identity Binding)
Iso' Binding (Identifier, Path)
binding (Tagged (Identifier, Path) (Identity (Identifier, Path))
 -> Tagged Binding (Identity Binding))
-> (Identifier, Path) -> Binding
forall t b. AReview t b -> b -> t
# (Identifier
i, Tagged [Identifier] (Identity [Identifier])
-> Tagged Path (Identity Path)
Iso' Path [Identifier]
path (Tagged [Identifier] (Identity [Identifier])
 -> Tagged Path (Identity Path))
-> [Identifier] -> Path
forall t b. AReview t b -> b -> t
# [Identifier]
is)
  where
    is :: [Identifier]
is = (String -> Identifier) -> [String] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map ((Tagged String (Identity String)
 -> Tagged Identifier (Identity Identifier))
-> String -> Identifier
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review Tagged String (Identity String)
-> Tagged Identifier (Identity Identifier)
Iso' Identifier String
ident) (String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s)
    i :: Identifier
i = [Identifier] -> Identifier
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 Binding -> Set Binding -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Binding
bs = Binding -> Set Binding -> Set Binding
forall a. Ord a => a -> Set a -> Set a
Set.insert Binding
new (Binding -> Set Binding -> Set Binding
forall a. Ord a => a -> Set a -> Set a
Set.delete Binding
old Set Binding
bs)
  | Bool
otherwise           = String -> Set Binding
forall a. HasCallStack => String -> a
error ([String] -> String
unwords [ String
"post-process: cannot replace name binding"
                                         , Binding -> String
forall a. Show a => a -> String
show Binding
old, String
"by", Binding -> String
forall a. Show a => a -> String
show Binding
new
                                         , String
"because it's not found in set"
                                         , Set Binding -> String
forall a. Show a => a -> String
show Set Binding
bs
                                         ])

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

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

gitAnnexHook :: Derivation -> Derivation
gitAnnexHook :: Derivation -> Derivation
gitAnnexHook = ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Derivation Derivation String String
Lens' Derivation String
phaseOverrides String
gitAnnexOverrides
             (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set Binding -> Identity (Set Binding))
 -> Derivation -> Identity Derivation)
-> (Set Binding -> Set Binding) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
executableDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Set Binding -> Identity (Set Binding))
    -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Identity (Set Binding))
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
system) (Set Binding -> Set Binding -> Set Binding
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 Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& (BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Set Binding -> Identity (Set Binding))
    -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Identity (Set Binding))
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
system ((Set Binding -> Identity (Set Binding))
 -> Derivation -> Identity Derivation)
-> (Set Binding -> Set Binding) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Set Binding -> Set Binding -> Set Binding
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Binding] -> Set Binding
forall a. Ord a => [a] -> Set a
Set.fromList [Identifier -> Binding
pkg Identifier
"libGL", String -> Binding
bind String
"pkgs.xorg.libX11"])
                  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& (BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> (Bool -> Identity Bool)
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
pkgconfig ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains (Identifier -> Binding
pkg Identifier
"wxGTK") ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
                  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& ASetter Derivation Derivation String String
Lens' Derivation String
phaseOverrides ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Version -> String
wxcPostInstall (Derivation -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion Derivation
drv)
                  Derivation -> (Derivation -> Derivation) -> Derivation
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Derivation -> Identity Derivation
Lens' Derivation Bool
runHaddock ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
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." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
display Version
version String -> String -> String
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 $out/etc"
  , String
"  mv bash-completion $out/etc/bash_completion.d"
  , String
"'';"
  ]

darcsInstallPostInstall :: String
darcsInstallPostInstall :: String
darcsInstallPostInstall = [String] -> String
unlines
  [ String
"postInstall = ''"
  , String
"  mkdir -p $out/etc/bash_completion.d"
  , String
"  mv contrib/darcs_completion $out/etc/bash_completion.d/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
  = ((Set Binding -> Identity (Set Binding))
 -> Derivation -> Identity Derivation)
-> (Set Binding -> Set Binding) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Set Binding -> Identity (Set Binding))
    -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Identity (Set Binding))
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
pkgconfig) (Binding -> Binding -> Set Binding -> Set Binding
replace (Identifier -> Binding
pkg (Tagged String (Identity String)
-> Tagged Identifier (Identity Identifier)
Iso' Identifier String
ident (Tagged String (Identity String)
 -> Tagged Identifier (Identity Identifier))
-> String -> Identifier
forall t b. AReview t b -> b -> t
# String
package)) (Tagged (Identifier, Path) (Identity (Identifier, Path))
-> Tagged Binding (Identity Binding)
Iso' Binding (Identifier, Path)
binding (Tagged (Identifier, Path) (Identity (Identifier, Path))
 -> Tagged Binding (Identity Binding))
-> (Identifier, Path) -> Binding
forall t b. AReview t b -> b -> t
# (Tagged String (Identity String)
-> Tagged Identifier (Identity Identifier)
Iso' Identifier String
ident (Tagged String (Identity String)
 -> Tagged Identifier (Identity Identifier))
-> String -> Identifier
forall t b. AReview t b -> b -> t
# String
package, Tagged [Identifier] (Identity [Identifier])
-> Tagged Path (Identity Path)
Iso' Path [Identifier]
path (Tagged [Identifier] (Identity [Identifier])
 -> Tagged Path (Identity Path))
-> [Identifier] -> Path
forall t b. AReview t b -> b -> t
# [Identifier
"pkgs",Identifier
"gst_all_1", Tagged String (Identity String)
-> Tagged Identifier (Identity Identifier)
Iso' Identifier String
ident (Tagged String (Identity String)
 -> Tagged Identifier (Identity Identifier))
-> String -> Identifier
forall t b. AReview t b -> b -> t
# String
package])))

giCairoPhaseOverrides :: Derivation -> Derivation
giCairoPhaseOverrides :: Derivation -> Derivation
giCairoPhaseOverrides = ASetter Derivation Derivation String String
-> (String -> String) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Derivation Derivation String String
Lens' Derivation String
phaseOverrides (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
txt)
                      (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> (Bool -> Identity Bool)
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
pkgconfig ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
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
  = ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set (Bool -> Identity Bool) -> Derivation -> Identity Derivation
Lens' Derivation Bool
isLibrary Bool
True
  (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Derivation Derivation (Set Platform) (Set Platform)
-> (Set Platform -> Set Platform) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Meta -> Identity Meta) -> Derivation -> Identity Derivation
Lens' Derivation Meta
metaSection ((Meta -> Identity Meta) -> Derivation -> Identity Derivation)
-> ((Set Platform -> Identity (Set Platform))
    -> Meta -> Identity Meta)
-> ASetter Derivation Derivation (Set Platform) (Set Platform)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Platform -> Identity (Set Platform)) -> Meta -> Identity Meta
Lens' Meta (Set Platform)
platforms) ((Platform -> Bool) -> Set Platform -> Set Platform
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\(Platform Arch
_ OS
os) -> OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSX))
  (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> (Bool -> Identity Bool)
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
tool ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains (String -> Binding
bind String
"pkgs.darwin.apple_sdk.frameworks.CoreServices")) Bool
True
  (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> (Bool -> Identity Bool)
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
system ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains (String -> Binding
bind String
"pkgs.darwin.apple_sdk.frameworks.Cocoa")) Bool
True
  (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set Binding -> Identity (Set Binding))
 -> Derivation -> Identity Derivation)
-> (Set Binding -> Set Binding) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Set Binding -> Identity (Set Binding))
    -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Identity (Set Binding))
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
haskell) (Set Binding -> Set Binding -> Set Binding
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Binding] -> Set Binding
forall a. Ord a => [a] -> Set a
Set.fromList ((String -> Binding) -> [String] -> [Binding]
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"])))

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

opencvOverrides :: Derivation -> Derivation
opencvOverrides :: Derivation -> Derivation
opencvOverrides = ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Derivation Derivation String String
Lens' Derivation String
phaseOverrides String
"hardeningDisable = [ \"bindnow\" ];"
                (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set Binding -> Identity (Set Binding))
 -> Derivation -> Identity Derivation)
-> (Set Binding -> Set Binding) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Set Binding -> Identity (Set Binding))
    -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Identity (Set Binding))
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
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 = ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Derivation Derivation String String
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 = ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Derivation Derivation String String
Lens' Derivation String
phaseOverrides (String -> Derivation -> Derivation)
-> String -> Derivation -> Derivation
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 = ((Set Binding -> Identity (Set Binding))
 -> Derivation -> Identity Derivation)
-> (Set Binding -> Set Binding) -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Set Binding -> Identity (Set Binding))
    -> BuildInfo -> Identity BuildInfo)
-> (Set Binding -> Identity (Set Binding))
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
system) (Set Binding -> Set Binding -> Set Binding
forall a. Ord a => Set a -> Set a -> Set a
Set.union ([Binding] -> Set Binding
forall a. Ord a => [a] -> Set a
Set.fromList [Binding]
deps))
  where
    deps :: [Binding]
    deps :: [Binding]
deps = String -> Binding
bind (String -> Binding) -> [String] -> [Binding]
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 = ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Derivation Derivation String String
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 = ASetter Derivation Derivation String String
-> String -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Derivation Derivation String String
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 = ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
libraryDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> (Bool -> Identity Bool)
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
pkgconfig ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index (Set Binding)
"system-glib = pkgs.glib") Bool
True
                (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Bool -> Identity Bool) -> Derivation -> Identity Derivation)
-> Bool -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((BuildInfo -> Identity BuildInfo)
-> Derivation -> Identity Derivation
Lens Derivation Derivation BuildInfo BuildInfo
executableDepends ((BuildInfo -> Identity BuildInfo)
 -> Derivation -> Identity Derivation)
-> ((Bool -> Identity Bool) -> BuildInfo -> Identity BuildInfo)
-> (Bool -> Identity Bool)
-> Derivation
-> Identity Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Binding -> Identity (Set Binding))
-> BuildInfo -> Identity BuildInfo
Lens' BuildInfo (Set Binding)
pkgconfig ((Set Binding -> Identity (Set Binding))
 -> BuildInfo -> Identity BuildInfo)
-> ((Bool -> Identity Bool)
    -> Set Binding -> Identity (Set Binding))
-> (Bool -> Identity Bool)
-> BuildInfo
-> Identity BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Set Binding) -> Lens' (Set Binding) Bool
forall m. Contains m => Index m -> Lens' m Bool
contains Index (Set Binding)
"gio-unix = null") Bool
False
                (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Derivation Derivation License License
-> License -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Meta -> Identity Meta) -> Derivation -> Identity Derivation
Lens' Derivation Meta
metaSection ((Meta -> Identity Meta) -> Derivation -> Identity Derivation)
-> ((License -> Identity License) -> Meta -> Identity Meta)
-> ASetter Derivation Derivation License License
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (License -> Identity License) -> Meta -> Identity Meta
Lens' Meta License
license) (String -> License
Known String
"stdenv.lib.licenses.lgpl21Plus")
                (Derivation -> Derivation)
-> (Derivation -> Derivation) -> Derivation -> Derivation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter Derivation Derivation (Set Platform) (Set Platform)
-> Set Platform -> Derivation -> Derivation
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Meta -> Identity Meta) -> Derivation -> Identity Derivation
Lens' Derivation Meta
metaSection ((Meta -> Identity Meta) -> Derivation -> Identity Derivation)
-> ((Set Platform -> Identity (Set Platform))
    -> Meta -> Identity Meta)
-> ASetter Derivation Derivation (Set Platform) (Set Platform)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Platform -> Identity (Set Platform)) -> Meta -> Identity Meta
Lens' Meta (Set Platform)
hydraPlatforms) Set Platform
allKnownPlatforms