module Data.GI.CodeGen.Cabal
( genCabalProject
, cabalConfig
, setupHs
, tryPkgConfig
) where
import Control.Monad (forM_)
import Data.Maybe (fromMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Version (Version(..))
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text)
import Text.Read
import Data.GI.CodeGen.API (GIRInfo(..))
import Data.GI.CodeGen.Code
import Data.GI.CodeGen.Config (Config(..))
import Data.GI.CodeGen.Overrides (cabalPkgVersion)
import Data.GI.CodeGen.PkgConfig (pkgConfigGetVersion)
import qualified Data.GI.CodeGen.ProjectInfo as PI
import Data.GI.CodeGen.Util (padTo, tshow)
import Paths_haskell_gi (version)
cabalConfig :: Text
cabalConfig :: Text
cabalConfig = [Text] -> Text
T.unlines ["optimization: False"]
setupHs :: Text
setupHs :: Text
setupHs = [Text] -> Text
T.unlines ["#!/usr/bin/env runhaskell",
"import Distribution.Simple",
"main = defaultMain"]
haskellGIAPIVersion :: Int
haskellGIAPIVersion :: Int
haskellGIAPIVersion = ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> (Version -> [Int]) -> Version -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionBranch) Version
version
minorVersion :: [Int] -> Int
minorVersion :: [Int] -> Int
minorVersion (_:y :: Int
y:_) = Int
y
minorVersion v :: [Int]
v = [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ "Programming error: the haskell-gi version does not have at least two components: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Char]
forall a. Show a => a -> [Char]
show [Int]
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ "."
haskellGIMinor :: Int
haskellGIMinor :: Int
haskellGIMinor = [Int] -> Int
minorVersion (Version -> [Int]
versionBranch Version
version)
giModuleVersion :: Int -> Int -> Text
giModuleVersion :: Int -> Int -> Text
giModuleVersion major :: Int
major minor :: Int
minor =
(Text -> [Text] -> Text
T.intercalate "." ([Text] -> Text) -> ([Int] -> [Text]) -> [Int] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow) [Int
haskellGIAPIVersion, Int
major, Int
minor,
Int
haskellGIMinor]
giNextMinor :: Int -> Int -> Text
giNextMinor :: Int -> Int -> Text
giNextMinor major :: Int
major minor :: Int
minor = (Text -> [Text] -> Text
T.intercalate "." ([Text] -> Text) -> ([Int] -> [Text]) -> [Int] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
tshow)
[Int
haskellGIAPIVersion, Int
major, Int
minorInt -> Int -> Int
forall a. Num a => a -> a -> a
+1]
data PkgInfo = PkgInfo { PkgInfo -> Text
pkgName :: Text
, PkgInfo -> Int
pkgMajor :: Int
, PkgInfo -> Int
pkgMinor :: Int
} deriving Int -> PkgInfo -> [Char] -> [Char]
[PkgInfo] -> [Char] -> [Char]
PkgInfo -> [Char]
(Int -> PkgInfo -> [Char] -> [Char])
-> (PkgInfo -> [Char])
-> ([PkgInfo] -> [Char] -> [Char])
-> Show PkgInfo
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [PkgInfo] -> [Char] -> [Char]
$cshowList :: [PkgInfo] -> [Char] -> [Char]
show :: PkgInfo -> [Char]
$cshow :: PkgInfo -> [Char]
showsPrec :: Int -> PkgInfo -> [Char] -> [Char]
$cshowsPrec :: Int -> PkgInfo -> [Char] -> [Char]
Show
tryPkgConfig :: GIRInfo -> Bool -> M.Map Text Text -> IO (Either Text PkgInfo)
tryPkgConfig :: GIRInfo -> Bool -> Map Text Text -> IO (Either Text PkgInfo)
tryPkgConfig gir :: GIRInfo
gir verbose :: Bool
verbose overridenNames :: Map Text Text
overridenNames = do
let name :: Text
name = GIRInfo -> Text
girNSName GIRInfo
gir
version :: Text
version = GIRInfo -> Text
girNSVersion GIRInfo
gir
packages :: [Text]
packages = GIRInfo -> [Text]
girPCPackages GIRInfo
gir
Text
-> Text
-> [Text]
-> Bool
-> Map Text Text
-> IO (Maybe (Text, Text))
pkgConfigGetVersion Text
name Text
version [Text]
packages Bool
verbose Map Text Text
overridenNames IO (Maybe (Text, Text))
-> (Maybe (Text, Text) -> IO (Either Text PkgInfo))
-> IO (Either Text PkgInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just (n :: Text
n,v :: Text
v) ->
case Text -> Maybe (Int, Int)
readMajorMinor Text
v of
Just (major :: Int
major, minor :: Int
minor) ->
Either Text PkgInfo -> IO (Either Text PkgInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text PkgInfo -> IO (Either Text PkgInfo))
-> Either Text PkgInfo -> IO (Either Text PkgInfo)
forall a b. (a -> b) -> a -> b
$ PkgInfo -> Either Text PkgInfo
forall a b. b -> Either a b
Right (PkgInfo :: Text -> Int -> Int -> PkgInfo
PkgInfo { pkgName :: Text
pkgName = Text
n
, pkgMajor :: Int
pkgMajor = Int
major
, pkgMinor :: Int
pkgMinor = Int
minor})
Nothing -> Either Text PkgInfo -> IO (Either Text PkgInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text PkgInfo -> IO (Either Text PkgInfo))
-> Either Text PkgInfo -> IO (Either Text PkgInfo)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text PkgInfo
forall a b. a -> Either a b
Left (Text -> Either Text PkgInfo) -> Text -> Either Text PkgInfo
forall a b. (a -> b) -> a -> b
$ "Cannot parse version \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"\" for module " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
Nothing -> Either Text PkgInfo -> IO (Either Text PkgInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text PkgInfo -> IO (Either Text PkgInfo))
-> Either Text PkgInfo -> IO (Either Text PkgInfo)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text PkgInfo
forall a b. a -> Either a b
Left (Text -> Either Text PkgInfo) -> Text -> Either Text PkgInfo
forall a b. (a -> b) -> a -> b
$
"Could not determine the pkg-config name corresponding to \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\".\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
"Try adding an override with the proper package name:\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "pkg-config-name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " [matching pkg-config name here]"
readMajorMinor :: Text -> Maybe (Int, Int)
readMajorMinor :: Text -> Maybe (Int, Int)
readMajorMinor version :: Text
version =
case Text -> Text -> [Text]
T.splitOn "." Text
version of
(a :: Text
a:b :: Text
b:_) -> (,) (Int -> Int -> (Int, Int))
-> Maybe Int -> Maybe (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
a) Maybe (Int -> (Int, Int)) -> Maybe Int -> Maybe (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe (Text -> [Char]
T.unpack Text
b)
_ -> Maybe (Int, Int)
forall a. Maybe a
Nothing
genCabalProject :: (GIRInfo, PkgInfo) -> [(GIRInfo, PkgInfo)] ->
[Text] -> BaseVersion -> CodeGen ()
genCabalProject :: (GIRInfo, PkgInfo)
-> [(GIRInfo, PkgInfo)] -> [Text] -> BaseVersion -> CodeGen ()
genCabalProject (gir :: GIRInfo
gir, PkgInfo {pkgName :: PkgInfo -> Text
pkgName = Text
pcName, pkgMajor :: PkgInfo -> Int
pkgMajor = Int
major,
pkgMinor :: PkgInfo -> Int
pkgMinor = Int
minor})
deps :: [(GIRInfo, PkgInfo)]
deps exposedModules :: [Text]
exposedModules minBaseVersion :: BaseVersion
minBaseVersion = do
Config
cfg <- BaseCodeGen e Config
CodeGen Config
config
let name :: Text
name = GIRInfo -> Text
girNSName GIRInfo
gir
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "-- Autogenerated, do not edit."
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "name:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "gi-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower Text
name
let cabalVersion :: Text
cabalVersion = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Text
giModuleVersion Int
major Int
minor)
(Overrides -> Maybe Text
cabalPkgVersion (Overrides -> Maybe Text) -> Overrides -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Config -> Overrides
overrides Config
cfg)
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "version:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cabalVersion
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "synopsis:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " bindings"
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "description:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Bindings for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ", autogenerated by haskell-gi."
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "homepage:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
PI.homepage
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "license:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
PI.license
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "license-file:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "LICENSE"
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "author:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
PI.authors
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "maintainer:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
PI.maintainers
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "category:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
PI.category
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "build-type:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "Simple"
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "cabal-version:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">=1.10"
BaseCodeGen e ()
CodeGen ()
blank
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "library"
BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "default-language:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
PI.defaultLanguage
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "default-extensions:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate ", " [Text]
PI.defaultExtensions
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "other-extensions:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text -> [Text] -> Text
T.intercalate ", " [Text]
PI.otherExtensions
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "ghc-options:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate " " [Text]
PI.ghcOptions
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "exposed-modules:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. [a] -> a
head [Text]
exposedModules
[Text] -> (Text -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Text] -> [Text]
forall a. [a] -> [a]
tail [Text]
exposedModules) ((Text -> BaseCodeGen e ()) -> BaseCodeGen e ())
-> (Text -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ \mod :: Text
mod ->
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mod
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padTo 20 "pkgconfig-depends:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pcName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " >= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Int -> Text
forall a. Show a => a -> Text
tshow Int
major Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
minor
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "build-depends:"
BaseCodeGen e () -> BaseCodeGen e ()
forall e a. BaseCodeGen e a -> BaseCodeGen e a
indent (BaseCodeGen e () -> BaseCodeGen e ())
-> BaseCodeGen e () -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ do
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "haskell-gi-base >= "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
haskellGIAPIVersion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
haskellGIMinor
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " && < " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
haskellGIAPIVersion Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ","
[(GIRInfo, PkgInfo)]
-> ((GIRInfo, PkgInfo) -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(GIRInfo, PkgInfo)]
deps (((GIRInfo, PkgInfo) -> BaseCodeGen e ()) -> BaseCodeGen e ())
-> ((GIRInfo, PkgInfo) -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ \(dep :: GIRInfo
dep, PkgInfo _ depMajor :: Int
depMajor depMinor :: Int
depMinor) -> do
let depName :: Text
depName = GIRInfo -> Text
girNSName GIRInfo
dep
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "gi-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.toLower Text
depName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " >= "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Text
giModuleVersion Int
depMajor Int
depMinor
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " && < "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> Text
giNextMinor Int
depMajor Int
depMinor
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ","
[Text] -> (Text -> BaseCodeGen e ()) -> BaseCodeGen e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
PI.standardDeps (Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ())
-> (Text -> Text) -> Text -> BaseCodeGen e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ","))
Text -> BaseCodeGen e ()
Text -> CodeGen ()
line (Text -> BaseCodeGen e ()) -> Text -> BaseCodeGen e ()
forall a b. (a -> b) -> a -> b
$ "base >= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BaseVersion -> Text
showBaseVersion BaseVersion
minBaseVersion Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " && <5"