ForeignLib.hs

{-# 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
      foreignLibName       :: UnqualComponentName
      -- | What kind of foreign library is this (static or dynamic).
    , foreignLibType       :: ForeignLibType
      -- | What options apply to this foreign library (e.g., are we
      -- merging in all foreign dependencies.)
    , foreignLibOptions    :: [ForeignLibOption]
      -- | Build information for this foreign library.
    , foreignLibBuildInfo  :: BuildInfo
      -- | Libtool-style version-info data to compute library version.
      -- Refer to the libtool documentation on the
      -- current:revision:age versioning scheme.
    , foreignLibVersionInfo :: Maybe LibVersionInfo
      -- | Linux library 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)
    , foreignLibModDefFile :: [FilePath]
    }
    deriving (Generic, Show, Read, Eq, Typeable, Data)

data LibVersionInfo = LibVersionInfo Int Int Int deriving (Data, Eq, Generic, Typeable)

instance Ord LibVersionInfo where
    LibVersionInfo c r _ `compare` LibVersionInfo c' r' _ =
        case c `compare` c' of
            EQ -> r `compare` r'
            e  -> e

instance Show LibVersionInfo where
    showsPrec d (LibVersionInfo c r a) = showParen (d > 10)
        $ showString "mkLibVersionInfo "
        . showsPrec 11 (c,r,a)

instance Read LibVersionInfo where
    readPrec = Read.parens $ do
        Read.Ident "mkLibVersionInfo" <- Read.lexP
        t <- Read.step Read.readPrec
        return (mkLibVersionInfo t)

instance Binary LibVersionInfo
instance Structured LibVersionInfo
instance NFData LibVersionInfo where rnf = genericRnf

instance Pretty LibVersionInfo where
    pretty (LibVersionInfo c r a)
      = Disp.hcat $ Disp.punctuate (Disp.char ':') $ map Disp.int [c,r,a]

instance Parsec LibVersionInfo where
    parsec = do
        c <- P.integral
        (r, a) <- P.option (0,0) $ do
            _ <- P.char ':'
            r <- P.integral
            a <- P.option 0 $ do
                _ <- P.char ':'
                P.integral
            return (r,a)
        return $ mkLibVersionInfo (c,r,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 (c,r,a) = LibVersionInfo c r a

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

-- | Given a version-info field, produce a @major.minor.build@ version
libVersionNumber :: LibVersionInfo -> (Int, Int, Int)
libVersionNumber (LibVersionInfo c r a) = (c-a , a , r)

-- | Given a version-info field, return @"major.minor.build"@ as a
-- 'String'
libVersionNumberShow :: LibVersionInfo -> String
libVersionNumberShow v =
    let (major, minor, build) = libVersionNumber v
    in show major ++ "." ++ show minor ++ "." ++ show build

-- | Return the @major@ version of a version-info field.
libVersionMajor :: LibVersionInfo -> Int
libVersionMajor (LibVersionInfo c _ a) = c-a

instance L.HasBuildInfo ForeignLib where
    buildInfo f l = (\x -> l { foreignLibBuildInfo = x }) <$> f (foreignLibBuildInfo l)

instance Binary ForeignLib
instance Structured ForeignLib
instance NFData ForeignLib where rnf = genericRnf

instance Semigroup ForeignLib where
  a <> b = ForeignLib {
      foreignLibName         = combine'  foreignLibName
    , foreignLibType         = combine   foreignLibType
    , foreignLibOptions      = combine   foreignLibOptions
    , foreignLibBuildInfo    = combine   foreignLibBuildInfo
    , foreignLibVersionInfo  = combine'' foreignLibVersionInfo
    , foreignLibVersionLinux = combine'' foreignLibVersionLinux
    , foreignLibModDefFile   = combine   foreignLibModDefFile
    }
    where combine field = field a `mappend` field b
          combine' field = case ( unUnqualComponentName $ field a
                                , unUnqualComponentName $ field b) of
            ("", _) -> field b
            (_, "") -> field a
            (x, y) -> error $ "Ambiguous values for executable field: '"
                                  ++ x ++ "' and '" ++ y ++ "'"
          combine'' field = field b

instance Monoid ForeignLib where
  mempty = ForeignLib {
      foreignLibName         = mempty
    , foreignLibType         = ForeignLibTypeUnknown
    , foreignLibOptions      = []
    , foreignLibBuildInfo    = mempty
    , foreignLibVersionInfo  = Nothing
    , foreignLibVersionLinux = Nothing
    , foreignLibModDefFile   = []
    }
  mappend = (<>)

-- | An empty foreign library.
emptyForeignLib :: ForeignLib
emptyForeignLib = mempty

-- | Modules defined by a foreign library.
foreignLibModules :: ForeignLib -> [ModuleName]
foreignLibModules = otherModules . foreignLibBuildInfo

-- | Is the foreign library shared?
foreignLibIsShared :: ForeignLib -> Bool
foreignLibIsShared = foreignLibTypeIsShared . 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 flib Linux =
  case foreignLibVersionLinux flib of
    Just v  -> versionNumbers v
    Nothing ->
      case foreignLibVersionInfo flib of
        Just v' ->
          let (major, minor, build) = libVersionNumber v'
          in [major, minor, build]
        Nothing -> []
foreignLibVersion _ _ = []