set up haskell bindings for c lib

11 files changed, 530 insertions, 0 deletions

diff --git a/lib/buildgen.cabal b/lib/buildgen.cabal
new file mode 100644
index 0000000..b7789c5
--- /dev/null
+++ b/lib/buildgen.cabal
@@ -0,0 +1,31 @@
+name:                build-tools
+version:             0.0.1
+synopsis:            Utils for generating bindings, for internal use
+description:         Utils for generating bindings, for internal use
+homepage:            https://github.com/haskell-gi/haskell-gi
+license:             LGPL-2.1
+                     -- or above
+author:              Iñaki García Etxebarria
+maintainer:          Iñaki García Etxebarria (garetxe@gmail.com)
+stability:           Experimental
+category:            Development
+build-type:          Simple
+cabal-version:       2.0
+
+executable buildgen
+  main-is:              buildgen.hs
+  default-language:     Haskell2010
+  default-extensions:   CPP
+
+  build-depends:        base >= 4.7 && < 5,
+                        haskell-gi >= 0.20,
+                        text >= 1.2,
+                        filepath >= 1.4,
+                        bytestring >= 0.10,
+                        directory >= 1.3,
+                        containers,
+                        aeson,
+                        aeson-pretty,
+                        process ^>= 1.6.0
+
+  ghc-options:         -Wall
diff --git a/lib/buildgen.hs b/lib/buildgen.hs
new file mode 100644
index 0000000..6cbdf0b
--- /dev/null
+++ b/lib/buildgen.hs
@@ -0,0 +1,268 @@
+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
+
+-- Based on:
+-- https://raw.githubusercontent.com/haskell-gi/haskell-gi/refs/heads/master/bindings/genBuildInfo.hs
+
+-- Generate the cabal info for the given subdirectories, assuming
+-- the existence of appropriate "pkg.info" files.
+
+import System.Directory (createDirectory, doesPathExist, makeAbsolute)
+import System.Environment (getArgs)
+import System.FilePath ((</>), (<.>), takeBaseName, takeDirectory)
+import System.IO (hPutStrLn, stderr, hFlush, stdout)
+import System.Exit (exitFailure)
+
+#if !MIN_VERSION_base(4,13,0)
+import Data.Monoid ((<>))
+#endif
+
+import GHC.Generics
+import qualified Data.Aeson as A
+import qualified Data.ByteString as B
+import Data.Maybe (fromMaybe, fromJust)
+import qualified Data.Set as S
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text as T
+import Data.Text (Text)
+
+import Data.GI.CodeGen.CabalHooks (configureDryRun)
+import qualified Data.GI.CodeGen.ProjectInfo as PI
+import Data.GI.CodeGen.Util (ucFirst)
+
+import qualified Data.ByteString.Lazy as LB
+
+data ProjectInfo = ProjectInfo {
+      name              :: T.Text -- ^ Name of the haskell package
+    , version           :: T.Text -- ^ Its version
+    , author            :: Maybe T.Text -- ^ Auhor. If not specified the
+                                        -- current maintainer (from
+                                        -- Data.GI.CodeGen.ProjectInfo)
+                                        -- will be used.
+    , synopsis          :: T.Text
+    , description       :: T.Text
+    , giDepends         :: [T.Text] -- ^ dependencies on other
+                                    -- haskell-gi generated modules.
+    , baseVersion       :: T.Text -- ^ Constraint on base for this module.
+
+    , girName           :: T.Text         -- ^ GIR file (without version)
+    , girVersion        :: T.Text         -- ^ Its version
+    , girOverrides      :: Maybe FilePath   -- ^ Possibly an overrides file
+    , compat            :: Maybe T.Text
+    } deriving (Show, Generic)
+
+instance A.FromJSON ProjectInfo
+instance A.ToJSON ProjectInfo
+
+readGIRInfo :: FilePath -> IO ProjectInfo
+readGIRInfo fname = do
+  buf <- LB.readFile fname
+  case A.eitherDecode buf of
+    Left err -> error ("Could not parse \"" <> fname <> "\": " <> err)
+    Right info -> return info
+
+writeCabal :: FilePath -> FilePath -> ProjectInfo -> [Text] -> IO ()
+writeCabal fname lib info exposed =
+    B.writeFile fname $ TE.encodeUtf8 $ T.unlines $
+       [ "name:                 " <> name info
+       , "version:              " <> version info
+       , "synopsis:             " <> synopsis info
+       , "description:          " <> description info
+       , "homepage:             " <> PI.homepage
+       , "license:              " <> PI.license
+       , "author:               " <> fromMaybe PI.maintainers (author info)
+       , "maintainer:           " <> PI.maintainers
+       , "category:             " <> PI.category
+       , "build-type:           Custom"
+       , "cabal-version:        2.0"
+       , let commonFiles = "README.md ChangeLog.md stack.yaml"
+         in case girOverrides info of
+           Nothing -> "\nextra-source-files: " <> commonFiles <> "\n"
+           Just ov -> "\nextra-source-files: " <> commonFiles <> " "
+                      <> T.pack ov <> "\n"
+       , "custom-setup"
+       , "      setup-depends: " <>
+         T.intercalate ",\n                     "
+           ([ "base >= 4.11 && < 5"
+            , "Cabal >= 1.24 && < 4"
+            , "haskell-gi >= 0.26.14 && < 0.27"]
+            <> giDepends info)
+       , ""
+       , "library"
+       , "      default-language: " <> PI.defaultLanguage
+       , "      default-extensions: " <> T.intercalate ", " PI.defaultExtensions
+       , "      other-extensions: " <> T.intercalate ", " PI.otherExtensions
+       , "      ghc-options: " <> T.intercalate " " PI.ghcOptions
+       , ""
+       , "      extra-lib-dirs: " <> T.pack (takeDirectory lib)
+       , "      extra-libraries: " <> fromJust (T.stripPrefix "lib" $ T.pack $ takeBaseName lib)
+       , "      build-depends: " <>
+         T.intercalate ",\n                     "
+              ([ baseVersion info
+               , "haskell-gi-base >= 0.26 && < 0.27"
+               -- Workaround for cabal new-build not picking up
+               -- setup-depends dependencies when constructing the
+               -- build plan.
+               , "haskell-gi >= 0.26.14 && < 0.27"
+               -- See https://github.com/haskell-gi/haskell-gi/issues/124
+               -- for the reasoning behind this.
+               , "haskell-gi-overloading < 1.1" ]
+               <> giDepends info <> PI.standardDeps)
+       , ""
+       -- GHC 8.2.x panics when building the overloaded bindings
+       -- https://ghc.haskell.org/trac/ghc/ticket/14382
+       , "      -- Disable overloading when compiling under GHC 8.2.x"
+       , "      -- see https://ghc.haskell.org/trac/ghc/ticket/14382"
+       , "      if impl(ghc == 8.2.*)"
+       , "              build-depends: haskell-gi-overloading == 0.0"
+       , ""
+       , "      -- Note that the following list of exposed modules and autogen"
+       , "      -- modules is for documentation purposes only, so that some"
+       , "      -- documentation appears in hackage. The actual list of modules"
+       , "      -- to be built will be built at configure time, based on the"
+       , "      -- available introspection data."
+       , ""
+       , "      exposed-modules: " <>
+         T.intercalate ",\n                       " exposed
+       , ""
+       , "      autogen-modules: " <>
+         T.intercalate ",\n                       " exposed
+       ]
+
+writeSetup :: FilePath -> ProjectInfo -> S.Set Text -> IO ()
+writeSetup fname info deps =
+    B.writeFile fname $ TE.encodeUtf8 $ T.unlines
+           [ "{-# LANGUAGE OverloadedStrings #-}"
+           , ""
+           , "import Data.GI.CodeGen.CabalHooks (setupBinding, TaggedOverride(..))"
+           , ""
+           , T.unlines (map buildInfo (S.toList deps))
+           , ""
+           , "main :: IO ()"
+           , "main = setupBinding name version pkgName pkgVersion verbose overridesFile inheritedOverrides outputDir"
+           , "  where name = " <> tshow (girName info)
+           , "        version = " <> tshow (girVersion info)
+           , "        pkgName = " <> tshow (name info)
+           , "        pkgVersion = " <> tshow (version info)
+           , "        overridesFile = " <> tshow (girOverrides info)
+           , "        verbose = False"
+           , "        outputDir = Nothing"
+           , "        inheritedOverrides = ["
+             <> T.intercalate ", " (map inheritedOverride (S.toList deps))
+             <> "]"
+           ]
+    where tshow :: Show a => a -> Text
+          tshow = T.pack . show
+
+          buildInfo :: Text -> Text
+          buildInfo dep = let capDep = ucFirst dep in
+            "import qualified GI." <> capDep <> ".Config as " <> capDep
+
+          inheritedOverride :: Text -> Text
+          inheritedOverride dep = let capDep = ucFirst dep in
+            "TaggedOverride \"inherited:" <> capDep <> "\" "
+                      <> capDep <> ".overrides"
+
+exposedModulesAndDeps :: FilePath -> ProjectInfo -> IO ([Text], S.Set Text)
+exposedModulesAndDeps dir info =
+  configureDryRun (girName info) (girVersion info) (name info) (version info)
+                  ((dir </>) <$> girOverrides info) []
+
+-- | Write a "compat" package re-exporting all symbols from the
+-- current pakage.
+writeCompatPkg :: FilePath -> Text -> ProjectInfo -> IO ()
+writeCompatPkg dir compatPkg info = do
+  alreadyThere <- doesPathExist dir
+  if alreadyThere
+    then return ()
+    else do
+      putStr $ " [+ " <> T.unpack compatPkg <> " ]"
+      hFlush stdout
+      createDirectory dir
+      writeCompatProject (dir </> "cabal.project") compatPkg
+      writeCompatCabal (dir </> T.unpack compatPkg <.> ".cabal") compatPkg info
+      writeCompatSetup (dir </> "Setup.hs") info
+      writeCompatReadme (dir </> "README.md") info
+
+-- | The .cabal file for the compatibility package.
+writeCompatCabal :: FilePath -> Text -> ProjectInfo -> IO ()
+writeCompatCabal fname compatPkg info =
+  B.writeFile fname $ TE.encodeUtf8 $ T.unlines
+  [   "name:           " <> compatPkg
+    , "version:        " <> version info
+    , "synopsis:       " <> synopsis info <> " (compatibility layer)"
+    , "description:    This package re-exports (for backward compatibility)"
+    , "                the haskell-gi generated bindings in the " <> name info <> " package."
+    , "homepage:       " <> PI.homepage
+    , "license:        " <> PI.license
+    , "license-file:   LICENSE"
+    , "author:         " <> fromMaybe PI.maintainers (author info)
+    , "maintainer:     " <> PI.maintainers
+    , "category:       " <> PI.category
+    , "build-type:     Custom"
+    , "cabal-version:  2.0"
+    , ""
+    , "extra-source-files: README.md"
+    , ""
+    , "custom-setup"
+    , " setup-depends:"
+    , "   base >= 4.11 && <5,"
+    -- For compatibility with stack, see
+    -- https://github.com/haskell-gi/haskell-gi/issues/463
+    , "   Cabal >= 1.24 && < 4,"
+    , "   haskell-gi ^>= 0.26.14,"
+    , "   " <> name info <> " ^>= " <> version info
+    , ""
+    , "library"
+    , "    ghc-options: -Wall"
+    , ""
+    , "    build-depends: base >= 4.11 && <5,"
+    , "                   " <> name info <> " ^>= " <> version info
+    , ""
+    , "    default-language: Haskell2010"
+    ]
+
+writeCompatProject :: FilePath -> Text -> IO ()
+writeCompatProject fname compatPkg =
+  B.writeFile fname $ TE.encodeUtf8 $ "packages: " <> compatPkg <> ".cabal"
+
+writeCompatSetup :: FilePath -> ProjectInfo -> IO ()
+writeCompatSetup fname info =
+  let cfgMod = "GI." <> ucFirst (girName info) <> ".Config"
+  in B.writeFile fname $ TE.encodeUtf8 $ T.unlines
+  [ "import Data.GI.CodeGen.CabalHooks (setupCompatWrapper)"
+  , "import qualified " <> cfgMod <> " as Cfg"
+  , ""
+  , "main :: IO ()"
+  , "main = setupCompatWrapper \"" <> name info <> "\" Cfg.modules"
+  ]
+
+writeCompatReadme :: FilePath -> ProjectInfo -> IO ()
+writeCompatReadme fname info =
+  let link = "[" <> name info <> "](/package/" <> name info <> ")"
+  in B.writeFile fname $ TE.encodeUtf8 $ T.unlines
+  [ "# Information"
+  , "This is a compatibility package. For newer projects we recommend that you use " <> link <> " instead."
+  ]
+
+genBindingsInDir :: FilePath -> FilePath -> IO ()
+genBindingsInDir dir lib = do
+  info <- readGIRInfo (dir </> "pkg.info")
+  putStr $ "Generating " <> T.unpack (name info) <> "-" <> T.unpack (version info) <> " ..."
+  hFlush stdout
+  (exposed, deps) <- exposedModulesAndDeps dir info
+  writeCabal (dir </> T.unpack (name info) <.> "cabal") lib info exposed
+  writeSetup (dir </> "Setup.hs") info deps
+  case compat info of
+    Nothing -> return ()
+    Just compatPkg -> writeCompatPkg (dir </> "compat") compatPkg info
+  putStrLn " done."
+
+main :: IO ()
+main = do
+  args <- getArgs
+
+  case args of
+    [lib, srcdir] -> do absLib <- makeAbsolute lib
+                        genBindingsInDir srcdir absLib
+    _ -> do hPutStrLn stderr "usage: buildgen <lib> <srcdir>"
+            exitFailure
diff --git a/lib/cabal.project b/lib/cabal.project
new file mode 100644
index 0000000..3438af7
--- /dev/null
+++ b/lib/cabal.project
@@ -0,0 +1 @@
+packages: buildgen.cabal
diff --git a/lib/dbus/com.github.hannesschulze.foobar.xml b/lib/dbus/com.github.hannesschulze.foobar.xml
new file mode 100644
index 0000000..e8373a6
--- /dev/null
+++ b/lib/dbus/com.github.hannesschulze.foobar.xml
@@ -0,0 +1,8 @@
+<node>
+    <interface name="com.github.hannesschulze.foobar.Server">
+        <method name="Inspector"/>
+        <method name="Quit"/>
+        <method name="ToggleLauncher"/>
+        <method name="ToggleControlCenter"/>
+    </interface>
+</node>
diff --git a/lib/dbus/org.bluez.xml b/lib/dbus/org.bluez.xml
new file mode 100644
index 0000000..669e325
--- /dev/null
+++ b/lib/dbus/org.bluez.xml
@@ -0,0 +1,66 @@
+<node>
+	<interface name="org.bluez.Adapter1">
+		<method name="StartDiscovery"/>
+		<method name="StopDiscovery"/>
+		<method name="RemoveDevice">
+			<arg name="device" type="o" direction="in"/>
+		</method>
+		<method name="SetDiscoveryFilter">
+			<arg name="properties" type="a{sv}" direction="in"/>
+		</method>
+		<property name="Address" type="s" access="read"/>
+		<property name="Name" type="s" access="read"/>
+		<property name="Alias" type="s" access="readwrite"/>
+		<property name="Class" type="u" access="read"/>
+		<property name="Powered" type="b" access="readwrite"/>
+		<property name="PowerState" type="s" access="read"/>
+		<property name="Discoverable" type="b" access="readwrite"/>
+		<property name="DiscoverableTimeout" type="u" access="readwrite"/>
+		<property name="Pairable" type="b" access="readwrite"/>
+		<property name="PairableTimeout" type="u" access="readwrite"/>
+		<property name="Discovering" type="b" access="read"/>
+		<property name="UUIDs" type="as" access="read"/>
+		<property name="Modalias" type="s" access="read"/>
+	</interface>
+
+	<interface name="org.bluez.Device1">
+		<method name="Disconnect"/>
+		<method name="Connect"/>
+		<method name="ConnectProfile">
+			<arg name="UUID" type="s" direction="in"/>
+		</method>
+		<method name="DisconnectProfile">
+			<arg name="UUID" type="s" direction="in"/>
+		</method>
+		<method name="Pair"/>
+		<method name="CancelPairing"/>
+		<property name="Address" type="s" access="read"/>
+		<property name="Name" type="s" access="read"/>
+		<property name="Alias" type="s" access="readwrite"/>
+		<property name="Class" type="u" access="read"/>
+		<property name="Appearance" type="q" access="read"/>
+		<property name="Icon" type="s" access="read"/>
+		<property name="Paired" type="b" access="read"/>
+		<property name="Trusted" type="b" access="readwrite"/>
+		<property name="Blocked" type="b" access="readwrite"/>
+		<property name="LegacyPairing" type="b" access="read"/>
+		<property name="RSSI" type="n" access="read"/>
+		<property name="Connected" type="b" access="read"/>
+		<property name="UUIDs" type="as" access="read"/>
+		<property name="Modalias" type="s" access="read"/>
+		<property name="Adapter" type="o" access="read"/>
+	</interface>
+
+	<interface name="org.bluez.AgentManager1">
+		<method name="RegisterAgent">
+			<arg name="agent" type="o" direction="in"/>
+			<arg name="capability" type="s" direction="in"/>
+		</method>
+		<method name="UnregisterAgent">
+			<arg name="agent" type="o" direction="in"/>
+		</method>
+		<method name="RequestDefaultAgent">
+			<arg name="agent" type="o" direction="in"/>
+		</method>
+	</interface>
+</node>
diff --git a/lib/dbus/org.freedesktop.Notifications.xml b/lib/dbus/org.freedesktop.Notifications.xml
new file mode 100644
index 0000000..6b1d2f2
--- /dev/null
+++ b/lib/dbus/org.freedesktop.Notifications.xml
@@ -0,0 +1,35 @@
+<node>
+    <interface name="org.freedesktop.Notifications">
+        <method name="Notify">
+            <arg type="s" direction="in"/>
+            <arg type="u" direction="in"/>
+            <arg type="s" direction="in"/>
+            <arg type="s" direction="in"/>
+            <arg type="s" direction="in"/>
+            <arg type="as" direction="in"/>
+            <arg type="a{sv}" direction="in"/>
+            <arg type="i" direction="in"/>
+            <arg type="u" direction="out"/>
+        </method>
+        <method name="CloseNotification">
+            <arg type="u" direction="in" name="id"/>
+        </method>
+        <method name="GetCapabilities">
+            <arg type="as" direction="out"/>
+        </method>
+        <method name="GetServerInformation">
+            <arg type="s" direction="out"/>
+            <arg type="s" direction="out"/>
+            <arg type="s" direction="out"/>
+            <arg type="s" direction="out"/>
+        </method>
+        <signal name="NotificationClosed">
+            <arg type="u"/>
+            <arg type="u"/>
+        </signal>
+        <signal name="ActionInvoked">
+            <arg type="u"/>
+            <arg type="s"/>
+        </signal>
+    </interface>
+</node>
diff --git a/lib/dbus/org.freedesktop.UPower.xml b/lib/dbus/org.freedesktop.UPower.xml
new file mode 100644
index 0000000..18fc41d
--- /dev/null
+++ b/lib/dbus/org.freedesktop.UPower.xml
@@ -0,0 +1,12 @@
+<node>
+    <interface name="org.freedesktop.UPower.Device">
+        <property name="State" type="u" access="read"/>
+        <property name="Percentage" type="d" access="read"/>
+        <property name="IsPresent" type="b" access="read"/>
+        <property name="TimeToEmpty" type="x" access="read"/>
+        <property name="TimeToFull" type="x" access="read"/>
+        <property name="Energy" type="d" access="read"/>
+        <property name="EnergyFull" type="d" access="read"/>
+        <property name="EnergyRate" type="d" access="read"/>
+    </interface>
+</node>
diff --git a/lib/hs/.gitignore b/lib/hs/.gitignore
new file mode 100644
index 0000000..988260d
--- /dev/null
+++ b/lib/hs/.gitignore
@@ -0,0 +1,3 @@
+GI/
+*.cabal
+Setup.hs
diff --git a/lib/hs/Foobar.overrides b/lib/hs/Foobar.overrides
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/lib/hs/Foobar.overrides
diff --git a/lib/hs/pkg.info b/lib/hs/pkg.info
new file mode 100644
index 0000000..e1171d0
--- /dev/null
+++ b/lib/hs/pkg.info
@@ -0,0 +1,16 @@
+{
+  "name": "gi-foobar",
+  "version": "1.0.0",
+  "description": "Bindings for the Foobar base library, autogenerated by haskell-gi.",
+  "synopsis": "Foobar bindings",
+  "author": null,
+  "girName": "Foobar",
+  "girVersion": "1.0.0",
+  "girOverrides": "Foobar.overrides",
+  "baseVersion": "base >= 4.9 && <5",
+  "giDepends": [
+    "gi-glib == 2.0.*",
+    "gi-gobject == 2.0.*",
+    "gi-gio == 2.0.*"
+  ]
+}
diff --git a/lib/meson.build b/lib/meson.build
new file mode 100644
index 0000000..473ac62
--- /dev/null
+++ b/lib/meson.build
@@ -0,0 +1,90 @@
+project('foobar', 'c', default_options: ['c_std=gnu11', 'warning_level=1'])
+
+gnome = import('gnome')
+glib_dep = dependency('glib-2.0', version: '>=2.78')
+gio_dep = dependency('gio-2.0', version: '>=2.78')
+
+deps = [
+  glib_dep,
+  gio_dep,
+]
+
+sources = []
+
+sources += gnome.gdbus_codegen(
+  'server',
+  'dbus/com.github.hannesschulze.foobar.xml',
+  namespace: 'Foobar',
+  annotations: [
+    ['com.github.hannesschulze.foobar.Server', 'org.gtk.GDBus.C.Name', 'Server'],
+  ],
+)
+
+sources += gnome.gdbus_codegen(
+  'notifications',
+  'dbus/org.freedesktop.Notifications.xml',
+  namespace: 'Foobar',
+  annotations: [
+    ['org.freedesktop.Notifications', 'org.gtk.GDBus.C.Name', 'Notifications'],
+  ],
+)
+
+sources += gnome.gdbus_codegen(
+  'upower',
+  'dbus/org.freedesktop.UPower.xml',
+  namespace: 'Foobar',
+  annotations: [
+    ['org.freedesktop.UPower.Device', 'org.gtk.GDBus.C.Name', 'UPowerDevice'],
+  ],
+)
+
+sources += gnome.gdbus_codegen(
+  'bluez',
+  'dbus/org.bluez.xml',
+  namespace: 'Foobar',
+  annotations: [
+    ['org.bluez.Adapter1', 'org.gtk.GDBus.C.Name', 'BluezAdapter'],
+    ['org.bluez.Device1', 'org.gtk.GDBus.C.Name', 'BluezDevice'],
+    ['org.bluez.AgentManager1', 'org.gtk.GDBus.C.Name', 'BluezAgentManager'],
+  ],
+)
+
+c_args = [
+  '-Wall',
+  '-Werror',
+  '-Wswitch-enum',
+  '-Wswitch-default',
+  '-Wunused',
+  '-Wuninitialized',
+]
+
+static_library(
+  'foobar_static',
+  sources,
+  dependencies: deps,
+  install: false,
+  c_args: c_args
+)
+
+libfoobar = shared_library(
+  'foobar',
+  sources,
+  dependencies: deps,
+  install: false,
+  c_args: c_args
+)
+
+libfoobar_gir = gnome.generate_gir(
+  libfoobar,
+  sources: sources,
+  namespace: 'Foobar',
+  link_with: libfoobar,
+  nsversion: '1.0.0',
+  identifier_prefix: 'Foobar',
+  symbol_prefix: 'foobar',
+  export_packages: 'foobar',
+  dependencies: deps,
+  includes: [ 'GObject-2.0', 'Gio-2.0' ],
+  install: false,
+  extra_args: [ '--fallback-library-path=' ]
+)