{-# LANGUAGE NoImplicitPrelude        #-}
{-# LANGUAGE ConstraintKinds          #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE OverloadedRecordDot      #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE ScopedTypeVariables      #-}

-- | All utility functions for Components in Stack (library, internal library,

-- foreign library, executable, tests, benchmarks). In particular, this module

-- gathers all the Cabal-to-Stack component translations, which previously

-- occurred in the "Stack.Package" module. See "Stack.Types.Component" for more

-- details about the design choices.


module Stack.Component
  ( isComponentBuildable
  , stackLibraryFromCabal
  , stackExecutableFromCabal
  , stackForeignLibraryFromCabal
  , stackBenchmarkFromCabal
  , stackTestFromCabal
  , foldOnNameAndBuildInfo
  , stackUnqualToQual
  , componentDependencyMap
  , fromCabalName
  ) where

import qualified Data.Map as Map
import qualified Data.Set as Set
import           Data.Text ( pack )
import           Distribution.PackageDescription
                   ( Benchmark (..), Executable, ForeignLib, Library (..)
                   , TestSuite (..)
                   )
import           Distribution.Types.BuildInfo ( BuildInfo )
import           Distribution.Package ( mkPackageName )
import qualified Distribution.PackageDescription as Cabal
import           GHC.Records ( HasField )
import           Stack.Prelude
import           Stack.Types.Component
                   ( HasBuildInfo, StackBenchmark (..), StackBuildInfo (..)
                   , StackExecutable (..), StackForeignLibrary (..)
                   , StackLibrary (..), StackTestSuite (..)
                   , StackUnqualCompName (..)
                   )
import           Stack.Types.ComponentUtils ( fromCabalName )
import           Stack.Types.Dependency ( cabalExeToStackDep, cabalToStackDep )
import           Stack.Types.NamedComponent ( NamedComponent )

stackUnqualToQual ::
     (Text -> NamedComponent)
  -> StackUnqualCompName
  -> NamedComponent
stackUnqualToQual :: (Text -> NamedComponent) -> StackUnqualCompName -> NamedComponent
stackUnqualToQual Text -> NamedComponent
c (StackUnqualCompName Text
n) = Text -> NamedComponent
c Text
n

foldOnNameAndBuildInfo ::
     ( HasField "buildInfo" a StackBuildInfo
     , HasField "name" a StackUnqualCompName
     , Foldable c
     )
  => c a
  -> (StackUnqualCompName -> StackBuildInfo -> t -> t)
  -> t
  -> t
foldOnNameAndBuildInfo :: forall a (c :: * -> *) t.
(HasField "buildInfo" a StackBuildInfo,
 HasField "name" a StackUnqualCompName, Foldable c) =>
c a -> (StackUnqualCompName -> StackBuildInfo -> t -> t) -> t -> t
foldOnNameAndBuildInfo c a
initialCollection StackUnqualCompName -> StackBuildInfo -> t -> t
accumulator t
input =
  (a -> t -> t) -> t -> c a -> t
forall a b. (a -> b -> b) -> b -> c a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' a -> t -> t
iterator t
input c a
initialCollection
 where
  iterator :: a -> t -> t
iterator a
comp = StackUnqualCompName -> StackBuildInfo -> t -> t
accumulator a
comp.name a
comp.buildInfo

stackLibraryFromCabal :: Library -> StackLibrary
stackLibraryFromCabal :: Library -> StackLibrary
stackLibraryFromCabal Library
cabalLib = StackLibrary
  { $sel:name:StackLibrary :: StackUnqualCompName
name = case Library
cabalLib.libName of
      LibraryName
LMainLibName -> Text -> StackUnqualCompName
StackUnqualCompName Text
forall a. Monoid a => a
mempty
      LSubLibName UnqualComponentName
v -> UnqualComponentName -> StackUnqualCompName
fromCabalName UnqualComponentName
v
  , $sel:buildInfo:StackLibrary :: StackBuildInfo
buildInfo = BuildInfo -> StackBuildInfo
stackBuildInfoFromCabal Library
cabalLib.libBuildInfo
  , $sel:exposedModules:StackLibrary :: [ModuleName]
exposedModules = Library
cabalLib.exposedModules
  }

stackExecutableFromCabal :: Executable -> StackExecutable
stackExecutableFromCabal :: Executable -> StackExecutable
stackExecutableFromCabal Executable
cabalExecutable = StackExecutable
  { $sel:name:StackExecutable :: StackUnqualCompName
name = UnqualComponentName -> StackUnqualCompName
fromCabalName Executable
cabalExecutable.exeName
  , $sel:buildInfo:StackExecutable :: StackBuildInfo
buildInfo = BuildInfo -> StackBuildInfo
stackBuildInfoFromCabal Executable
cabalExecutable.buildInfo
  , $sel:modulePath:StackExecutable :: String
modulePath = Executable
cabalExecutable.modulePath
  }

stackForeignLibraryFromCabal :: ForeignLib -> StackForeignLibrary
stackForeignLibraryFromCabal :: ForeignLib -> StackForeignLibrary
stackForeignLibraryFromCabal ForeignLib
cabalForeignLib = StackForeignLibrary
  { $sel:name:StackForeignLibrary :: StackUnqualCompName
name = UnqualComponentName -> StackUnqualCompName
fromCabalName ForeignLib
cabalForeignLib.foreignLibName
  , $sel:buildInfo:StackForeignLibrary :: StackBuildInfo
buildInfo=BuildInfo -> StackBuildInfo
stackBuildInfoFromCabal ForeignLib
cabalForeignLib.foreignLibBuildInfo
  }

stackBenchmarkFromCabal :: Benchmark -> StackBenchmark
stackBenchmarkFromCabal :: Benchmark -> StackBenchmark
stackBenchmarkFromCabal Benchmark
cabalBenchmark = StackBenchmark
  { $sel:name:StackBenchmark :: StackUnqualCompName
name = UnqualComponentName -> StackUnqualCompName
fromCabalName Benchmark
cabalBenchmark.benchmarkName
  , $sel:interface:StackBenchmark :: BenchmarkInterface
interface = Benchmark
cabalBenchmark.benchmarkInterface
  , $sel:buildInfo:StackBenchmark :: StackBuildInfo
buildInfo = BuildInfo -> StackBuildInfo
stackBuildInfoFromCabal Benchmark
cabalBenchmark.benchmarkBuildInfo
  }

stackTestFromCabal :: TestSuite -> StackTestSuite
stackTestFromCabal :: TestSuite -> StackTestSuite
stackTestFromCabal TestSuite
cabalTest = StackTestSuite
  { $sel:name:StackTestSuite :: StackUnqualCompName
name = UnqualComponentName -> StackUnqualCompName
fromCabalName TestSuite
cabalTest.testName
  , $sel:interface:StackTestSuite :: TestSuiteInterface
interface = TestSuite
cabalTest.testInterface
  , $sel:buildInfo:StackTestSuite :: StackBuildInfo
buildInfo = BuildInfo -> StackBuildInfo
stackBuildInfoFromCabal TestSuite
cabalTest.testBuildInfo
  }

isComponentBuildable :: HasBuildInfo component => component -> Bool
isComponentBuildable :: forall component. HasBuildInfo component => component -> Bool
isComponentBuildable component
componentRec = component
componentRec.buildInfo.buildable

stackBuildInfoFromCabal :: BuildInfo -> StackBuildInfo
stackBuildInfoFromCabal :: BuildInfo -> StackBuildInfo
stackBuildInfoFromCabal BuildInfo
buildInfoV = [LegacyExeDependency]
-> [ExeDependency]
-> [Dependency]
-> StackBuildInfo
-> StackBuildInfo
gatherComponentToolsAndDepsFromCabal
  BuildInfo
buildInfoV.buildTools
  BuildInfo
buildInfoV.buildToolDepends
  BuildInfo
buildInfoV.targetBuildDepends
  StackBuildInfo
    { $sel:buildable:StackBuildInfo :: Bool
buildable = BuildInfo
buildInfoV.buildable
    , $sel:otherModules:StackBuildInfo :: [ModuleName]
otherModules = BuildInfo
buildInfoV.otherModules
    , $sel:jsSources:StackBuildInfo :: [String]
jsSources = BuildInfo
buildInfoV.jsSources
    , $sel:hsSourceDirs:StackBuildInfo :: [SymbolicPath PackageDir SourceDir]
hsSourceDirs = BuildInfo
buildInfoV.hsSourceDirs
    , $sel:cSources:StackBuildInfo :: [String]
cSources = BuildInfo
buildInfoV.cSources
    , $sel:dependency:StackBuildInfo :: Map PackageName DepValue
dependency = Map PackageName DepValue
forall a. Monoid a => a
mempty
    , $sel:unknownTools:StackBuildInfo :: Set Text
unknownTools = Set Text
forall a. Monoid a => a
mempty
    , $sel:cppOptions:StackBuildInfo :: [String]
cppOptions = BuildInfo
buildInfoV.cppOptions
    , $sel:targetBuildDepends:StackBuildInfo :: [Dependency]
targetBuildDepends = BuildInfo
buildInfoV.targetBuildDepends
    , $sel:options:StackBuildInfo :: PerCompilerFlavor [String]
options = BuildInfo
buildInfoV.options
    , $sel:allLanguages:StackBuildInfo :: [Language]
allLanguages = BuildInfo -> [Language]
Cabal.allLanguages BuildInfo
buildInfoV
    , $sel:usedExtensions:StackBuildInfo :: [Extension]
usedExtensions = BuildInfo -> [Extension]
Cabal.usedExtensions BuildInfo
buildInfoV
    , $sel:includeDirs:StackBuildInfo :: [String]
includeDirs = BuildInfo
buildInfoV.includeDirs
    , $sel:extraLibs:StackBuildInfo :: [String]
extraLibs = BuildInfo
buildInfoV.extraLibs
    , $sel:extraLibDirs:StackBuildInfo :: [String]
extraLibDirs = BuildInfo
buildInfoV.extraLibDirs
    , $sel:frameworks:StackBuildInfo :: [String]
frameworks = BuildInfo
buildInfoV.frameworks
    }

-- | Iterate on all three dependency list given, and transform and sort them

-- between 'sbiUnknownTools' and legitimate 'DepValue' sbiDependency. Bear in

-- mind that this only gathers the component level dependencies.

gatherComponentToolsAndDepsFromCabal
  :: [Cabal.LegacyExeDependency]
     -- ^ Legacy build tools dependency from

     -- 'Distribution.Types.BuildInfo.buildTools'.

  -> [Cabal.ExeDependency]
     -- ^ Build tools dependency from

     -- `Distribution.Types.BuildInfo.buildToolDepends'.

  -> [Cabal.Dependency]
     -- ^ Cabal-syntax defines

     -- 'Distribution.Types.BuildInfo.targetBuildDepends'. These are the

     -- simplest dependencies for a component extracted from the Cabal file such

     -- as:

     -- @

     --  build-depends:

     --      foo ^>= 1.2.3.4,

     --      bar ^>= 1

     -- @

  -> StackBuildInfo
  -> StackBuildInfo
gatherComponentToolsAndDepsFromCabal :: [LegacyExeDependency]
-> [ExeDependency]
-> [Dependency]
-> StackBuildInfo
-> StackBuildInfo
gatherComponentToolsAndDepsFromCabal [LegacyExeDependency]
legacyBuildTools [ExeDependency]
buildTools [Dependency]
targetDeps =
  StackBuildInfo -> StackBuildInfo
gatherTargetDependency (StackBuildInfo -> StackBuildInfo)
-> (StackBuildInfo -> StackBuildInfo)
-> StackBuildInfo
-> StackBuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackBuildInfo -> StackBuildInfo
gatherToolsDependency (StackBuildInfo -> StackBuildInfo)
-> (StackBuildInfo -> StackBuildInfo)
-> StackBuildInfo
-> StackBuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackBuildInfo -> StackBuildInfo
gatherUnknownTools
 where
  gatherUnknownTools :: StackBuildInfo -> StackBuildInfo
gatherUnknownTools StackBuildInfo
sbi = (StackBuildInfo -> LegacyExeDependency -> StackBuildInfo)
-> StackBuildInfo -> [LegacyExeDependency] -> StackBuildInfo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StackBuildInfo -> LegacyExeDependency -> StackBuildInfo
processLegacyExeDepency StackBuildInfo
sbi [LegacyExeDependency]
legacyBuildTools
  gatherToolsDependency :: StackBuildInfo -> StackBuildInfo
gatherToolsDependency StackBuildInfo
sbi = (StackBuildInfo -> ExeDependency -> StackBuildInfo)
-> StackBuildInfo -> [ExeDependency] -> StackBuildInfo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StackBuildInfo -> ExeDependency -> StackBuildInfo
processExeDependency StackBuildInfo
sbi [ExeDependency]
buildTools
  gatherTargetDependency :: StackBuildInfo -> StackBuildInfo
gatherTargetDependency StackBuildInfo
sbi = (StackBuildInfo -> Dependency -> StackBuildInfo)
-> StackBuildInfo -> [Dependency] -> StackBuildInfo
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' StackBuildInfo -> Dependency -> StackBuildInfo
processDependency StackBuildInfo
sbi [Dependency]
targetDeps
  -- This is similar to Cabal's

  -- 'Distribution.Simple.BuildToolDepends.desugarBuildTool', however it uses

  -- our own hard-coded map which drops tools shipped with GHC (like hsc2hs),

  -- and includes some tools from Stackage.

  processLegacyExeDepency :: StackBuildInfo -> LegacyExeDependency -> StackBuildInfo
processLegacyExeDepency StackBuildInfo
sbi (Cabal.LegacyExeDependency String
exeName VersionRange
range) =
    case String -> Maybe PackageName
isKnownLegacyExe String
exeName of
      Just PackageName
pName ->
        StackBuildInfo -> ExeDependency -> StackBuildInfo
processExeDependency
          StackBuildInfo
sbi
          (PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
Cabal.ExeDependency PackageName
pName (String -> UnqualComponentName
Cabal.mkUnqualComponentName String
exeName) VersionRange
range)
      Maybe PackageName
Nothing -> StackBuildInfo
sbi
        { unknownTools = Set.insert (pack exeName) sbi.unknownTools }
  processExeDependency :: StackBuildInfo -> ExeDependency -> StackBuildInfo
processExeDependency StackBuildInfo
sbi exeDep :: ExeDependency
exeDep@(Cabal.ExeDependency PackageName
pName UnqualComponentName
_ VersionRange
_)
    | PackageName -> Bool
isPreInstalledPackages PackageName
pName = StackBuildInfo
sbi
    | Bool
otherwise = StackBuildInfo
sbi
        { dependency =
            Map.insert pName (cabalExeToStackDep exeDep) sbi.dependency
        }
  processDependency :: StackBuildInfo -> Dependency -> StackBuildInfo
processDependency StackBuildInfo
sbi dep :: Dependency
dep@(Cabal.Dependency PackageName
pName VersionRange
_ NonEmptySet LibraryName
_) = StackBuildInfo
sbi
    { dependency = Map.insert pName (cabalToStackDep dep) sbi.dependency }

componentDependencyMap ::
     (HasField "buildInfo" r1 r2, HasField "dependency" r2 a)
  => r1
  -> a
componentDependencyMap :: forall r1 r2 a.
(HasField "buildInfo" r1 r2, HasField "dependency" r2 a) =>
r1 -> a
componentDependencyMap r1
component = r1
component.buildInfo.dependency

-- | A hard-coded map for tool dependencies. If a dependency is within this map

-- it's considered "known" (the exe will be found at the execution stage). The

-- corresponding Cabal function is

-- 'Distribution.Simple.BuildToolDepends.desugarBuildTool'.

isKnownLegacyExe :: String -> Maybe PackageName
isKnownLegacyExe :: String -> Maybe PackageName
isKnownLegacyExe String
input = case String
input of
  String
"alex" -> String -> Maybe PackageName
justPck String
"alex"
  String
"happy" -> String -> Maybe PackageName
justPck String
"happy"
  String
"cpphs" -> String -> Maybe PackageName
justPck String
"cpphs"
  String
"greencard" -> String -> Maybe PackageName
justPck String
"greencard"
  String
"c2hs" -> String -> Maybe PackageName
justPck String
"c2hs"
  String
"hscolour" -> String -> Maybe PackageName
justPck String
"hscolour"
  String
"hspec-discover" -> String -> Maybe PackageName
justPck String
"hspec-discover"
  String
"hsx2hs" -> String -> Maybe PackageName
justPck String
"hsx2hs"
  String
"gtk2hsC2hs" -> String -> Maybe PackageName
justPck String
"gtk2hs-buildtools"
  String
"gtk2hsHookGenerator" -> String -> Maybe PackageName
justPck String
"gtk2hs-buildtools"
  String
"gtk2hsTypeGen" -> String -> Maybe PackageName
justPck String
"gtk2hs-buildtools"
  String
_ -> Maybe PackageName
forall a. Maybe a
Nothing
 where
  justPck :: String -> Maybe PackageName
justPck = PackageName -> Maybe PackageName
forall a. a -> Maybe a
Just (PackageName -> Maybe PackageName)
-> (String -> PackageName) -> String -> Maybe PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageName
mkPackageName

-- | Executable-only packages which come pre-installed with GHC and do not need

-- to be built. Without this exception, we would either end up unnecessarily

-- rebuilding these packages, or failing because the packages do not appear in

-- the Stackage snapshot.

isPreInstalledPackages :: PackageName -> Bool
isPreInstalledPackages :: PackageName -> Bool
isPreInstalledPackages PackageName
input = case PackageName
input of
  PackageName
"hsc2hs" -> Bool
True
  PackageName
"haddock" -> Bool
True
  PackageName
_ -> Bool
False