-- |
--
--  Example:
--
--  @
--      main :: IO ()
--      main =
--        defaultMainWithHooks $
--          simpleUserHooks
--            & addHook
--              (mkSettings "nix-store")
--                { macroName = "NIX",
--                  flagPrefixName = "nix"
--                }
--  @
--
--  The above will look for a pkg-config package @nix-store@, and then
--
--    * Define CPP, C and C++ macros
--
--        * @NIX_MAJOR@, an integer
--        * @NIX_MINOR@, an integer
--        * @NIX_PATCH@, an integer; 0 if missing
--        * @NIX_IS_AT_LEAST(major,minor,patch)@, returning true when the discovered version @>=@ the specified version
--
--    * Set or unset flags like `nix-2_4` so that the flag is true when the
--      discovered version is at least the version in the flag's name.
module Distribution.PkgConfigVersionHook
  ( addHook,
    mkSettings,
    Settings (..),
    composeConfHook,
  )
where

import Control.Lens ((%~), (^.))
import Control.Monad (when)
import qualified Data.Char as C
import Data.Foldable (toList)
import Data.Function ((&))
import qualified Data.List as L
import Distribution.Simple
import Distribution.Simple.Setup (configConfigurationsFlags)
import Distribution.Types.BuildInfo.Lens (ccOptions, cppOptions, cxxOptions)
import Distribution.Types.Flag (flagName, mkFlagAssignment, mkFlagName, unFlagName)
import Distribution.Types.GenericPackageDescription.Lens
  ( allCondTrees,
    condBenchmarks,
    condExecutables,
    condForeignLibs,
    condLibrary,
    condSubLibraries,
    condTestSuites,
    genPackageFlags,
  )
import System.IO (hPutStrLn, stderr)
import System.Process (readProcess)
import qualified Text.ParserCombinators.ReadP as P
import Prelude hiding (log)

-- | Hook into Cabal to provide pkg-config metadata. Can be applied multiple
-- times to support multiple packages.
addHook :: Settings -> UserHooks -> UserHooks
addHook :: Settings -> UserHooks -> UserHooks
addHook Settings
settings UserHooks
hooks = UserHooks
hooks {confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook = Settings
-> ((GenericPackageDescription, HookedBuildInfo)
    -> ConfigFlags -> IO LocalBuildInfo)
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
forall b b.
Settings
-> ((GenericPackageDescription, b) -> ConfigFlags -> IO b)
-> (GenericPackageDescription, b)
-> ConfigFlags
-> IO b
composeConfHook Settings
settings (UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
confHook UserHooks
hooks)}

-- | How the metadata for a pkg-config package should be made available to the
-- cabal file.
data Settings = Settings
  { -- | Name of the package; used for querying pkg-config.
    Settings -> String
pkgConfigName :: String,
    -- | Name to use in the Haskell CPP and C/C++ preprocessor macros.
    --
    -- For example, `pkgConfigName = "FOO"` will set the macros
    --
    --  * @FOO_MAJOR@
    --
    --  * @FOO_MINOR@
    --
    --  * @FOO_PATCH@
    --
    --  * @FOO_IS_AT_LEAST(major, minor, patch)@
    Settings -> String
macroName :: String,
    -- | Name to use when setting flag values in the cabal file.
    --
    -- Flags named with this prefix, followed by a dash, followed by a major version number, an underscore and a minor version number will be set when the detected package is at least that version.
    Settings -> String
flagPrefixName :: String
  }

-- | Derive a default 'Settings' value from just a pkg-config package name.
mkSettings :: String -> Settings
mkSettings :: String -> Settings
mkSettings String
name =
  Settings :: String -> String -> String -> Settings
Settings
    { pkgConfigName :: String
pkgConfigName = String
name,
      macroName :: String
macroName = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> case Char
x of Char
'-' -> Char
'_') String
name,
      flagPrefixName :: String
flagPrefixName = String
name
    }

-- | Extend the value of 'confHook'. It's what powers 'addHook'.
composeConfHook :: Settings
-> ((GenericPackageDescription, b) -> ConfigFlags -> IO b)
-> (GenericPackageDescription, b)
-> ConfigFlags
-> IO b
composeConfHook Settings
settings (GenericPackageDescription, b) -> ConfigFlags -> IO b
origHook = \(GenericPackageDescription
genericPackageDescription, b
hookedBuildInfo) ConfigFlags
confFlags -> do
  (Int
actualMajor, Int
actualMinor, Int
actualPatch) <- String -> IO (Int, Int, Int)
getPkgConfigPackageVersion (Settings -> String
pkgConfigName Settings
settings)

  let defines :: [String]
defines =
        [ String
"-D" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Settings -> String
macroName Settings
settings String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_MAJOR=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualMajor,
          String
"-D" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Settings -> String
macroName Settings
settings String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_MINOR=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualMinor,
          String
"-D" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Settings -> String
macroName Settings
settings String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_PATCH=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualPatch,
          String
"-D" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Settings -> String
macroName Settings
settings String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_IS_AT_LEAST(a,b,c)=(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualMajor String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">a||(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualMajor String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"==a&&(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualMinor String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">b||(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualMinor String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"==b&&" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actualPatch String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">=c))))"
        ]
      extraFlags :: [(FlagName, Bool)]
extraFlags =
        [ (String -> FlagName
mkFlagName (Settings -> String
flagPrefixName Settings
settings String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
major String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minor), (Int
actualMajor, Int
actualMinor) (Int, Int) -> (Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
major, Int
minor))
          | Flag
declaredFlag <- GenericPackageDescription
genericPackageDescription GenericPackageDescription
-> Getting [Flag] GenericPackageDescription [Flag] -> [Flag]
forall s a. s -> Getting a s a -> a
^. Getting [Flag] GenericPackageDescription [Flag]
Lens' GenericPackageDescription [Flag]
genPackageFlags,
            let rawName :: String
rawName = FlagName -> String
unFlagName (FlagName -> String) -> FlagName -> String
forall a b. (a -> b) -> a -> b
$ Flag -> FlagName
flagName Flag
declaredFlag,
            String
rawVersion <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
L.stripPrefix (Settings -> String
flagPrefixName Settings
settings String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-") String
rawName Maybe String -> (Maybe String -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& Maybe String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList,
            [Int
major, Int
minor] <- ReadP [Int] -> String -> Maybe [Int]
forall a. ReadP a -> String -> Maybe a
unambiguously ReadP [Int]
parseFlagVersion String
rawVersion Maybe [Int] -> (Maybe [Int] -> [[Int]]) -> [[Int]]
forall a b. a -> (a -> b) -> b
& Maybe [Int] -> [[Int]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
        ]
      setDefines :: ((a -> Identity a) -> b -> Identity b) -> b -> b
setDefines (a -> Identity a) -> b -> Identity b
comp b
x =
        b
x
          b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
comp ((a -> Identity a) -> b -> Identity b)
-> (([String] -> Identity [String]) -> a -> Identity a)
-> ([String] -> Identity [String])
-> b
-> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Identity [String]) -> a -> Identity a
forall a. HasBuildInfo a => Lens' a [String]
cppOptions (([String] -> Identity [String]) -> b -> Identity b)
-> ([String] -> [String]) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
defines)
          b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
comp ((a -> Identity a) -> b -> Identity b)
-> (([String] -> Identity [String]) -> a -> Identity a)
-> ([String] -> Identity [String])
-> b
-> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Identity [String]) -> a -> Identity a
forall a. HasBuildInfo a => Lens' a [String]
ccOptions (([String] -> Identity [String]) -> b -> Identity b)
-> ([String] -> [String]) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
defines)
          b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> b -> Identity b
comp ((a -> Identity a) -> b -> Identity b)
-> (([String] -> Identity [String]) -> a -> Identity a)
-> ([String] -> Identity [String])
-> b
-> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Identity [String]) -> a -> Identity a
forall a. HasBuildInfo a => Lens' a [String]
cxxOptions (([String] -> Identity [String]) -> b -> Identity b)
-> ([String] -> [String]) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
defines)
      genericPackageDescription' :: GenericPackageDescription
genericPackageDescription' =
        GenericPackageDescription
genericPackageDescription
          GenericPackageDescription
-> (GenericPackageDescription -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& ((Library -> Identity Library)
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> GenericPackageDescription -> GenericPackageDescription
forall a b.
HasBuildInfo a =>
((a -> Identity a) -> b -> Identity b) -> b -> b
setDefines (LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
  (Maybe (CondTree ConfVar [Dependency] Library))
Lens'
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
condLibrary LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  (Maybe (CondTree ConfVar [Dependency] Library))
  (Maybe (CondTree ConfVar [Dependency] Library))
-> ((Library -> Identity Library)
    -> Maybe (CondTree ConfVar [Dependency] Library)
    -> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> (Library -> Identity Library)
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] Library
 -> Identity (CondTree ConfVar [Dependency] Library))
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Identity (Maybe (CondTree ConfVar [Dependency] Library))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((CondTree ConfVar [Dependency] Library
  -> Identity (CondTree ConfVar [Dependency] Library))
 -> Maybe (CondTree ConfVar [Dependency] Library)
 -> Identity (Maybe (CondTree ConfVar [Dependency] Library)))
-> ((Library -> Identity Library)
    -> CondTree ConfVar [Dependency] Library
    -> Identity (CondTree ConfVar [Dependency] Library))
-> (Library -> Identity Library)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Identity (Maybe (CondTree ConfVar [Dependency] Library))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Identity Library)
-> CondTree ConfVar [Dependency] Library
-> Identity (CondTree ConfVar [Dependency] Library)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
          GenericPackageDescription
-> (GenericPackageDescription -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& ((Library -> Identity Library)
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> GenericPackageDescription -> GenericPackageDescription
forall a b.
HasBuildInfo a =>
((a -> Identity a) -> b -> Identity b) -> b -> b
setDefines (LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> ((Library -> Identity Library)
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
    -> Identity
         [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> (Library -> Identity Library)
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] Library)
  -> Identity
       (UnqualComponentName, CondTree ConfVar [Dependency] Library))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
 -> Identity
      [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> ((Library -> Identity Library)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> Identity
         (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> (Library -> Identity Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] Library
 -> Identity (CondTree ConfVar [Dependency] Library))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] Library)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((CondTree ConfVar [Dependency] Library
  -> Identity (CondTree ConfVar [Dependency] Library))
 -> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> ((Library -> Identity Library)
    -> CondTree ConfVar [Dependency] Library
    -> Identity (CondTree ConfVar [Dependency] Library))
-> (Library -> Identity Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] Library)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Library -> Identity Library)
-> CondTree ConfVar [Dependency] Library
-> Identity (CondTree ConfVar [Dependency] Library)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
          GenericPackageDescription
-> (GenericPackageDescription -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& ((ForeignLib -> Identity ForeignLib)
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> GenericPackageDescription -> GenericPackageDescription
forall a b.
HasBuildInfo a =>
((a -> Identity a) -> b -> Identity b) -> b -> b
setDefines (LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
-> ((ForeignLib -> Identity ForeignLib)
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] ForeignLib)]
    -> Identity
         [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> (ForeignLib -> Identity ForeignLib)
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
  -> Identity
       (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] ForeignLib)]
 -> Identity
      [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)])
-> ((ForeignLib -> Identity ForeignLib)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
    -> Identity
         (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
-> (ForeignLib -> Identity ForeignLib)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] ForeignLib
 -> Identity (CondTree ConfVar [Dependency] ForeignLib))
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((CondTree ConfVar [Dependency] ForeignLib
  -> Identity (CondTree ConfVar [Dependency] ForeignLib))
 -> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
-> ((ForeignLib -> Identity ForeignLib)
    -> CondTree ConfVar [Dependency] ForeignLib
    -> Identity (CondTree ConfVar [Dependency] ForeignLib))
-> (ForeignLib -> Identity ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ForeignLib -> Identity ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
-> Identity (CondTree ConfVar [Dependency] ForeignLib)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
          GenericPackageDescription
-> (GenericPackageDescription -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& ((Executable -> Identity Executable)
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> GenericPackageDescription -> GenericPackageDescription
forall a b.
HasBuildInfo a =>
((a -> Identity a) -> b -> Identity b) -> b -> b
setDefines (LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
condExecutables LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
-> ((Executable -> Identity Executable)
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)]
    -> Identity
         [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> (Executable -> Identity Executable)
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
  -> Identity
       (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
 -> [(UnqualComponentName,
      CondTree ConfVar [Dependency] Executable)]
 -> Identity
      [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)])
-> ((Executable -> Identity Executable)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> Identity
         (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
-> (Executable -> Identity Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] Executable
 -> Identity (CondTree ConfVar [Dependency] Executable))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((CondTree ConfVar [Dependency] Executable
  -> Identity (CondTree ConfVar [Dependency] Executable))
 -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
-> ((Executable -> Identity Executable)
    -> CondTree ConfVar [Dependency] Executable
    -> Identity (CondTree ConfVar [Dependency] Executable))
-> (Executable -> Identity Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Executable -> Identity Executable)
-> CondTree ConfVar [Dependency] Executable
-> Identity (CondTree ConfVar [Dependency] Executable)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
          GenericPackageDescription
-> (GenericPackageDescription -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& ((TestSuite -> Identity TestSuite)
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> GenericPackageDescription -> GenericPackageDescription
forall a b.
HasBuildInfo a =>
((a -> Identity a) -> b -> Identity b) -> b -> b
setDefines (LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> ((TestSuite -> Identity TestSuite)
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
    -> Identity
         [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> (TestSuite -> Identity TestSuite)
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
  -> Identity
       (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> Identity
      [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)])
-> ((TestSuite -> Identity TestSuite)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> Identity
         (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
-> (TestSuite -> Identity TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] TestSuite
 -> Identity (CondTree ConfVar [Dependency] TestSuite))
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((CondTree ConfVar [Dependency] TestSuite
  -> Identity (CondTree ConfVar [Dependency] TestSuite))
 -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
-> ((TestSuite -> Identity TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite
    -> Identity (CondTree ConfVar [Dependency] TestSuite))
-> (TestSuite -> Identity TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestSuite -> Identity TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> Identity (CondTree ConfVar [Dependency] TestSuite)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)
          GenericPackageDescription
-> (GenericPackageDescription -> GenericPackageDescription)
-> GenericPackageDescription
forall a b. a -> (a -> b) -> b
& ((Benchmark -> Identity Benchmark)
 -> GenericPackageDescription -> Identity GenericPackageDescription)
-> GenericPackageDescription -> GenericPackageDescription
forall a b.
HasBuildInfo a =>
((a -> Identity a) -> b -> Identity b) -> b -> b
setDefines (LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
Lens'
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks LensLike
  Identity
  GenericPackageDescription
  GenericPackageDescription
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
  [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> ((Benchmark -> Identity Benchmark)
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
    -> Identity
         [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> (Benchmark -> Identity Benchmark)
-> GenericPackageDescription
-> Identity GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
  -> Identity
       (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
 -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> Identity
      [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)])
-> ((Benchmark -> Identity Benchmark)
    -> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> Identity
         (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
-> (Benchmark -> Identity Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> Identity
     [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CondTree ConfVar [Dependency] Benchmark
 -> Identity (CondTree ConfVar [Dependency] Benchmark))
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((CondTree ConfVar [Dependency] Benchmark
  -> Identity (CondTree ConfVar [Dependency] Benchmark))
 -> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> Identity
      (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
-> ((Benchmark -> Identity Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark
    -> Identity (CondTree ConfVar [Dependency] Benchmark))
-> (Benchmark -> Identity Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Identity
     (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Benchmark -> Identity Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> Identity (CondTree ConfVar [Dependency] Benchmark)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse)

      configConfigurationsFlags' :: FlagAssignment
configConfigurationsFlags' = ConfigFlags -> FlagAssignment
configConfigurationsFlags ConfigFlags
confFlags FlagAssignment -> FlagAssignment -> FlagAssignment
forall a. Monoid a => a -> a -> a
`mappend` [(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment [(FlagName, Bool)]
extraFlags
      confFlags' :: ConfigFlags
confFlags' =
        ConfigFlags
confFlags
          { configConfigurationsFlags :: FlagAssignment
configConfigurationsFlags = FlagAssignment
configConfigurationsFlags'
          }
  (GenericPackageDescription, b) -> ConfigFlags -> IO b
origHook (GenericPackageDescription
genericPackageDescription', b
hookedBuildInfo) ConfigFlags
confFlags'

parseVersion :: P.ReadP [Int]
parseVersion :: ReadP [Int]
parseVersion = do
  (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. Read a => String -> a
read ([String] -> [Int]) -> ReadP [String] -> ReadP [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
P.many1 ((Char -> Bool) -> ReadP Char
P.satisfy Char -> Bool
C.isDigit) ReadP String -> ReadP Char -> ReadP [String]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`P.sepBy` Char -> ReadP Char
P.char Char
'.'

parseFlagVersion :: P.ReadP [Int]
parseFlagVersion :: ReadP [Int]
parseFlagVersion =
  (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. Read a => String -> a
read ([String] -> [Int]) -> ReadP [String] -> ReadP [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    ReadP Char -> ReadP String
forall a. ReadP a -> ReadP [a]
P.many1 ((Char -> Bool) -> ReadP Char
P.satisfy Char -> Bool
C.isDigit) ReadP String -> ReadP Char -> ReadP [String]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
`P.sepBy` Char -> ReadP Char
P.char Char
'_'

unambiguously :: P.ReadP a -> String -> Maybe a
unambiguously :: ReadP a -> String -> Maybe a
unambiguously ReadP a
p String
s =
  case ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
a, String
x) -> String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"") ([(a, String)] -> [(a, String)]) -> [(a, String)] -> [(a, String)]
forall a b. (a -> b) -> a -> b
$ ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
P.readP_to_S ReadP a
p String
s of
    [(a
v, String
_)] -> a -> Maybe a
forall a. a -> Maybe a
Just a
v
    [(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing

getPkgConfigPackageVersion :: String -> IO (Int, Int, Int)
getPkgConfigPackageVersion :: String -> IO (Int, Int, Int)
getPkgConfigPackageVersion String
pkgName = do
  String
s <- String -> [String] -> String -> IO String
readProcess String
"pkg-config" [String
"--modversion", String
pkgName] String
""
  case (([Int], String) -> Int) -> [([Int], String)] -> [([Int], String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (\([Int]
_, String
s) -> String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) ([([Int], String)] -> [([Int], String)])
-> [([Int], String)] -> [([Int], String)]
forall a b. (a -> b) -> a -> b
$ ReadP [Int] -> ReadS [Int]
forall a. ReadP a -> ReadS a
P.readP_to_S ReadP [Int]
parseVersion String
s of
    [] -> String -> IO (Int, Int, Int)
forall a. HasCallStack => String -> a
error (String
"Could not parse version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" returned by pkg-config for package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkgName)
    ([Int]
v, String
r) : [([Int], String)]
_ -> do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile Char -> Bool
C.isSpace String
r String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
log (String
"ignoring trailing text " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of pkg-config package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pkgName)
      let v' :: [Int]
v' = [Int]
v [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
L.repeat Int
0
      (Int, Int, Int) -> IO (Int, Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Int]
v' [Int] -> Int -> Int
forall a. [a] -> Int -> a
L.!! Int
0, [Int]
v' [Int] -> Int -> Int
forall a. [a] -> Int -> a
L.!! Int
1, [Int]
v' [Int] -> Int -> Int
forall a. [a] -> Int -> a
L.!! Int
2)

-- Should probably use a Cabal function?
log :: String -> IO ()
log = Handle -> String -> IO ()
hPutStrLn Handle
stderr