{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Module exporting the 'NamedComponent' type and related functions.

module Stack.Types.NamedComponent
  ( NamedComponent (..)
  , componentCachePath
  , renderComponent
  , renderComponentTo
  , renderPkgComponents
  , renderPkgComponent
  , exeComponents
  , testComponents
  , benchComponents
  , subLibComponents
  , isCLib
  , isCSubLib
  , isCExe
  , isCTest
  , isCBench
  , isPotentialDependency
  , splitComponents
  ) where

import qualified Data.Set as Set
import qualified Data.Text as T
import           Stack.Prelude
import           Stack.Types.ComponentUtils
                   ( StackUnqualCompName, unqualCompToString, unqualCompToText
                   )

-- | Type representing components of a fully-resolved Cabal package.

data NamedComponent
  = CLib
    -- The \'main\' unnamed library component.

  | CSubLib !StackUnqualCompName
    -- A named \'subsidiary\' or \'ancillary\` library component (sub-library).

  | CFlib !StackUnqualCompName
    -- A foreign library.

  | CExe !StackUnqualCompName
    -- A named executable component.

  | CTest !StackUnqualCompName
    -- A named test-suite component.

  | CBench !StackUnqualCompName
    -- A named benchmark component.

  deriving (NamedComponent -> NamedComponent -> Bool
(NamedComponent -> NamedComponent -> Bool)
-> (NamedComponent -> NamedComponent -> Bool) -> Eq NamedComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamedComponent -> NamedComponent -> Bool
== :: NamedComponent -> NamedComponent -> Bool
$c/= :: NamedComponent -> NamedComponent -> Bool
/= :: NamedComponent -> NamedComponent -> Bool
Eq, Eq NamedComponent
Eq NamedComponent =>
(NamedComponent -> NamedComponent -> Ordering)
-> (NamedComponent -> NamedComponent -> Bool)
-> (NamedComponent -> NamedComponent -> Bool)
-> (NamedComponent -> NamedComponent -> Bool)
-> (NamedComponent -> NamedComponent -> Bool)
-> (NamedComponent -> NamedComponent -> NamedComponent)
-> (NamedComponent -> NamedComponent -> NamedComponent)
-> Ord NamedComponent
NamedComponent -> NamedComponent -> Bool
NamedComponent -> NamedComponent -> Ordering
NamedComponent -> NamedComponent -> NamedComponent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NamedComponent -> NamedComponent -> Ordering
compare :: NamedComponent -> NamedComponent -> Ordering
$c< :: NamedComponent -> NamedComponent -> Bool
< :: NamedComponent -> NamedComponent -> Bool
$c<= :: NamedComponent -> NamedComponent -> Bool
<= :: NamedComponent -> NamedComponent -> Bool
$c> :: NamedComponent -> NamedComponent -> Bool
> :: NamedComponent -> NamedComponent -> Bool
$c>= :: NamedComponent -> NamedComponent -> Bool
>= :: NamedComponent -> NamedComponent -> Bool
$cmax :: NamedComponent -> NamedComponent -> NamedComponent
max :: NamedComponent -> NamedComponent -> NamedComponent
$cmin :: NamedComponent -> NamedComponent -> NamedComponent
min :: NamedComponent -> NamedComponent -> NamedComponent
Ord, Int -> NamedComponent -> ShowS
[NamedComponent] -> ShowS
NamedComponent -> String
(Int -> NamedComponent -> ShowS)
-> (NamedComponent -> String)
-> ([NamedComponent] -> ShowS)
-> Show NamedComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedComponent -> ShowS
showsPrec :: Int -> NamedComponent -> ShowS
$cshow :: NamedComponent -> String
show :: NamedComponent -> String
$cshowList :: [NamedComponent] -> ShowS
showList :: [NamedComponent] -> ShowS
Show)

-- | Render a component to anything with an "IsString" instance. For 'Text'

-- prefer 'renderComponent'.

renderComponentTo :: IsString a => NamedComponent -> a
renderComponentTo :: forall a. IsString a => NamedComponent -> a
renderComponentTo = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (NamedComponent -> String) -> NamedComponent -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> (NamedComponent -> Text) -> NamedComponent -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedComponent -> Text
renderComponent

renderComponent :: NamedComponent -> Text
renderComponent :: NamedComponent -> Text
renderComponent NamedComponent
CLib = Text
"lib"
renderComponent (CSubLib StackUnqualCompName
x) = Text
"sub-lib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> Text
unqualCompToText StackUnqualCompName
x
renderComponent (CFlib StackUnqualCompName
x) = Text
"flib:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> Text
unqualCompToText StackUnqualCompName
x
renderComponent (CExe StackUnqualCompName
x) = Text
"exe:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> Text
unqualCompToText StackUnqualCompName
x
renderComponent (CTest StackUnqualCompName
x) = Text
"test:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> Text
unqualCompToText StackUnqualCompName
x
renderComponent (CBench StackUnqualCompName
x) = Text
"bench:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> Text
unqualCompToText StackUnqualCompName
x

componentCachePath :: NamedComponent -> String
componentCachePath :: NamedComponent -> String
componentCachePath NamedComponent
CLib = String
"lib"
componentCachePath (CSubLib StackUnqualCompName
x) = String
"sub-lib-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> String
unqualCompToString StackUnqualCompName
x
componentCachePath (CFlib StackUnqualCompName
x) = String
"flib-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> String
unqualCompToString StackUnqualCompName
x
componentCachePath (CExe StackUnqualCompName
x) = String
"exe-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> String
unqualCompToString StackUnqualCompName
x
componentCachePath (CTest StackUnqualCompName
x) = String
"test-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> String
unqualCompToString StackUnqualCompName
x
componentCachePath (CBench StackUnqualCompName
x) = String
"bench-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StackUnqualCompName -> String
unqualCompToString StackUnqualCompName
x

renderPkgComponents :: [(PackageName, NamedComponent)] -> Text
renderPkgComponents :: [(PackageName, NamedComponent)] -> Text
renderPkgComponents = Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text)
-> ([(PackageName, NamedComponent)] -> [Text])
-> [(PackageName, NamedComponent)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PackageName, NamedComponent) -> Text)
-> [(PackageName, NamedComponent)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName, NamedComponent) -> Text
renderPkgComponent

renderPkgComponent :: (PackageName, NamedComponent) -> Text
renderPkgComponent :: (PackageName, NamedComponent) -> Text
renderPkgComponent (PackageName
pkg, NamedComponent
comp) =
  PackageName -> Text
forall a. IsString a => PackageName -> a
fromPackageName PackageName
pkg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NamedComponent -> Text
renderComponent NamedComponent
comp

exeComponents :: Set NamedComponent -> Set StackUnqualCompName
exeComponents :: Set NamedComponent -> Set StackUnqualCompName
exeComponents = [StackUnqualCompName] -> Set StackUnqualCompName
forall a. Ord a => [a] -> Set a
Set.fromList ([StackUnqualCompName] -> Set StackUnqualCompName)
-> (Set NamedComponent -> [StackUnqualCompName])
-> Set NamedComponent
-> Set StackUnqualCompName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedComponent -> Maybe StackUnqualCompName)
-> [NamedComponent] -> [StackUnqualCompName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NamedComponent -> Maybe StackUnqualCompName
mExeName ([NamedComponent] -> [StackUnqualCompName])
-> (Set NamedComponent -> [NamedComponent])
-> Set NamedComponent
-> [StackUnqualCompName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList
 where
  mExeName :: NamedComponent -> Maybe StackUnqualCompName
mExeName (CExe StackUnqualCompName
name) = StackUnqualCompName -> Maybe StackUnqualCompName
forall a. a -> Maybe a
Just StackUnqualCompName
name
  mExeName NamedComponent
_ = Maybe StackUnqualCompName
forall a. Maybe a
Nothing

testComponents :: Set NamedComponent -> Set StackUnqualCompName
testComponents :: Set NamedComponent -> Set StackUnqualCompName
testComponents = [StackUnqualCompName] -> Set StackUnqualCompName
forall a. Ord a => [a] -> Set a
Set.fromList ([StackUnqualCompName] -> Set StackUnqualCompName)
-> (Set NamedComponent -> [StackUnqualCompName])
-> Set NamedComponent
-> Set StackUnqualCompName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedComponent -> Maybe StackUnqualCompName)
-> [NamedComponent] -> [StackUnqualCompName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NamedComponent -> Maybe StackUnqualCompName
mTestName ([NamedComponent] -> [StackUnqualCompName])
-> (Set NamedComponent -> [NamedComponent])
-> Set NamedComponent
-> [StackUnqualCompName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList
 where
  mTestName :: NamedComponent -> Maybe StackUnqualCompName
mTestName (CTest StackUnqualCompName
name) = StackUnqualCompName -> Maybe StackUnqualCompName
forall a. a -> Maybe a
Just StackUnqualCompName
name
  mTestName NamedComponent
_ = Maybe StackUnqualCompName
forall a. Maybe a
Nothing

benchComponents :: Set NamedComponent -> Set StackUnqualCompName
benchComponents :: Set NamedComponent -> Set StackUnqualCompName
benchComponents = [StackUnqualCompName] -> Set StackUnqualCompName
forall a. Ord a => [a] -> Set a
Set.fromList ([StackUnqualCompName] -> Set StackUnqualCompName)
-> (Set NamedComponent -> [StackUnqualCompName])
-> Set NamedComponent
-> Set StackUnqualCompName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedComponent -> Maybe StackUnqualCompName)
-> [NamedComponent] -> [StackUnqualCompName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NamedComponent -> Maybe StackUnqualCompName
mBenchName ([NamedComponent] -> [StackUnqualCompName])
-> (Set NamedComponent -> [NamedComponent])
-> Set NamedComponent
-> [StackUnqualCompName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList
 where
  mBenchName :: NamedComponent -> Maybe StackUnqualCompName
mBenchName (CBench StackUnqualCompName
name) = StackUnqualCompName -> Maybe StackUnqualCompName
forall a. a -> Maybe a
Just StackUnqualCompName
name
  mBenchName NamedComponent
_ = Maybe StackUnqualCompName
forall a. Maybe a
Nothing

subLibComponents :: Set NamedComponent -> Set StackUnqualCompName
subLibComponents :: Set NamedComponent -> Set StackUnqualCompName
subLibComponents = [StackUnqualCompName] -> Set StackUnqualCompName
forall a. Ord a => [a] -> Set a
Set.fromList ([StackUnqualCompName] -> Set StackUnqualCompName)
-> (Set NamedComponent -> [StackUnqualCompName])
-> Set NamedComponent
-> Set StackUnqualCompName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedComponent -> Maybe StackUnqualCompName)
-> [NamedComponent] -> [StackUnqualCompName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe NamedComponent -> Maybe StackUnqualCompName
mSubLibName ([NamedComponent] -> [StackUnqualCompName])
-> (Set NamedComponent -> [NamedComponent])
-> Set NamedComponent
-> [StackUnqualCompName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList
 where
  mSubLibName :: NamedComponent -> Maybe StackUnqualCompName
mSubLibName (CSubLib StackUnqualCompName
name) = StackUnqualCompName -> Maybe StackUnqualCompName
forall a. a -> Maybe a
Just StackUnqualCompName
name
  mSubLibName NamedComponent
_ = Maybe StackUnqualCompName
forall a. Maybe a
Nothing

isCLib :: NamedComponent -> Bool
isCLib :: NamedComponent -> Bool
isCLib CLib{} = Bool
True
isCLib NamedComponent
_ = Bool
False

isCSubLib :: NamedComponent -> Bool
isCSubLib :: NamedComponent -> Bool
isCSubLib CSubLib{} = Bool
True
isCSubLib NamedComponent
_ = Bool
False

isCExe :: NamedComponent -> Bool
isCExe :: NamedComponent -> Bool
isCExe CExe{} = Bool
True
isCExe NamedComponent
_ = Bool
False

isCTest :: NamedComponent -> Bool
isCTest :: NamedComponent -> Bool
isCTest CTest{} = Bool
True
isCTest NamedComponent
_ = Bool
False

isCBench :: NamedComponent -> Bool
isCBench :: NamedComponent -> Bool
isCBench CBench{} = Bool
True
isCBench NamedComponent
_ = Bool
False

isPotentialDependency :: NamedComponent -> Bool
isPotentialDependency :: NamedComponent -> Bool
isPotentialDependency NamedComponent
v = NamedComponent -> Bool
isCLib NamedComponent
v Bool -> Bool -> Bool
|| NamedComponent -> Bool
isCSubLib NamedComponent
v Bool -> Bool -> Bool
|| NamedComponent -> Bool
isCExe NamedComponent
v

-- | A function to split the given list of components into sets of the names of

-- the named components by the type of component (sub-libraries, executables,

-- test-suites, benchmarks), ignoring any 'main' unnamed library component or

-- foreign library component. This function should be used very sparingly; more

-- often than not, you can keep/parse the components split from the start.

splitComponents ::
     [NamedComponent]
  -> ( Set StackUnqualCompName
       -- ^ Sub-libraries.

     , Set StackUnqualCompName
       -- ^ Executables.

     , Set StackUnqualCompName
       -- ^ Test-suites.

     , Set StackUnqualCompName
       -- ^ Benchmarks.

     )
splitComponents :: [NamedComponent]
-> (Set StackUnqualCompName, Set StackUnqualCompName,
    Set StackUnqualCompName, Set StackUnqualCompName)
splitComponents =
  ([StackUnqualCompName] -> [StackUnqualCompName])
-> ([StackUnqualCompName] -> [StackUnqualCompName])
-> ([StackUnqualCompName] -> [StackUnqualCompName])
-> ([StackUnqualCompName] -> [StackUnqualCompName])
-> [NamedComponent]
-> (Set StackUnqualCompName, Set StackUnqualCompName,
    Set StackUnqualCompName, Set StackUnqualCompName)
forall {a} {a} {a} {a}.
(Ord a, Ord a, Ord a, Ord a) =>
([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go [StackUnqualCompName] -> [StackUnqualCompName]
forall a. a -> a
id [StackUnqualCompName] -> [StackUnqualCompName]
forall a. a -> a
id [StackUnqualCompName] -> [StackUnqualCompName]
forall a. a -> a
id [StackUnqualCompName] -> [StackUnqualCompName]
forall a. a -> a
id
 where
  run :: ([a] -> [a]) -> Set a
run [a] -> [a]
c = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
c []
  go :: ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b [] = (([StackUnqualCompName] -> [a]) -> Set a
forall {a} {a}. Ord a => ([a] -> [a]) -> Set a
run [StackUnqualCompName] -> [a]
s, ([StackUnqualCompName] -> [a]) -> Set a
forall {a} {a}. Ord a => ([a] -> [a]) -> Set a
run [StackUnqualCompName] -> [a]
e, ([StackUnqualCompName] -> [a]) -> Set a
forall {a} {a}. Ord a => ([a] -> [a]) -> Set a
run [StackUnqualCompName] -> [a]
t, ([StackUnqualCompName] -> [a]) -> Set a
forall {a} {a}. Ord a => ([a] -> [a]) -> Set a
run [StackUnqualCompName] -> [a]
b)
  go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b (NamedComponent
CLib : [NamedComponent]
xs) = ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b [NamedComponent]
xs
  go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b (CSubLib StackUnqualCompName
x : [NamedComponent]
xs) = ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go ([StackUnqualCompName] -> [a]
s ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [StackUnqualCompName])
-> [StackUnqualCompName]
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackUnqualCompName
x:)) [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b [NamedComponent]
xs
  -- Ignore foreign libraries, for now.

  go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b (CFlib StackUnqualCompName
_ : [NamedComponent]
xs) = ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b [NamedComponent]
xs
  go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b (CExe StackUnqualCompName
x : [NamedComponent]
xs) = ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go [StackUnqualCompName] -> [a]
s ([StackUnqualCompName] -> [a]
e ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [StackUnqualCompName])
-> [StackUnqualCompName]
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackUnqualCompName
x:)) [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b [NamedComponent]
xs
  go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b (CTest StackUnqualCompName
x : [NamedComponent]
xs) = ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e ([StackUnqualCompName] -> [a]
t ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [StackUnqualCompName])
-> [StackUnqualCompName]
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackUnqualCompName
x:)) [StackUnqualCompName] -> [a]
b [NamedComponent]
xs
  go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t [StackUnqualCompName] -> [a]
b (CBench StackUnqualCompName
x : [NamedComponent]
xs) = ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a, Set a)
go [StackUnqualCompName] -> [a]
s [StackUnqualCompName] -> [a]
e [StackUnqualCompName] -> [a]
t ([StackUnqualCompName] -> [a]
b ([StackUnqualCompName] -> [a])
-> ([StackUnqualCompName] -> [StackUnqualCompName])
-> [StackUnqualCompName]
-> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StackUnqualCompName
x:)) [NamedComponent]
xs