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

module Distribution.Types.ForeignLib(
    ForeignLib(..),
    emptyForeignLib,
    foreignLibModules,
    foreignLibIsShared,
    foreignLibVersion,

    LibVersionInfo,
    mkLibVersionInfo,
    libVersionInfoCRA,
    libVersionNumber,
    libVersionNumberShow,
    libVersionMajor
) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.ModuleName
import Distribution.Parsec
import Distribution.Pretty
import Distribution.System
import Distribution.Types.BuildInfo
import Distribution.Types.ForeignLibOption
import Distribution.Types.ForeignLibType
import Distribution.Types.UnqualComponentName
import Distribution.Version

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint           as Disp
import qualified Text.Read                  as Read

import qualified Distribution.Types.BuildInfo.Lens as L

-- | A foreign library stanza is like a library stanza, except that
-- the built code is intended for consumption by a non-Haskell client.
data ForeignLib = ForeignLib {
      -- | Name of the foreign library
      ForeignLib -> UnqualComponentName
foreignLibName       :: UnqualComponentName
      -- | What kind of foreign library is this (static or dynamic).
    , ForeignLib -> ForeignLibType
foreignLibType       :: ForeignLibType
      -- | What options apply to this foreign library (e.g., are we
      -- merging in all foreign dependencies.)
    , ForeignLib -> [ForeignLibOption]
foreignLibOptions    :: [ForeignLibOption]
      -- | Build information for this foreign library.
    , ForeignLib -> BuildInfo
foreignLibBuildInfo  :: BuildInfo
      -- | Libtool-style version-info data to compute library version.
      -- Refer to the libtool documentation on the
      -- current:revision:age versioning scheme.
    , ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo :: Maybe LibVersionInfo
      -- | Linux library version
    , ForeignLib -> Maybe Version
foreignLibVersionLinux :: Maybe Version

      -- | (Windows-specific) module definition files
      --
      -- This is a list rather than a maybe field so that we can flatten
      -- the condition trees (for instance, when creating an sdist)
    , ForeignLib -> [FilePath]
foreignLibModDefFile :: [FilePath]
    }
    deriving ((forall x. ForeignLib -> Rep ForeignLib x)
-> (forall x. Rep ForeignLib x -> ForeignLib) -> Generic ForeignLib
forall x. Rep ForeignLib x -> ForeignLib
forall x. ForeignLib -> Rep ForeignLib x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ForeignLib x -> ForeignLib
$cfrom :: forall x. ForeignLib -> Rep ForeignLib x
Generic, Int -> ForeignLib -> ShowS
[ForeignLib] -> ShowS
ForeignLib -> FilePath
(Int -> ForeignLib -> ShowS)
-> (ForeignLib -> FilePath)
-> ([ForeignLib] -> ShowS)
-> Show ForeignLib
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ForeignLib] -> ShowS
$cshowList :: [ForeignLib] -> ShowS
show :: ForeignLib -> FilePath
$cshow :: ForeignLib -> FilePath
showsPrec :: Int -> ForeignLib -> ShowS
$cshowsPrec :: Int -> ForeignLib -> ShowS
External instance of the constraint type Show Char
External instance of the constraint type Show Char
External instance of the constraint type Show Version
External instance of the constraint type Show ForeignLibOption
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show Char
External instance of the constraint type Show Version
Instance of class: Show of the constraint type Show LibVersionInfo
External instance of the constraint type forall a. Show a => Show (Maybe a)
External instance of the constraint type Show BuildInfo
External instance of the constraint type Show ForeignLibOption
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Show ForeignLibType
External instance of the constraint type Show UnqualComponentName
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show LibVersionInfo
Show, ReadPrec [ForeignLib]
ReadPrec ForeignLib
Int -> ReadS ForeignLib
ReadS [ForeignLib]
(Int -> ReadS ForeignLib)
-> ReadS [ForeignLib]
-> ReadPrec ForeignLib
-> ReadPrec [ForeignLib]
-> Read ForeignLib
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ForeignLib]
$creadListPrec :: ReadPrec [ForeignLib]
readPrec :: ReadPrec ForeignLib
$creadPrec :: ReadPrec ForeignLib
readList :: ReadS [ForeignLib]
$creadList :: ReadS [ForeignLib]
readsPrec :: Int -> ReadS ForeignLib
$creadsPrec :: Int -> ReadS ForeignLib
External instance of the constraint type Read Char
External instance of the constraint type Read Char
External instance of the constraint type Read Version
External instance of the constraint type Read ForeignLibOption
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read Char
External instance of the constraint type Read Version
Instance of class: Read of the constraint type Read LibVersionInfo
External instance of the constraint type forall a. Read a => Read (Maybe a)
External instance of the constraint type Read BuildInfo
External instance of the constraint type Read ForeignLibOption
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Read ForeignLibType
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 LibVersionInfo
Instance of class: Read of the constraint type Read ForeignLib
Read, ForeignLib -> ForeignLib -> Bool
(ForeignLib -> ForeignLib -> Bool)
-> (ForeignLib -> ForeignLib -> Bool) -> Eq ForeignLib
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignLib -> ForeignLib -> Bool
$c/= :: ForeignLib -> ForeignLib -> Bool
== :: ForeignLib -> ForeignLib -> Bool
$c== :: ForeignLib -> ForeignLib -> Bool
External instance of the constraint type Eq Char
External instance of the constraint type Eq Char
External instance of the constraint type Eq Version
External instance of the constraint type Eq ForeignLibOption
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq Char
External instance of the constraint type Eq Version
Instance of class: Eq of the constraint type Eq LibVersionInfo
External instance of the constraint type forall a. Eq a => Eq (Maybe a)
External instance of the constraint type Eq BuildInfo
External instance of the constraint type Eq ForeignLibOption
External instance of the constraint type forall a. Eq a => Eq [a]
External instance of the constraint type Eq ForeignLibType
External instance of the constraint type Eq UnqualComponentName
Instance of class: Eq of the constraint type Eq LibVersionInfo
Eq, Typeable, Typeable ForeignLib
DataType
Constr
Typeable ForeignLib
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ForeignLib -> c ForeignLib)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ForeignLib)
-> (ForeignLib -> Constr)
-> (ForeignLib -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ForeignLib))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ForeignLib))
-> ((forall b. Data b => b -> b) -> ForeignLib -> ForeignLib)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ForeignLib -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ForeignLib -> r)
-> (forall u. (forall d. Data d => d -> u) -> ForeignLib -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ForeignLib -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib)
-> Data ForeignLib
ForeignLib -> DataType
ForeignLib -> Constr
(forall b. Data b => b -> b) -> ForeignLib -> ForeignLib
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLib -> c ForeignLib
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLib
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) -> ForeignLib -> u
forall u. (forall d. Data d => d -> u) -> ForeignLib -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLib -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLib -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLib
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLib -> c ForeignLib
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForeignLib)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ForeignLib)
$cForeignLib :: Constr
$tForeignLib :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
gmapMp :: (forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
gmapM :: (forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ForeignLib -> m ForeignLib
gmapQi :: Int -> (forall d. Data d => d -> u) -> ForeignLib -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ForeignLib -> u
gmapQ :: (forall d. Data d => d -> u) -> ForeignLib -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ForeignLib -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLib -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLib -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLib -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ForeignLib -> r
gmapT :: (forall b. Data b => b -> b) -> ForeignLib -> ForeignLib
$cgmapT :: (forall b. Data b => b -> b) -> ForeignLib -> ForeignLib
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ForeignLib)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ForeignLib)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ForeignLib)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ForeignLib)
dataTypeOf :: ForeignLib -> DataType
$cdataTypeOf :: ForeignLib -> DataType
toConstr :: ForeignLib -> Constr
$ctoConstr :: ForeignLib -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLib
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ForeignLib
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLib -> c ForeignLib
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ForeignLib -> c ForeignLib
External instance of the constraint type Data Char
External instance of the constraint type Data ForeignLibOption
External instance of the constraint type Data Version
External instance of the constraint type Data Char
External instance of the constraint type Data Char
External instance of the constraint type Data ForeignLibOption
Instance of class: Data of the constraint type Data LibVersionInfo
External instance of the constraint type Data Version
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Char
External instance of the constraint type Data UnqualComponentName
External instance of the constraint type Data ForeignLibType
External instance of the constraint type Data ForeignLibOption
External instance of the constraint type Data BuildInfo
Instance of class: Data of the constraint type Data LibVersionInfo
External instance of the constraint type Data Version
External instance of the constraint type forall a. Data a => Data (Maybe a)
External instance of the constraint type forall a. Data a => Data [a]
External instance of the constraint type Data Char
External instance of the constraint type forall a. Data a => Data [a]
Instance of class: Data of the constraint type Data LibVersionInfo
Data)

data LibVersionInfo = LibVersionInfo Int Int Int deriving (Typeable LibVersionInfo
DataType
Constr
Typeable LibVersionInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LibVersionInfo -> c LibVersionInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LibVersionInfo)
-> (LibVersionInfo -> Constr)
-> (LibVersionInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LibVersionInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LibVersionInfo))
-> ((forall b. Data b => b -> b)
    -> LibVersionInfo -> LibVersionInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LibVersionInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LibVersionInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LibVersionInfo -> m LibVersionInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LibVersionInfo -> m LibVersionInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LibVersionInfo -> m LibVersionInfo)
-> Data LibVersionInfo
LibVersionInfo -> DataType
LibVersionInfo -> Constr
(forall b. Data b => b -> b) -> LibVersionInfo -> LibVersionInfo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LibVersionInfo -> c LibVersionInfo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LibVersionInfo
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) -> LibVersionInfo -> u
forall u. (forall d. Data d => d -> u) -> LibVersionInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LibVersionInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LibVersionInfo -> c LibVersionInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LibVersionInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LibVersionInfo)
$cLibVersionInfo :: Constr
$tLibVersionInfo :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
gmapMp :: (forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
gmapM :: (forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LibVersionInfo -> m LibVersionInfo
gmapQi :: Int -> (forall d. Data d => d -> u) -> LibVersionInfo -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LibVersionInfo -> u
gmapQ :: (forall d. Data d => d -> u) -> LibVersionInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LibVersionInfo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LibVersionInfo -> r
gmapT :: (forall b. Data b => b -> b) -> LibVersionInfo -> LibVersionInfo
$cgmapT :: (forall b. Data b => b -> b) -> LibVersionInfo -> LibVersionInfo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LibVersionInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LibVersionInfo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LibVersionInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LibVersionInfo)
dataTypeOf :: LibVersionInfo -> DataType
$cdataTypeOf :: LibVersionInfo -> DataType
toConstr :: LibVersionInfo -> Constr
$ctoConstr :: LibVersionInfo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LibVersionInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LibVersionInfo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LibVersionInfo -> c LibVersionInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LibVersionInfo -> c LibVersionInfo
External instance of the constraint type Data Int
External instance of the constraint type Data Int
External instance of the constraint type Data Int
Data, LibVersionInfo -> LibVersionInfo -> Bool
(LibVersionInfo -> LibVersionInfo -> Bool)
-> (LibVersionInfo -> LibVersionInfo -> Bool) -> Eq LibVersionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LibVersionInfo -> LibVersionInfo -> Bool
$c/= :: LibVersionInfo -> LibVersionInfo -> Bool
== :: LibVersionInfo -> LibVersionInfo -> Bool
$c== :: LibVersionInfo -> LibVersionInfo -> Bool
External instance of the constraint type Eq Int
External instance of the constraint type Eq Int
Eq, (forall x. LibVersionInfo -> Rep LibVersionInfo x)
-> (forall x. Rep LibVersionInfo x -> LibVersionInfo)
-> Generic LibVersionInfo
forall x. Rep LibVersionInfo x -> LibVersionInfo
forall x. LibVersionInfo -> Rep LibVersionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LibVersionInfo x -> LibVersionInfo
$cfrom :: forall x. LibVersionInfo -> Rep LibVersionInfo x
Generic, Typeable)

instance Ord LibVersionInfo where
    LibVersionInfo Int
c Int
r Int
_ compare :: LibVersionInfo -> LibVersionInfo -> Ordering
`compare` LibVersionInfo Int
c' Int
r' Int
_ =
        case Int
c Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Int
`compare` Int
c' of
            Ordering
EQ -> Int
r Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
External instance of the constraint type Ord Int
`compare` Int
r'
            Ordering
e  -> Ordering
e

instance Show LibVersionInfo where
    showsPrec :: Int -> LibVersionInfo -> ShowS
showsPrec Int
d (LibVersionInfo Int
c Int
r Int
a) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Int
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
showString FilePath
"mkLibVersionInfo "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int, Int, Int) -> ShowS
forall a. Show a => Int -> a -> ShowS
External instance of the constraint type forall a b c. (Show a, Show b, Show c) => Show (a, b, c)
External instance of the constraint type Show Int
showsPrec Int
11 (Int
c,Int
r,Int
a)

instance Read LibVersionInfo where
    readPrec :: ReadPrec LibVersionInfo
readPrec = ReadPrec LibVersionInfo -> ReadPrec LibVersionInfo
forall a. ReadPrec a -> ReadPrec a
Read.parens (ReadPrec LibVersionInfo -> ReadPrec LibVersionInfo)
-> ReadPrec LibVersionInfo -> ReadPrec LibVersionInfo
forall a b. (a -> b) -> a -> b
$ do
        Read.Ident FilePath
"mkLibVersionInfo" <- ReadPrec Lexeme
Read.lexP
        (Int, Int, Int)
t <- ReadPrec (Int, Int, Int) -> ReadPrec (Int, Int, Int)
forall a. ReadPrec a -> ReadPrec a
Read.step ReadPrec (Int, Int, Int)
forall a. Read a => ReadPrec a
External instance of the constraint type forall a b c. (Read a, Read b, Read c) => Read (a, b, c)
External instance of the constraint type Read Int
External instance of the constraint type Read Int
External instance of the constraint type Read Int
Read.readPrec
        LibVersionInfo -> ReadPrec LibVersionInfo
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad ReadPrec
return ((Int, Int, Int) -> LibVersionInfo
mkLibVersionInfo (Int, Int, Int)
t)

instance Binary LibVersionInfo
instance Structured LibVersionInfo
instance NFData LibVersionInfo where rnf :: LibVersionInfo -> ()
rnf = LibVersionInfo -> ()
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 :: * -> *) 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 Int
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 Int
Instance of class: Generic of the constraint type Generic LibVersionInfo
genericRnf

instance Pretty LibVersionInfo where
    pretty :: LibVersionInfo -> Doc
pretty (LibVersionInfo Int
c Int
r Int
a)
      = [Doc] -> Doc
Disp.hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
Disp.punctuate (Char -> Doc
Disp.char Char
':') ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Int -> Doc) -> [Int] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Doc
Disp.int [Int
c,Int
r,Int
a]

instance Parsec LibVersionInfo where
    parsec :: m LibVersionInfo
parsec = do
        Int
c <- m Int
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
External instance of the constraint type Integral Int
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.integral
        (Int
r, Int
a) <- (Int, Int) -> m (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.option (Int
0,Int
0) (m (Int, Int) -> m (Int, Int)) -> m (Int, Int) -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ do
            Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.char Char
':'
            Int
r <- m Int
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
External instance of the constraint type Integral Int
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.integral
            Int
a <- Int -> m Int -> m Int
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.option Int
0 (m Int -> m Int) -> m Int -> m Int
forall a b. (a -> b) -> a -> b
$ do
                Char
_ <- Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.char Char
':'
                m Int
forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
External instance of the constraint type Integral Int
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.integral
            (Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (Int
r,Int
a)
        LibVersionInfo -> m LibVersionInfo
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (LibVersionInfo -> m LibVersionInfo)
-> LibVersionInfo -> m LibVersionInfo
forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> LibVersionInfo
mkLibVersionInfo (Int
c,Int
r,Int
a)

-- | Construct 'LibVersionInfo' from @(current, revision, age)@
-- numbers.
--
-- For instance, @mkLibVersionInfo (3,0,0)@ constructs a
-- 'LibVersionInfo' representing the version-info @3:0:0@.
--
-- All version components must be non-negative.
mkLibVersionInfo :: (Int, Int, Int) -> LibVersionInfo
mkLibVersionInfo :: (Int, Int, Int) -> LibVersionInfo
mkLibVersionInfo (Int
c,Int
r,Int
a) = Int -> Int -> Int -> LibVersionInfo
LibVersionInfo Int
c Int
r Int
a

-- | From a given 'LibVersionInfo', extract the @(current, revision,
-- age)@ numbers.
libVersionInfoCRA :: LibVersionInfo -> (Int, Int, Int)
libVersionInfoCRA :: LibVersionInfo -> (Int, Int, Int)
libVersionInfoCRA (LibVersionInfo Int
c Int
r Int
a) = (Int
c,Int
r,Int
a)

-- | Given a version-info field, produce a @major.minor.build@ version
libVersionNumber :: LibVersionInfo -> (Int, Int, Int)
libVersionNumber :: LibVersionInfo -> (Int, Int, Int)
libVersionNumber (LibVersionInfo Int
c Int
r Int
a) = (Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
a , Int
a , Int
r)

-- | Given a version-info field, return @"major.minor.build"@ as a
-- 'String'
libVersionNumberShow :: LibVersionInfo -> String
libVersionNumberShow :: LibVersionInfo -> FilePath
libVersionNumberShow LibVersionInfo
v =
    let (Int
major, Int
minor, Int
build) = LibVersionInfo -> (Int, Int, Int)
libVersionNumber LibVersionInfo
v
    in Int -> FilePath
forall a. Show a => a -> FilePath
External instance of the constraint type Show Int
show Int
major FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
External instance of the constraint type Show Int
show Int
minor FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
External instance of the constraint type Show Int
show Int
build

-- | Return the @major@ version of a version-info field.
libVersionMajor :: LibVersionInfo -> Int
libVersionMajor :: LibVersionInfo -> Int
libVersionMajor (LibVersionInfo Int
c Int
_ Int
a) = Int
cInt -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
-Int
a

instance L.HasBuildInfo ForeignLib where
    buildInfo :: LensLike f ForeignLib ForeignLib BuildInfo BuildInfo
buildInfo BuildInfo -> f BuildInfo
f ForeignLib
l = (\BuildInfo
x -> ForeignLib
l { foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo = BuildInfo
x }) (BuildInfo -> ForeignLib) -> f BuildInfo -> f ForeignLib
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 (ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
l)

instance Binary ForeignLib
instance Structured ForeignLib
instance NFData ForeignLib where rnf :: ForeignLib -> ()
rnf = ForeignLib -> ()
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 :: * -> *) (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 ForeignLibType
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 ForeignLibOption
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 BuildInfo
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 (Maybe a)
Instance of class: NFData of the constraint type NFData LibVersionInfo
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 forall a. NFData a => NFData (Maybe a)
External instance of the constraint type NFData Version
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 forall a. NFData a => NFData [a]
External instance of the constraint type NFData Char
Instance of class: Generic of the constraint type Generic ForeignLib
genericRnf

instance Semigroup ForeignLib where
  ForeignLib
a <> :: ForeignLib -> ForeignLib -> ForeignLib
<> ForeignLib
b = ForeignLib :: UnqualComponentName
-> ForeignLibType
-> [ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib
ForeignLib {
      foreignLibName :: UnqualComponentName
foreignLibName         = (ForeignLib -> UnqualComponentName) -> UnqualComponentName
combine'  ForeignLib -> UnqualComponentName
foreignLibName
    , foreignLibType :: ForeignLibType
foreignLibType         = (ForeignLib -> ForeignLibType) -> ForeignLibType
forall {a}. Monoid a => (ForeignLib -> a) -> a
External instance of the constraint type Monoid ForeignLibType
combine   ForeignLib -> ForeignLibType
foreignLibType
    , foreignLibOptions :: [ForeignLibOption]
foreignLibOptions      = (ForeignLib -> [ForeignLibOption]) -> [ForeignLibOption]
forall {a}. Monoid a => (ForeignLib -> a) -> a
External instance of the constraint type forall a. Monoid [a]
combine   ForeignLib -> [ForeignLibOption]
foreignLibOptions
    , foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo    = (ForeignLib -> BuildInfo) -> BuildInfo
forall {a}. Monoid a => (ForeignLib -> a) -> a
External instance of the constraint type Monoid BuildInfo
combine   ForeignLib -> BuildInfo
foreignLibBuildInfo
    , foreignLibVersionInfo :: Maybe LibVersionInfo
foreignLibVersionInfo  = (ForeignLib -> Maybe LibVersionInfo) -> Maybe LibVersionInfo
forall {t}. (ForeignLib -> t) -> t
combine'' ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo
    , foreignLibVersionLinux :: Maybe Version
foreignLibVersionLinux = (ForeignLib -> Maybe Version) -> Maybe Version
forall {t}. (ForeignLib -> t) -> t
combine'' ForeignLib -> Maybe Version
foreignLibVersionLinux
    , foreignLibModDefFile :: [FilePath]
foreignLibModDefFile   = (ForeignLib -> [FilePath]) -> [FilePath]
forall {a}. Monoid a => (ForeignLib -> a) -> a
External instance of the constraint type forall a. Monoid [a]
combine   ForeignLib -> [FilePath]
foreignLibModDefFile
    }
    where combine :: (ForeignLib -> a) -> a
combine ForeignLib -> a
field = ForeignLib -> a
field ForeignLib
a a -> a -> a
forall a. Monoid a => a -> a -> a
Evidence bound by a type signature of the constraint type Monoid a
`mappend` ForeignLib -> a
field ForeignLib
b
          combine' :: (ForeignLib -> UnqualComponentName) -> UnqualComponentName
combine' ForeignLib -> UnqualComponentName
field = case ( UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
field ForeignLib
a
                                , UnqualComponentName -> FilePath
unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ ForeignLib -> UnqualComponentName
field ForeignLib
b) of
            (FilePath
"", FilePath
_) -> ForeignLib -> UnqualComponentName
field ForeignLib
b
            (FilePath
_, FilePath
"") -> ForeignLib -> UnqualComponentName
field ForeignLib
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
"'"
          combine'' :: (ForeignLib -> t) -> t
combine'' ForeignLib -> t
field = ForeignLib -> t
field ForeignLib
b

instance Monoid ForeignLib where
  mempty :: ForeignLib
mempty = ForeignLib :: UnqualComponentName
-> ForeignLibType
-> [ForeignLibOption]
-> BuildInfo
-> Maybe LibVersionInfo
-> Maybe Version
-> [FilePath]
-> ForeignLib
ForeignLib {
      foreignLibName :: UnqualComponentName
foreignLibName         = UnqualComponentName
forall a. Monoid a => a
External instance of the constraint type Monoid UnqualComponentName
mempty
    , foreignLibType :: ForeignLibType
foreignLibType         = ForeignLibType
ForeignLibTypeUnknown
    , foreignLibOptions :: [ForeignLibOption]
foreignLibOptions      = []
    , foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo    = BuildInfo
forall a. Monoid a => a
External instance of the constraint type Monoid BuildInfo
mempty
    , foreignLibVersionInfo :: Maybe LibVersionInfo
foreignLibVersionInfo  = Maybe LibVersionInfo
forall a. Maybe a
Nothing
    , foreignLibVersionLinux :: Maybe Version
foreignLibVersionLinux = Maybe Version
forall a. Maybe a
Nothing
    , foreignLibModDefFile :: [FilePath]
foreignLibModDefFile   = []
    }
  mappend :: ForeignLib -> ForeignLib -> ForeignLib
mappend = ForeignLib -> ForeignLib -> ForeignLib
forall a. Semigroup a => a -> a -> a
Instance of class: Semigroup of the constraint type Semigroup ForeignLib
(<>)

-- | An empty foreign library.
emptyForeignLib :: ForeignLib
emptyForeignLib :: ForeignLib
emptyForeignLib = ForeignLib
forall a. Monoid a => a
Instance of class: Monoid of the constraint type Monoid ForeignLib
mempty

-- | Modules defined by a foreign library.
foreignLibModules :: ForeignLib -> [ModuleName]
foreignLibModules :: ForeignLib -> [ModuleName]
foreignLibModules = BuildInfo -> [ModuleName]
otherModules (BuildInfo -> [ModuleName])
-> (ForeignLib -> BuildInfo) -> ForeignLib -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> BuildInfo
foreignLibBuildInfo

-- | Is the foreign library shared?
foreignLibIsShared :: ForeignLib -> Bool
foreignLibIsShared :: ForeignLib -> Bool
foreignLibIsShared = ForeignLibType -> Bool
foreignLibTypeIsShared (ForeignLibType -> Bool)
-> (ForeignLib -> ForeignLibType) -> ForeignLib -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> ForeignLibType
foreignLibType

-- | Get a version number for a foreign library.
-- If we're on Linux, and a Linux version is specified, use that.
-- If we're on Linux, and libtool-style version-info is specified, translate
-- that field into appropriate version numbers.
-- Otherwise, this feature is unsupported so we don't return any version data.
foreignLibVersion :: ForeignLib -> OS -> [Int]
foreignLibVersion :: ForeignLib -> OS -> [Int]
foreignLibVersion ForeignLib
flib OS
Linux =
  case ForeignLib -> Maybe Version
foreignLibVersionLinux ForeignLib
flib of
    Just Version
v  -> Version -> [Int]
versionNumbers Version
v
    Maybe Version
Nothing ->
      case ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo ForeignLib
flib of
        Just LibVersionInfo
v' ->
          let (Int
major, Int
minor, Int
build) = LibVersionInfo -> (Int, Int, Int)
libVersionNumber LibVersionInfo
v'
          in [Int
major, Int
minor, Int
build]
        Maybe LibVersionInfo
Nothing -> []
foreignLibVersion ForeignLib
_ OS
_ = []