{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

module Distribution.Types.Executable (
    Executable(..),
    emptyExecutable,
    exeModules,
    exeModulesAutogen
) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Types.BuildInfo
import Distribution.Types.UnqualComponentName
import Distribution.Types.ExecutableScope
import Distribution.ModuleName

import qualified Distribution.Types.BuildInfo.Lens as L

data Executable = Executable {
        Executable -> UnqualComponentName
exeName    :: UnqualComponentName,
        Executable -> FilePath
modulePath :: FilePath,
        Executable -> ExecutableScope
exeScope   :: ExecutableScope,
        Executable -> BuildInfo
buildInfo  :: BuildInfo
    }
    deriving ((forall x. Executable -> Rep Executable x)
-> (forall x. Rep Executable x -> Executable) -> Generic Executable
forall x. Rep Executable x -> Executable
forall x. Executable -> Rep Executable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Executable x -> Executable
$cfrom :: forall x. Executable -> Rep Executable x
Generic, Int -> Executable -> ShowS
[Executable] -> ShowS
Executable -> FilePath
(Int -> Executable -> ShowS)
-> (Executable -> FilePath)
-> ([Executable] -> ShowS)
-> Show Executable
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Executable] -> ShowS
$cshowList :: [Executable] -> ShowS
show :: Executable -> FilePath
$cshow :: Executable -> FilePath
showsPrec :: Int -> Executable -> ShowS
$cshowsPrec :: Int -> Executable -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show BuildInfo
External instance of the constraint type Show ExecutableScope
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show UnqualComponentName
External instance of the constraint type Ord Int
Show, ReadPrec [Executable]
ReadPrec Executable
Int -> ReadS Executable
ReadS [Executable]
(Int -> ReadS Executable)
-> ReadS [Executable]
-> ReadPrec Executable
-> ReadPrec [Executable]
-> Read Executable
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Executable]
$creadListPrec :: ReadPrec [Executable]
readPrec :: ReadPrec Executable
$creadPrec :: ReadPrec Executable
readList :: ReadS [Executable]
$creadList :: ReadS [Executable]
readsPrec :: Int -> ReadS Executable
$creadsPrec :: Int -> ReadS Executable
External instance of the constraint type Read Char
External instance of the constraint type Read BuildInfo
External instance of the constraint type Read ExecutableScope
External instance of the constraint type Read Char
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read UnqualComponentName
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read Executable
Read, Executable -> Executable -> Bool
(Executable -> Executable -> Bool)
-> (Executable -> Executable -> Bool) -> Eq Executable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Executable -> Executable -> Bool
$c/= :: Executable -> Executable -> Bool
== :: Executable -> Executable -> Bool
$c== :: Executable -> Executable -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Eq BuildInfo
External instance of the constraint type Eq ExecutableScope
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq UnqualComponentName
Eq, Typeable, Typeable Executable
DataType
Constr
Typeable Executable
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Executable -> c Executable)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Executable)
-> (Executable -> Constr)
-> (Executable -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Executable))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Executable))
-> ((forall b. Data b => b -> b) -> Executable -> Executable)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Executable -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Executable -> r)
-> (forall u. (forall d. Data d => d -> u) -> Executable -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Executable -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Executable -> m Executable)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Executable -> m Executable)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Executable -> m Executable)
-> Data Executable
Executable -> DataType
Executable -> Constr
(forall b. Data b => b -> b) -> Executable -> Executable
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Executable -> c Executable
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Executable
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) -> Executable -> u
forall u. (forall d. Data d => d -> u) -> Executable -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Executable -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Executable -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Executable -> m Executable
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Executable -> m Executable
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Executable
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Executable -> c Executable
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Executable)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Executable)
$cExecutable :: Constr
$tExecutable :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Executable -> m Executable
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Executable -> m Executable
gmapMp :: (forall d. Data d => d -> m d) -> Executable -> m Executable
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Executable -> m Executable
gmapM :: (forall d. Data d => d -> m d) -> Executable -> m Executable
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Executable -> m Executable
gmapQi :: Int -> (forall d. Data d => d -> u) -> Executable -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Executable -> u
gmapQ :: (forall d. Data d => d -> u) -> Executable -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Executable -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Executable -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Executable -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Executable -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Executable -> r
gmapT :: (forall b. Data b => b -> b) -> Executable -> Executable
$cgmapT :: (forall b. Data b => b -> b) -> Executable -> Executable
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Executable)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Executable)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Executable)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Executable)
dataTypeOf :: Executable -> DataType
$cdataTypeOf :: Executable -> DataType
toConstr :: Executable -> Constr
$ctoConstr :: Executable -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Executable
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Executable
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Executable -> c Executable
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Executable -> c Executable
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data UnqualComponentName
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data ExecutableScope
External instance of the constraint type Data BuildInfo
Data)

instance L.HasBuildInfo Executable where
    buildInfo :: LensLike f Executable Executable BuildInfo BuildInfo
buildInfo BuildInfo -> f BuildInfo
f Executable
l = (\BuildInfo
x -> Executable
l { buildInfo :: BuildInfo
buildInfo = BuildInfo
x }) (BuildInfo -> Executable) -> f BuildInfo -> f Executable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Evidence bound by a type signature of the constraint type Functor f
<$> BuildInfo -> f BuildInfo
f (Executable -> BuildInfo
buildInfo Executable
l)

instance Binary Executable
instance Structured Executable
instance NFData Executable where rnf :: Executable -> ()
rnf = Executable -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData UnqualComponentName
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
External instance of the constraint type forall (a :: * -> *) (b :: * -> *).
(GNFData a, GNFData b) =>
GNFData (a :*: b)
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData ExecutableScope
External instance of the constraint type forall (a :: * -> *) i (c :: Meta). GNFData a => GNFData (M1 i c a)
External instance of the constraint type forall a i. NFData a => GNFData (K1 i a)
External instance of the constraint type NFData BuildInfo
Instance of class: Generic of the constraint type Generic Executable
genericRnf

instance Monoid Executable where
  mempty :: Executable
mempty = Executable
forall a. (Generic a, GMonoid (Rep a)) => a
External instance of the constraint type forall (f :: * -> *) i (c :: Meta). GMonoid f => GMonoid (M1 i c f)
External instance of the constraint type forall (f :: * -> *) i (c :: Meta). GMonoid f => GMonoid (M1 i c f)
External instance of the constraint type forall (f :: * -> *) (g :: * -> *).
(GMonoid f, GMonoid g) =>
GMonoid (f :*: g)
External instance of the constraint type forall (f :: * -> *) (g :: * -> *).
(GMonoid f, GMonoid g) =>
GMonoid (f :*: g)
External instance of the constraint type forall (f :: * -> *) i (c :: Meta). GMonoid f => GMonoid (M1 i c f)
External instance of the constraint type forall a i. (Semigroup a, Monoid a) => GMonoid (K1 i a)
External instance of the constraint type Semigroup UnqualComponentName
External instance of the constraint type Monoid UnqualComponentName
External instance of the constraint type forall (f :: * -> *) i (c :: Meta). GMonoid f => GMonoid (M1 i c f)
External instance of the constraint type forall a i. (Semigroup a, Monoid a) => GMonoid (K1 i a)
External instance of the constraint type forall a. Semigroup [a]
External instance of the constraint type forall a. Monoid [a]
External instance of the constraint type forall (f :: * -> *) (g :: * -> *).
(GMonoid f, GMonoid g) =>
GMonoid (f :*: g)
External instance of the constraint type forall (f :: * -> *) i (c :: Meta). GMonoid f => GMonoid (M1 i c f)
External instance of the constraint type forall a i. (Semigroup a, Monoid a) => GMonoid (K1 i a)
External instance of the constraint type Semigroup ExecutableScope
External instance of the constraint type Monoid ExecutableScope
External instance of the constraint type forall (f :: * -> *) i (c :: Meta). GMonoid f => GMonoid (M1 i c f)
External instance of the constraint type forall a i. (Semigroup a, Monoid a) => GMonoid (K1 i a)
External instance of the constraint type Semigroup BuildInfo
External instance of the constraint type Monoid BuildInfo
Instance of class: Generic of the constraint type Generic Executable
gmempty
  mappend :: Executable -> Executable -> Executable
mappend = Executable -> Executable -> Executable
forall a. Semigroup a => a -> a -> a
Instance of class: Semigroup of the constraint type Semigroup Executable
(<>)

instance Semigroup Executable where
  Executable
a <> :: Executable -> Executable -> Executable
<> Executable
b = Executable :: UnqualComponentName
-> FilePath -> ExecutableScope -> BuildInfo -> Executable
Executable{
    exeName :: UnqualComponentName
exeName    = (Executable -> UnqualComponentName) -> UnqualComponentName
combine' Executable -> UnqualComponentName
exeName,
    modulePath :: FilePath
modulePath = (Executable -> FilePath) -> FilePath
forall {a}. Monoid a => (Executable -> a) -> a
External instance of the constraint type forall a. Monoid [a]
combine Executable -> FilePath
modulePath,
    exeScope :: ExecutableScope
exeScope   = (Executable -> ExecutableScope) -> ExecutableScope
forall {a}. Monoid a => (Executable -> a) -> a
External instance of the constraint type Monoid ExecutableScope
combine Executable -> ExecutableScope
exeScope,
    buildInfo :: BuildInfo
buildInfo  = (Executable -> BuildInfo) -> BuildInfo
forall {a}. Monoid a => (Executable -> a) -> a
External instance of the constraint type Monoid BuildInfo
combine Executable -> BuildInfo
buildInfo
  }
    where combine :: (Executable -> a) -> a
combine Executable -> a
field = Executable -> a
field Executable
a a -> a -> a
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid a
`mappend` Executable -> a
field Executable
b
          combine' :: (Executable -> UnqualComponentName) -> UnqualComponentName
combine' Executable -> UnqualComponentName
field = case ( UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
field Executable
a
                                , UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
field Executable
b) of
                      (FilePath
"", FilePath
_) -> Executable -> UnqualComponentName
field Executable
b
                      (FilePath
_, FilePath
"") -> Executable -> UnqualComponentName
field Executable
a
                      (FilePath
x, FilePath
y) -> FilePath -> UnqualComponentName
forall a. HasCallStack => FilePath -> a
error (FilePath -> UnqualComponentName)
-> FilePath -> UnqualComponentName
forall a b. (a -> b) -> a -> b
$ FilePath
"Ambiguous values for executable field: '"
                                  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
x FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"' and '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
y FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'"

emptyExecutable :: Executable
emptyExecutable :: Executable
emptyExecutable = Executable
forall a. Monoid a => a
Instance of class: Monoid of the constraint type Monoid Executable
mempty

-- | Get all the module names from an exe
exeModules :: Executable -> [ModuleName]
exeModules :: Executable -> [ModuleName]
exeModules Executable
exe = BuildInfo -> [ModuleName]
otherModules (Executable -> BuildInfo
buildInfo Executable
exe)

-- | Get all the auto generated module names from an exe
-- This are a subset of 'exeModules'.
exeModulesAutogen :: Executable -> [ModuleName]
exeModulesAutogen :: Executable -> [ModuleName]
exeModulesAutogen Executable
exe = BuildInfo -> [ModuleName]
autogenModules (Executable -> BuildInfo
buildInfo Executable
exe)