{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE NoFieldSelectors    #-}
{-# LANGUAGE OverloadedRecordDot #-}

module Stack.Types.Dependency
  ( DepValue (..)
  , DepType (..)
  , DepLibrary (..)
  , cabalToStackDep
  , cabalExeToStackDep
  , cabalSetupDepsToStackDep
  , libraryDepFromVersionRange
  , isDepTypeLibrary
  , getDepSublib
  ) where

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Distribution.PackageDescription as Cabal
import           Distribution.Types.VersionRange ( VersionRange )
import           Stack.Prelude
import           Stack.Types.ComponentUtils
                   ( StackUnqualCompName (..), fromCabalName )

-- | The value for a map from dependency name. This contains both the version

-- range and the type of dependency.

data DepValue = DepValue
  { DepValue -> VersionRange
versionRange :: !VersionRange
  , DepValue -> DepType
depType :: !DepType
  }
  deriving (Int -> DepValue -> ShowS
[DepValue] -> ShowS
DepValue -> String
(Int -> DepValue -> ShowS)
-> (DepValue -> String) -> ([DepValue] -> ShowS) -> Show DepValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepValue -> ShowS
showsPrec :: Int -> DepValue -> ShowS
$cshow :: DepValue -> String
show :: DepValue -> String
$cshowList :: [DepValue] -> ShowS
showList :: [DepValue] -> ShowS
Show, Typeable)

-- | Is this package being used as a library, or just as a build tool? If the

-- former, we need to ensure that a library actually exists. See

-- <https://github.com/commercialhaskell/stack/issues/2195>

data DepType
  = AsLibrary !DepLibrary
  | AsBuildTool
  deriving (DepType -> DepType -> Bool
(DepType -> DepType -> Bool)
-> (DepType -> DepType -> Bool) -> Eq DepType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepType -> DepType -> Bool
== :: DepType -> DepType -> Bool
$c/= :: DepType -> DepType -> Bool
/= :: DepType -> DepType -> Bool
Eq, Int -> DepType -> ShowS
[DepType] -> ShowS
DepType -> String
(Int -> DepType -> ShowS)
-> (DepType -> String) -> ([DepType] -> ShowS) -> Show DepType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepType -> ShowS
showsPrec :: Int -> DepType -> ShowS
$cshow :: DepType -> String
show :: DepType -> String
$cshowList :: [DepType] -> ShowS
showList :: [DepType] -> ShowS
Show)

data DepLibrary = DepLibrary
  { DepLibrary -> Bool
main :: !Bool
  , DepLibrary -> Set StackUnqualCompName
subLib :: Set StackUnqualCompName
  }
  deriving (DepLibrary -> DepLibrary -> Bool
(DepLibrary -> DepLibrary -> Bool)
-> (DepLibrary -> DepLibrary -> Bool) -> Eq DepLibrary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepLibrary -> DepLibrary -> Bool
== :: DepLibrary -> DepLibrary -> Bool
$c/= :: DepLibrary -> DepLibrary -> Bool
/= :: DepLibrary -> DepLibrary -> Bool
Eq, Int -> DepLibrary -> ShowS
[DepLibrary] -> ShowS
DepLibrary -> String
(Int -> DepLibrary -> ShowS)
-> (DepLibrary -> String)
-> ([DepLibrary] -> ShowS)
-> Show DepLibrary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepLibrary -> ShowS
showsPrec :: Int -> DepLibrary -> ShowS
$cshow :: DepLibrary -> String
show :: DepLibrary -> String
$cshowList :: [DepLibrary] -> ShowS
showList :: [DepLibrary] -> ShowS
Show)

getDepSublib :: DepValue -> Maybe (Set StackUnqualCompName)
getDepSublib :: DepValue -> Maybe (Set StackUnqualCompName)
getDepSublib DepValue
val = case DepValue
val.depType of
  AsLibrary DepLibrary
libVal -> Set StackUnqualCompName -> Maybe (Set StackUnqualCompName)
forall a. a -> Maybe a
Just DepLibrary
libVal.subLib
  DepType
_ -> Maybe (Set StackUnqualCompName)
forall a. Maybe a
Nothing

defaultDepLibrary :: DepLibrary
defaultDepLibrary :: DepLibrary
defaultDepLibrary = Bool -> Set StackUnqualCompName -> DepLibrary
DepLibrary Bool
True Set StackUnqualCompName
forall a. Monoid a => a
mempty

isDepTypeLibrary :: DepType -> Bool
isDepTypeLibrary :: DepType -> Bool
isDepTypeLibrary AsLibrary{} = Bool
True
isDepTypeLibrary DepType
AsBuildTool = Bool
False

cabalToStackDep :: Cabal.Dependency -> DepValue
cabalToStackDep :: Dependency -> DepValue
cabalToStackDep (Cabal.Dependency PackageName
_ VersionRange
verRange NonEmptySet LibraryName
libNameSet) =
  DepValue { $sel:versionRange:DepValue :: VersionRange
versionRange = VersionRange
verRange, $sel:depType:DepValue :: DepType
depType = DepLibrary -> DepType
AsLibrary DepLibrary
depLibrary }
 where
  depLibrary :: DepLibrary
depLibrary = Bool -> Set StackUnqualCompName -> DepLibrary
DepLibrary Bool
finalHasMain Set StackUnqualCompName
filteredItems
  (Bool
finalHasMain, Set StackUnqualCompName
filteredItems) = (LibraryName
 -> (Bool, Set StackUnqualCompName)
 -> (Bool, Set StackUnqualCompName))
-> (Bool, Set StackUnqualCompName)
-> NonEmptySet LibraryName
-> (Bool, Set StackUnqualCompName)
forall a b. (a -> b -> b) -> b -> NonEmptySet a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' LibraryName
-> (Bool, Set StackUnqualCompName)
-> (Bool, Set StackUnqualCompName)
iterator (Bool
False, Set StackUnqualCompName
forall a. Monoid a => a
mempty) NonEmptySet LibraryName
libNameSet
  iterator :: LibraryName
-> (Bool, Set StackUnqualCompName)
-> (Bool, Set StackUnqualCompName)
iterator LibraryName
LMainLibName (Bool
_, Set StackUnqualCompName
newLibNameSet) = (Bool
True, Set StackUnqualCompName
newLibNameSet)
  iterator (LSubLibName UnqualComponentName
libName) (Bool
hasMain, Set StackUnqualCompName
newLibNameSet) =
    (Bool
hasMain, StackUnqualCompName
-> Set StackUnqualCompName -> Set StackUnqualCompName
forall a. Ord a => a -> Set a -> Set a
Set.insert (UnqualComponentName -> StackUnqualCompName
fromCabalName UnqualComponentName
libName) Set StackUnqualCompName
newLibNameSet)

cabalExeToStackDep :: Cabal.ExeDependency -> DepValue
cabalExeToStackDep :: ExeDependency -> DepValue
cabalExeToStackDep (Cabal.ExeDependency PackageName
_ UnqualComponentName
_name VersionRange
verRange) =
  DepValue { $sel:versionRange:DepValue :: VersionRange
versionRange = VersionRange
verRange, $sel:depType:DepValue :: DepType
depType = DepType
AsBuildTool }

cabalSetupDepsToStackDep :: Cabal.SetupBuildInfo -> Map PackageName DepValue
cabalSetupDepsToStackDep :: SetupBuildInfo -> Map PackageName DepValue
cabalSetupDepsToStackDep SetupBuildInfo
setupInfo =
  (Dependency
 -> Map PackageName DepValue -> Map PackageName DepValue)
-> Map PackageName DepValue
-> [Dependency]
-> Map PackageName DepValue
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Dependency -> Map PackageName DepValue -> Map PackageName DepValue
inserter Map PackageName DepValue
forall a. Monoid a => a
mempty (SetupBuildInfo -> [Dependency]
Cabal.setupDepends SetupBuildInfo
setupInfo)
 where
  inserter :: Dependency -> Map PackageName DepValue -> Map PackageName DepValue
inserter d :: Dependency
d@(Cabal.Dependency PackageName
packageName VersionRange
_ NonEmptySet LibraryName
_) =
    PackageName
-> DepValue -> Map PackageName DepValue -> Map PackageName DepValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PackageName
packageName (Dependency -> DepValue
cabalToStackDep Dependency
d)

libraryDepFromVersionRange :: VersionRange -> DepValue
libraryDepFromVersionRange :: VersionRange -> DepValue
libraryDepFromVersionRange VersionRange
range = DepValue
  { $sel:versionRange:DepValue :: VersionRange
versionRange = VersionRange
range
  , $sel:depType:DepValue :: DepType
depType = DepLibrary -> DepType
AsLibrary DepLibrary
defaultDepLibrary
  }