{-# LANGUAGE NoImplicitPrelude          #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoFieldSelectors           #-}
{-# LANGUAGE OverloadedRecordDot        #-}
{-# LANGUAGE ScopedTypeVariables        #-}

-- | A module providing the types that represent different sorts of components

-- of a package (library and sub-library, foreign library, executable, test

-- suite and benchmark).

module Stack.Types.Component
  ( StackLibrary (..)
  , StackForeignLibrary (..)
  , StackExecutable (..)
  , StackTestSuite (..)
  , StackBenchmark (..)
  , StackUnqualCompName (..)
  , StackBuildInfo (..)
  , HasName
  , HasBuildInfo
  , HasComponentInfo
  ) where

import           Distribution.Compiler ( PerCompilerFlavor )
import           Distribution.ModuleName ( ModuleName )
import           Distribution.PackageDescription
                   ( BenchmarkInterface, Dependency, TestSuiteInterface )
import           Distribution.Simple ( Extension, Language )
import           Distribution.Utils.Path ( PackageDir, SourceDir, SymbolicPath )
import           GHC.Records ( HasField (..) )
import           Stack.Prelude
import           Stack.Types.ComponentUtils ( StackUnqualCompName (..) )
import           Stack.Types.Dependency ( DepValue )
import           Stack.Types.NamedComponent ( NamedComponent (..) )

-- | A type representing (unnamed) main library or sub-library components of a

-- package.

--

-- Cabal-syntax uses data constructors

-- 'Distribution.Types.LibraryName.LMainLibName' and

-- 'Distribution.Types.LibraryName.LSubLibName' to distinguish main libraries

-- and sub-libraries. We do not do so, as the \'missing\' name in the case of a

-- main library can be represented by the empty string.

--

-- The corresponding Cabal-syntax type is 'Distribution.Types.Library.Library'.

data StackLibrary = StackLibrary
  { StackLibrary -> StackUnqualCompName
name :: StackUnqualCompName
  , StackLibrary -> StackBuildInfo
buildInfo :: !StackBuildInfo
  , StackLibrary -> [ModuleName]
exposedModules :: [ModuleName]
    -- |^ This is only used for gathering the files related to this component.

  }
  deriving (Int -> StackLibrary -> ShowS
[StackLibrary] -> ShowS
StackLibrary -> String
(Int -> StackLibrary -> ShowS)
-> (StackLibrary -> String)
-> ([StackLibrary] -> ShowS)
-> Show StackLibrary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackLibrary -> ShowS
showsPrec :: Int -> StackLibrary -> ShowS
$cshow :: StackLibrary -> String
show :: StackLibrary -> String
$cshowList :: [StackLibrary] -> ShowS
showList :: [StackLibrary] -> ShowS
Show, Typeable)

-- | A type representing foreign library components of a package.

--

-- The corresponding Cabal-syntax type is

-- 'Distribution.Types.Foreign.Libraries.ForeignLib'.

data StackForeignLibrary = StackForeignLibrary
  { StackForeignLibrary -> StackUnqualCompName
name :: StackUnqualCompName
  , StackForeignLibrary -> StackBuildInfo
buildInfo :: !StackBuildInfo
  }
  deriving (Int -> StackForeignLibrary -> ShowS
[StackForeignLibrary] -> ShowS
StackForeignLibrary -> String
(Int -> StackForeignLibrary -> ShowS)
-> (StackForeignLibrary -> String)
-> ([StackForeignLibrary] -> ShowS)
-> Show StackForeignLibrary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackForeignLibrary -> ShowS
showsPrec :: Int -> StackForeignLibrary -> ShowS
$cshow :: StackForeignLibrary -> String
show :: StackForeignLibrary -> String
$cshowList :: [StackForeignLibrary] -> ShowS
showList :: [StackForeignLibrary] -> ShowS
Show, Typeable)

-- | A type representing executable components of a package.

--

-- The corresponding Cabal-syntax type is

-- 'Distribution.Types.Executable.Executable'.

data StackExecutable = StackExecutable
  { StackExecutable -> StackUnqualCompName
name :: StackUnqualCompName
  , StackExecutable -> StackBuildInfo
buildInfo :: !StackBuildInfo
  , StackExecutable -> String
modulePath :: FilePath
  }
  deriving (Int -> StackExecutable -> ShowS
[StackExecutable] -> ShowS
StackExecutable -> String
(Int -> StackExecutable -> ShowS)
-> (StackExecutable -> String)
-> ([StackExecutable] -> ShowS)
-> Show StackExecutable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackExecutable -> ShowS
showsPrec :: Int -> StackExecutable -> ShowS
$cshow :: StackExecutable -> String
show :: StackExecutable -> String
$cshowList :: [StackExecutable] -> ShowS
showList :: [StackExecutable] -> ShowS
Show, Typeable)

-- | A type representing test suite components of a package.

--

-- The corresponding Cabal-syntax type is

-- 'Distribution.Types.TestSuite.TestSuite'.

data StackTestSuite = StackTestSuite
  { StackTestSuite -> StackUnqualCompName
name :: StackUnqualCompName
  , StackTestSuite -> StackBuildInfo
buildInfo :: !StackBuildInfo
  , StackTestSuite -> TestSuiteInterface
interface :: !TestSuiteInterface
  }
  deriving (Int -> StackTestSuite -> ShowS
[StackTestSuite] -> ShowS
StackTestSuite -> String
(Int -> StackTestSuite -> ShowS)
-> (StackTestSuite -> String)
-> ([StackTestSuite] -> ShowS)
-> Show StackTestSuite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackTestSuite -> ShowS
showsPrec :: Int -> StackTestSuite -> ShowS
$cshow :: StackTestSuite -> String
show :: StackTestSuite -> String
$cshowList :: [StackTestSuite] -> ShowS
showList :: [StackTestSuite] -> ShowS
Show, Typeable)

-- | A type representing benchmark components of a package.

--

-- The corresponding Cabal-syntax type is

-- 'Distribution.Types.Benchmark.Benchmark'.

data StackBenchmark = StackBenchmark
  { StackBenchmark -> StackUnqualCompName
name :: StackUnqualCompName
  , StackBenchmark -> StackBuildInfo
buildInfo :: StackBuildInfo
  , StackBenchmark -> BenchmarkInterface
interface :: BenchmarkInterface
    -- ^ This is only used for gathering the files related to this component.

  }
  deriving (Int -> StackBenchmark -> ShowS
[StackBenchmark] -> ShowS
StackBenchmark -> String
(Int -> StackBenchmark -> ShowS)
-> (StackBenchmark -> String)
-> ([StackBenchmark] -> ShowS)
-> Show StackBenchmark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackBenchmark -> ShowS
showsPrec :: Int -> StackBenchmark -> ShowS
$cshow :: StackBenchmark -> String
show :: StackBenchmark -> String
$cshowList :: [StackBenchmark] -> ShowS
showList :: [StackBenchmark] -> ShowS
Show, Typeable)

-- | Type representing the name of an executable.

newtype ExeName = ExeName Text
  deriving (Typeable ExeName
Typeable ExeName =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ExeName -> c ExeName)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ExeName)
-> (ExeName -> Constr)
-> (ExeName -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ExeName))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName))
-> ((forall b. Data b => b -> b) -> ExeName -> ExeName)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExeName -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExeName -> r)
-> (forall u. (forall d. Data d => d -> u) -> ExeName -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ExeName -> m ExeName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExeName -> m ExeName)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ExeName -> m ExeName)
-> Data ExeName
ExeName -> Constr
ExeName -> DataType
(forall b. Data b => b -> b) -> ExeName -> ExeName
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u
forall u. (forall d. Data d => d -> u) -> ExeName -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeName
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeName -> c ExeName
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeName)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeName -> c ExeName
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExeName -> c ExeName
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeName
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExeName
$ctoConstr :: ExeName -> Constr
toConstr :: ExeName -> Constr
$cdataTypeOf :: ExeName -> DataType
dataTypeOf :: ExeName -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeName)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExeName)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ExeName)
$cgmapT :: (forall b. Data b => b -> b) -> ExeName -> ExeName
gmapT :: (forall b. Data b => b -> b) -> ExeName -> ExeName
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExeName -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExeName -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExeName -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ExeName -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ExeName -> m ExeName
Data, ExeName -> ExeName -> Bool
(ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool) -> Eq ExeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExeName -> ExeName -> Bool
== :: ExeName -> ExeName -> Bool
$c/= :: ExeName -> ExeName -> Bool
/= :: ExeName -> ExeName -> Bool
Eq, Eq ExeName
Eq ExeName =>
(Int -> ExeName -> Int) -> (ExeName -> Int) -> Hashable ExeName
Int -> ExeName -> Int
ExeName -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ExeName -> Int
hashWithSalt :: Int -> ExeName -> Int
$chash :: ExeName -> Int
hash :: ExeName -> Int
Hashable, String -> ExeName
(String -> ExeName) -> IsString ExeName
forall a. (String -> a) -> IsString a
$cfromString :: String -> ExeName
fromString :: String -> ExeName
IsString, (forall x. ExeName -> Rep ExeName x)
-> (forall x. Rep ExeName x -> ExeName) -> Generic ExeName
forall x. Rep ExeName x -> ExeName
forall x. ExeName -> Rep ExeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExeName -> Rep ExeName x
from :: forall x. ExeName -> Rep ExeName x
$cto :: forall x. Rep ExeName x -> ExeName
to :: forall x. Rep ExeName x -> ExeName
Generic, ExeName -> ()
(ExeName -> ()) -> NFData ExeName
forall a. (a -> ()) -> NFData a
$crnf :: ExeName -> ()
rnf :: ExeName -> ()
NFData, Eq ExeName
Eq ExeName =>
(ExeName -> ExeName -> Ordering)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> Bool)
-> (ExeName -> ExeName -> ExeName)
-> (ExeName -> ExeName -> ExeName)
-> Ord ExeName
ExeName -> ExeName -> Bool
ExeName -> ExeName -> Ordering
ExeName -> ExeName -> ExeName
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 :: ExeName -> ExeName -> Ordering
compare :: ExeName -> ExeName -> Ordering
$c< :: ExeName -> ExeName -> Bool
< :: ExeName -> ExeName -> Bool
$c<= :: ExeName -> ExeName -> Bool
<= :: ExeName -> ExeName -> Bool
$c> :: ExeName -> ExeName -> Bool
> :: ExeName -> ExeName -> Bool
$c>= :: ExeName -> ExeName -> Bool
>= :: ExeName -> ExeName -> Bool
$cmax :: ExeName -> ExeName -> ExeName
max :: ExeName -> ExeName -> ExeName
$cmin :: ExeName -> ExeName -> ExeName
min :: ExeName -> ExeName -> ExeName
Ord, Int -> ExeName -> ShowS
[ExeName] -> ShowS
ExeName -> String
(Int -> ExeName -> ShowS)
-> (ExeName -> String) -> ([ExeName] -> ShowS) -> Show ExeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExeName -> ShowS
showsPrec :: Int -> ExeName -> ShowS
$cshow :: ExeName -> String
show :: ExeName -> String
$cshowList :: [ExeName] -> ShowS
showList :: [ExeName] -> ShowS
Show, Typeable)

-- | Type representing information needed to build. The file gathering-related

-- fields are lazy because they are not always needed.

--

-- The corresponding Cabal-syntax type is

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


-- We don't use the Cabal-syntax type because Cabal provides a list of

-- dependencies, and Stack needs a Map and only a small subset of all the

-- information in Cabal-syntax type.

data StackBuildInfo = StackBuildInfo
  { StackBuildInfo -> Bool
buildable :: !Bool
    -- ^ Corresponding to Cabal-syntax's

    -- 'Distribution.Types.BuildInfo.buildable'. The component is buildable

    -- here.

  , StackBuildInfo -> Map PackageName DepValue
dependency :: !(Map PackageName DepValue)
    -- ^ Corresponding to Cabal-syntax's

    -- 'Distribution.Types.BuildInfo.targetBuildDepends'. Dependencies specific

    -- to a library or executable target.

  , StackBuildInfo -> Set Text
unknownTools :: Set Text
    -- ^ From Cabal-syntax's 'Distribution.Types.BuildInfo.buildTools'. We only

    -- keep the legacy build tool depends that we know (from a hardcoded list).

    -- We only use the deduplication aspect of the Set here, as this field is

    -- only used for error reporting in the end. This is lazy because it's an

    -- error reporting field only.

  , StackBuildInfo -> [ModuleName]
otherModules :: [ModuleName]
    -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module.

  , StackBuildInfo -> [String]
jsSources :: [FilePath]
    -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module.

  , StackBuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs :: [SymbolicPath PackageDir SourceDir]
    -- ^ Only used in file & opts gathering. See usage in "Stack.ComponentFile"

    -- module for fle gathering.

  , StackBuildInfo -> [String]
cSources :: [FilePath]
    -- ^ Only used in file gathering. See usage in "Stack.ComponentFile" module.

  , StackBuildInfo -> [String]
cppOptions :: [String]
    -- ^ Only used in opts gathering. See usage in "Stack.Package" module.

  , StackBuildInfo -> [Dependency]
targetBuildDepends :: [Dependency]
    -- ^ Only used in opts gathering.

  , StackBuildInfo -> PerCompilerFlavor [String]
options :: PerCompilerFlavor [String]
    -- ^ Only used in opts gathering.

  , StackBuildInfo -> [Language]
allLanguages :: [Language]
    -- ^ Only used in opts gathering.

  , StackBuildInfo -> [Extension]
usedExtensions :: [Extension]
    -- ^ Only used in opts gathering.

  , StackBuildInfo -> [String]
includeDirs :: [FilePath]
    -- ^ Only used in opts gathering.

  , StackBuildInfo -> [String]
extraLibs :: [String]
    -- ^ Only used in opts gathering.

  , StackBuildInfo -> [String]
extraLibDirs :: [String]
    -- ^ Only used in opts gathering.

  , StackBuildInfo -> [String]
frameworks :: [String]
    -- ^ Only used in opts gathering.

  }
  deriving (Int -> StackBuildInfo -> ShowS
[StackBuildInfo] -> ShowS
StackBuildInfo -> String
(Int -> StackBuildInfo -> ShowS)
-> (StackBuildInfo -> String)
-> ([StackBuildInfo] -> ShowS)
-> Show StackBuildInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackBuildInfo -> ShowS
showsPrec :: Int -> StackBuildInfo -> ShowS
$cshow :: StackBuildInfo -> String
show :: StackBuildInfo -> String
$cshowList :: [StackBuildInfo] -> ShowS
showList :: [StackBuildInfo] -> ShowS
Show)

-- | Type synonym for a 'HasField' constraint.

type HasName component = HasField "name" component StackUnqualCompName

-- | Type synonym for a 'HasField' constraint.

type HasBuildInfo component = HasField "buildInfo" component StackBuildInfo

instance HasField "qualifiedName" StackLibrary NamedComponent where
  getField :: StackLibrary -> NamedComponent
getField StackLibrary
v
    | Text
rawName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
forall a. Monoid a => a
mempty = NamedComponent
CLib
    | Bool
otherwise = Text -> NamedComponent
CSubLib Text
rawName
    where
      rawName :: Text
rawName = StackLibrary
v.name.unqualCompToText

instance HasField "qualifiedName" StackForeignLibrary NamedComponent where
  getField :: StackForeignLibrary -> NamedComponent
getField = Text -> NamedComponent
CFlib (Text -> NamedComponent)
-> (StackForeignLibrary -> Text)
-> StackForeignLibrary
-> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.name.unqualCompToText)

instance HasField "qualifiedName" StackExecutable NamedComponent where
  getField :: StackExecutable -> NamedComponent
getField = Text -> NamedComponent
CExe (Text -> NamedComponent)
-> (StackExecutable -> Text) -> StackExecutable -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.name.unqualCompToText)

instance HasField "qualifiedName" StackTestSuite NamedComponent where
  getField :: StackTestSuite -> NamedComponent
getField = Text -> NamedComponent
CTest (Text -> NamedComponent)
-> (StackTestSuite -> Text) -> StackTestSuite -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.name.unqualCompToText)

instance HasField "qualifiedName" StackBenchmark NamedComponent where
  getField :: StackBenchmark -> NamedComponent
getField = Text -> NamedComponent
CTest (Text -> NamedComponent)
-> (StackBenchmark -> Text) -> StackBenchmark -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.name.unqualCompToText)

-- | Type synonym for a 'HasField' constraint which represent a virtual field,

-- computed from the type, the NamedComponent constructor and the name.

type HasQualiName component = HasField "qualifiedName" component NamedComponent

-- | Type synonym for a 'HasField' constraint for all the common component

-- fields i.e. @name@, @buildInfo@ and @qualifiedName@.

type HasComponentInfo component =
  (HasName component, HasBuildInfo component, HasQualiName component)