{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

module Distribution.Nixpkgs.Haskell.Derivation
  ( Derivation, nullDerivation, pkgid, revision, src, subpath, isLibrary, isExecutable
  , extraFunctionArgs, libraryDepends, executableDepends, testDepends, configureFlags
  , cabalFlags, runHaddock, jailbreak, doCheck, doBenchmark, testTarget, hyperlinkSource, enableSplitObjs
  , enableLibraryProfiling, enableExecutableProfiling, phaseOverrides, editedCabalFile, metaSection
  , dependencies, setupDepends, benchmarkDepends, enableSeparateDataOutput, extraAttributes
  )
  where

import Prelude hiding ((<>))

import Control.DeepSeq
import Control.Lens
import Data.List ( isPrefixOf )
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Set ( Set )
import qualified Data.Set as Set
import Data.Set.Lens
import Distribution.Nixpkgs.Fetch
import Distribution.Nixpkgs.Haskell.BuildInfo
import Distribution.Nixpkgs.Haskell.OrphanInstances ( )
import Distribution.Nixpkgs.Meta
import Distribution.Package
import Distribution.PackageDescription ( FlagAssignment, unFlagName, unFlagAssignment )
import GHC.Generics ( Generic )
import Language.Nix
import Language.Nix.PrettyPrinting

-- | A represtation of Nix expressions for building Haskell packages.
-- The data type correspond closely to the definition of
-- 'PackageDescription' from Cabal.

data Derivation = MkDerivation
  { Derivation -> PackageIdentifier
_pkgid                      :: PackageIdentifier
  , Derivation -> Int
_revision                   :: Int
  , Derivation -> DerivationSource
_src                        :: DerivationSource
  , Derivation -> FilePath
_subpath                    :: FilePath
  , Derivation -> Bool
_isLibrary                  :: Bool
  , Derivation -> Bool
_isExecutable               :: Bool
  , Derivation -> Set Binding
_extraFunctionArgs          :: Set Binding
  , Derivation -> Map FilePath FilePath
_extraAttributes            :: Map String String
  , Derivation -> BuildInfo
_setupDepends               :: BuildInfo
  , Derivation -> BuildInfo
_libraryDepends             :: BuildInfo
  , Derivation -> BuildInfo
_executableDepends          :: BuildInfo
  , Derivation -> BuildInfo
_testDepends                :: BuildInfo
  , Derivation -> BuildInfo
_benchmarkDepends           :: BuildInfo
  , Derivation -> Set FilePath
_configureFlags             :: Set String
  , Derivation -> FlagAssignment
_cabalFlags                 :: FlagAssignment
  , Derivation -> Bool
_runHaddock                 :: Bool
  , Derivation -> Bool
_jailbreak                  :: Bool
  , Derivation -> Bool
_doCheck                    :: Bool
  , Derivation -> Bool
_doBenchmark                :: Bool
  , Derivation -> FilePath
_testTarget                 :: String
  , Derivation -> Bool
_hyperlinkSource            :: Bool
  , Derivation -> Bool
_enableLibraryProfiling     :: Bool
  , Derivation -> Bool
_enableExecutableProfiling  :: Bool
  , Derivation -> Bool
_enableSplitObjs            :: Bool
  , Derivation -> FilePath
_phaseOverrides             :: String
  , Derivation -> FilePath
_editedCabalFile            :: String
  , Derivation -> Bool
_enableSeparateDataOutput   :: Bool
  , Derivation -> Meta
_metaSection                :: Meta
  }
  deriving (Int -> Derivation -> ShowS
[Derivation] -> ShowS
Derivation -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Derivation] -> ShowS
$cshowList :: [Derivation] -> ShowS
show :: Derivation -> FilePath
$cshow :: Derivation -> FilePath
showsPrec :: Int -> Derivation -> ShowS
$cshowsPrec :: Int -> Derivation -> ShowS
Show, forall x. Rep Derivation x -> Derivation
forall x. Derivation -> Rep Derivation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Derivation x -> Derivation
$cfrom :: forall x. Derivation -> Rep Derivation x
Generic)

nullDerivation :: Derivation
nullDerivation :: Derivation
nullDerivation = MkDerivation
  { _pkgid :: PackageIdentifier
_pkgid = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.pkgid"
  , _revision :: Int
_revision = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.revision"
  , _src :: DerivationSource
_src = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.src"
  , _subpath :: FilePath
_subpath = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.subpath"
  , _isLibrary :: Bool
_isLibrary = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.isLibrary"
  , _isExecutable :: Bool
_isExecutable = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.isExecutable"
  , _extraFunctionArgs :: Set Binding
_extraFunctionArgs = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.extraFunctionArgs"
  , _extraAttributes :: Map FilePath FilePath
_extraAttributes = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.extraAttributes"
  , _setupDepends :: BuildInfo
_setupDepends = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.setupDepends"
  , _libraryDepends :: BuildInfo
_libraryDepends = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.libraryDepends"
  , _executableDepends :: BuildInfo
_executableDepends = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.executableDepends"
  , _testDepends :: BuildInfo
_testDepends = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.testDepends"
  , _benchmarkDepends :: BuildInfo
_benchmarkDepends = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.benchmarkDepends"
  , _configureFlags :: Set FilePath
_configureFlags = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.configureFlags"
  , _cabalFlags :: FlagAssignment
_cabalFlags = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.cabalFlags"
  , _runHaddock :: Bool
_runHaddock = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.runHaddock"
  , _jailbreak :: Bool
_jailbreak = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.jailbreak"
  , _doCheck :: Bool
_doCheck = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.doCheck"
  , _doBenchmark :: Bool
_doBenchmark = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.doBenchmark"
  , _testTarget :: FilePath
_testTarget = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.testTarget"
  , _hyperlinkSource :: Bool
_hyperlinkSource = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.hyperlinkSource"
  , _enableLibraryProfiling :: Bool
_enableLibraryProfiling = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.enableLibraryProfiling"
  , _enableExecutableProfiling :: Bool
_enableExecutableProfiling = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.enableExecutableProfiling"
  , _enableSplitObjs :: Bool
_enableSplitObjs = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.enableSplitObjs"
  , _phaseOverrides :: FilePath
_phaseOverrides = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.phaseOverrides"
  , _editedCabalFile :: FilePath
_editedCabalFile = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.editedCabalFile"
  , _enableSeparateDataOutput :: Bool
_enableSeparateDataOutput = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.enableSeparateDataOutput"
  , _metaSection :: Meta
_metaSection = forall a. HasCallStack => FilePath -> a
error FilePath
"undefined Derivation.metaSection"
  }

makeLenses ''Derivation

makeLensesFor [("_setupDepends", "dependencies"), ("_libraryDepends", "dependencies"), ("_executableDepends", "dependencies"), ("_testDepends", "dependencies"), ("_benchmarkDepends", "dependencies")] ''Derivation

instance Package Derivation where
  packageId :: Derivation -> PackageIdentifier
packageId = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Derivation PackageIdentifier
pkgid

instance NFData Derivation

instance Pretty Derivation where
  pPrint :: Derivation -> Doc
pPrint drv :: Derivation
drv@MkDerivation {Bool
Int
FilePath
PackageIdentifier
FlagAssignment
Set FilePath
Set Binding
Map FilePath FilePath
Meta
DerivationSource
BuildInfo
_metaSection :: Meta
_enableSeparateDataOutput :: Bool
_editedCabalFile :: FilePath
_phaseOverrides :: FilePath
_enableSplitObjs :: Bool
_enableExecutableProfiling :: Bool
_enableLibraryProfiling :: Bool
_hyperlinkSource :: Bool
_testTarget :: FilePath
_doBenchmark :: Bool
_doCheck :: Bool
_jailbreak :: Bool
_runHaddock :: Bool
_cabalFlags :: FlagAssignment
_configureFlags :: Set FilePath
_benchmarkDepends :: BuildInfo
_testDepends :: BuildInfo
_executableDepends :: BuildInfo
_libraryDepends :: BuildInfo
_setupDepends :: BuildInfo
_extraAttributes :: Map FilePath FilePath
_extraFunctionArgs :: Set Binding
_isExecutable :: Bool
_isLibrary :: Bool
_subpath :: FilePath
_src :: DerivationSource
_revision :: Int
_pkgid :: PackageIdentifier
_metaSection :: Derivation -> Meta
_enableSeparateDataOutput :: Derivation -> Bool
_editedCabalFile :: Derivation -> FilePath
_phaseOverrides :: Derivation -> FilePath
_enableSplitObjs :: Derivation -> Bool
_enableExecutableProfiling :: Derivation -> Bool
_enableLibraryProfiling :: Derivation -> Bool
_hyperlinkSource :: Derivation -> Bool
_testTarget :: Derivation -> FilePath
_doBenchmark :: Derivation -> Bool
_doCheck :: Derivation -> Bool
_jailbreak :: Derivation -> Bool
_runHaddock :: Derivation -> Bool
_cabalFlags :: Derivation -> FlagAssignment
_configureFlags :: Derivation -> Set FilePath
_benchmarkDepends :: Derivation -> BuildInfo
_testDepends :: Derivation -> BuildInfo
_executableDepends :: Derivation -> BuildInfo
_libraryDepends :: Derivation -> BuildInfo
_setupDepends :: Derivation -> BuildInfo
_extraAttributes :: Derivation -> Map FilePath FilePath
_extraFunctionArgs :: Derivation -> Set Binding
_isExecutable :: Derivation -> Bool
_isLibrary :: Derivation -> Bool
_subpath :: Derivation -> FilePath
_src :: Derivation -> DerivationSource
_revision :: Derivation -> Int
_pkgid :: Derivation -> PackageIdentifier
..} = [Doc] -> Doc
funargs (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
text (FilePath
"mkDerivation" forall a. a -> [a] -> [a]
: Set FilePath -> [FilePath]
toAscList Set FilePath
inputs)) Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat
    [ FilePath -> Doc
text FilePath
"mkDerivation" Doc -> Doc -> Doc
<+> Doc
lbrace
    , Int -> Doc -> Doc
nest Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
      [ FilePath -> Doc -> Doc
attr FilePath
"pname"   forall a b. (a -> b) -> a -> b
$ Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pPrint (forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
_pkgid)
      , FilePath -> Doc -> Doc
attr FilePath
"version" forall a b. (a -> b) -> a -> b
$ Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> Doc
pPrint (forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
_pkgid)
      , forall a. Pretty a => a -> Doc
pPrint DerivationSource
_src
      , Bool -> Doc -> Doc
onlyIf (FilePath
_subpath forall a. Eq a => a -> a -> Bool
/= FilePath
".") forall a b. (a -> b) -> a -> b
$ FilePath -> Doc -> Doc
attr FilePath
"postUnpack" Doc
postUnpack
      , Bool -> Doc -> Doc
onlyIf (Int
_revision forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ FilePath -> Doc -> Doc
attr FilePath
"revision" forall a b. (a -> b) -> a -> b
$ Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ Int -> Doc
int Int
_revision
      , Bool -> Doc -> Doc
onlyIf (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
_editedCabalFile) Bool -> Bool -> Bool
&& Int
_revision forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ FilePath -> Doc -> Doc
attr FilePath
"editedCabalFile" forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
string FilePath
_editedCabalFile
      , FilePath -> Doc -> [FilePath] -> Doc
listattr FilePath
"configureFlags" Doc
empty (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Show a => a -> FilePath
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show) [Doc]
renderedFlags)
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"isLibrary" (Bool -> Bool
not Bool
_isLibrary Bool -> Bool -> Bool
|| Bool
_isExecutable) Bool
_isLibrary
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"isExecutable" (Bool -> Bool
not Bool
_isLibrary Bool -> Bool -> Bool
|| Bool
_isExecutable) Bool
_isExecutable
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"enableSeparateDataOutput" Bool
_enableSeparateDataOutput Bool
_enableSeparateDataOutput
      , Bool -> Doc -> Doc
onlyIf (BuildInfo
_setupDepends forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ FilePath -> BuildInfo -> Doc
pPrintBuildInfo FilePath
"setup" BuildInfo
_setupDepends
      , Bool -> Doc -> Doc
onlyIf (BuildInfo
_libraryDepends forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ FilePath -> BuildInfo -> Doc
pPrintBuildInfo FilePath
"library" BuildInfo
_libraryDepends
      , Bool -> Doc -> Doc
onlyIf (BuildInfo
_executableDepends forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ FilePath -> BuildInfo -> Doc
pPrintBuildInfo FilePath
"executable" BuildInfo
_executableDepends
      , Bool -> Doc -> Doc
onlyIf (BuildInfo
_testDepends forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ FilePath -> BuildInfo -> Doc
pPrintBuildInfo FilePath
"test" BuildInfo
_testDepends
      , Bool -> Doc -> Doc
onlyIf (BuildInfo
_benchmarkDepends forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ FilePath -> BuildInfo -> Doc
pPrintBuildInfo FilePath
"benchmark" BuildInfo
_benchmarkDepends
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"enableLibraryProfiling" Bool
_enableLibraryProfiling Bool
_enableLibraryProfiling
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"enableExecutableProfiling" Bool
_enableExecutableProfiling Bool
_enableExecutableProfiling
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"enableSplitObjs"  (Bool -> Bool
not Bool
_enableSplitObjs) Bool
_enableSplitObjs
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"doHaddock" (Bool -> Bool
not Bool
_runHaddock) Bool
_runHaddock
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"jailbreak" Bool
_jailbreak Bool
_jailbreak
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"doCheck" (Bool -> Bool
not Bool
_doCheck) Bool
_doCheck
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"doBenchmark" Bool
_doBenchmark Bool
_doBenchmark
      , Bool -> Doc -> Doc
onlyIf (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
_testTarget)) forall a b. (a -> b) -> a -> b
$ FilePath -> Doc -> Doc
attr FilePath
"testTarget" forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
string FilePath
_testTarget
      , FilePath -> Bool -> Bool -> Doc
boolattr FilePath
"hyperlinkSource" (Bool -> Bool
not Bool
_hyperlinkSource) Bool
_hyperlinkSource
      , Bool -> Doc -> Doc
onlyIf (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
_phaseOverrides)) forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ((forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines) FilePath
_phaseOverrides)
      , forall a. Pretty a => a -> Doc
pPrint Meta
_metaSection
      , [Doc] -> Doc
vcat [ FilePath -> Doc -> Doc
attr FilePath
k (FilePath -> Doc
text FilePath
v) | (FilePath
k,FilePath
v) <- forall k a. Map k a -> [(k, a)]
Map.toList Map FilePath FilePath
_extraAttributes ]
      ]
    , Doc
rbrace
    ]
    where
      inputs :: Set String
      inputs :: Set FilePath
inputs = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' Binding Identifier
localName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' Identifier FilePath
ident)) Set Binding
_extraFunctionArgs
                          , forall a s. Getting (Set a) s a -> s -> Set a
setOf (Traversal' Derivation BuildInfo
dependencies forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Each s t a b => Traversal s t a b
each forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Binding Identifier
localName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Iso' Identifier FilePath
ident) Derivation
drv
                          , case DerivationSource -> Maybe DerivKind
derivKind DerivationSource
_src of
                              Maybe DerivKind
Nothing -> forall a. Monoid a => a
mempty
                              Just DerivKind
derivKind' -> forall a. Ord a => [a] -> Set a
Set.fromList [DerivKind -> FilePath
derivKindFunction DerivKind
derivKind' | Bool -> Bool
not Bool
isHackagePackage]
                          ]

      renderedFlags :: [Doc]
renderedFlags = [ FilePath -> Doc
text FilePath
"-f" Doc -> Doc -> Doc
<> (if Bool
enable then Doc
empty else Char -> Doc
char Char
'-') Doc -> Doc -> Doc
<> FilePath -> Doc
text (FlagName -> FilePath
unFlagName FlagName
f) | (FlagName
f, Bool
enable) <- FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment FlagAssignment
_cabalFlags ]
                      forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
text (Set FilePath -> [FilePath]
toAscList Set FilePath
_configureFlags)
      isHackagePackage :: Bool
isHackagePackage = FilePath
"mirror://hackage/" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` DerivationSource -> FilePath
derivUrl DerivationSource
_src

      postUnpack :: Doc
postUnpack = FilePath -> Doc
string forall a b. (a -> b) -> a -> b
$ FilePath
"sourceRoot+=/" forall a. [a] -> [a] -> [a]
++ FilePath
_subpath forall a. [a] -> [a] -> [a]
++ FilePath
"; echo source root reset to $sourceRoot"