diff --git a/haskell-gi.cabal b/haskell-gi.cabal --- a/haskell-gi.cabal +++ b/haskell-gi.cabal @@ -1,5 +1,5 @@ name: haskell-gi -version: 0.26.3 +version: 0.26.4 synopsis: Generate Haskell bindings for GObject Introspection capable libraries description: Generate Haskell bindings for GObject Introspection capable libraries. This includes most notably Gtk+, but many other libraries in the GObject ecosystem provide introspection data too. @@ -20,7 +20,7 @@ custom-setup setup-depends: base >= 4 && <5, - Cabal == 3.*, + Cabal >= 1.24 && < 4, cabal-doctest >= 1 source-repository head diff --git a/lib/Data/GI/CodeGen/Code.hs b/lib/Data/GI/CodeGen/Code.hs --- a/lib/Data/GI/CodeGen/Code.hs +++ b/lib/Data/GI/CodeGen/Code.hs @@ -71,7 +71,9 @@ import Control.Applicative ((<$>)) import Data.Monoid (Monoid(..)) #endif +#if MIN_VERSION_base(4,18,0) import Control.Monad (forM, unless, when) +#endif import Control.Monad.Reader import Control.Monad.State.Strict import Control.Monad.Except @@ -956,6 +958,7 @@ , "import qualified Control.Monad.IO.Class as MIO" , "import qualified Data.Coerce as Coerce" , "import qualified Data.Text as T" + , "import qualified Data.Kind as DK" , "import qualified Data.ByteString.Char8 as B" , "import qualified Data.Map as Map" , "import qualified Foreign.Ptr as FP" diff --git a/lib/Data/GI/CodeGen/Conversions.hsc b/lib/Data/GI/CodeGen/Conversions.hsc --- a/lib/Data/GI/CodeGen/Conversions.hsc +++ b/lib/Data/GI/CodeGen/Conversions.hsc @@ -299,13 +299,15 @@ | TCArray False _ _ (TBasicType TUInt8) <- t = return $ M "packByteString" | TCArray False _ _ (TBasicType TBoolean) <- t = - return $ M "(packMapStorableArray (fromIntegral . fromEnum))" + return $ M "(packMapStorableArray (P.fromIntegral . P.fromEnum))" | TCArray False _ _ (TBasicType TGType) <- t = return $ M "(packMapStorableArray gtypeToCGType)" | TCArray False _ _ (TBasicType TFloat) <- t = return $ M "(packMapStorableArray realToFrac)" | TCArray False _ _ (TBasicType TDouble) <- t = return $ M "(packMapStorableArray realToFrac)" + | TCArray False _ _ (TBasicType TUniChar) <- t = + return $ M "(packMapStorableArray (P.fromIntegral . SP.ord))" | TCArray False _ _ (TBasicType _) <- t = return $ M "packStorableArray" | TCArray False _ _ TGValue <- t = @@ -315,8 +317,8 @@ | otherwise = case (typeShow hType, typeShow fType) of ("T.Text", "CString") -> return $ M "textToCString" ("[Char]", "CString") -> return $ M "stringToCString" - ("Char", "CInt") -> return "(fromIntegral . ord)" - ("Bool", "CInt") -> return "(fromIntegral . fromEnum)" + ("Char", "CInt") -> return "(P.fromIntegral . SP.ord)" + ("Bool", "CInt") -> return "(P.fromIntegral . P.fromEnum)" ("Float", "CFloat") -> return "realToFrac" ("Double", "CDouble") -> return "realToFrac" ("GType", "CGType") -> return "gtypeToCGType" @@ -667,25 +669,27 @@ unpackCArray length (TCArray False _ _ t) transfer = case t of TBasicType TUTF8 -> return $ apply $ M $ parenthesize $ - "unpackUTF8CArrayWithLength " <> length + "unpackUTF8CArrayWithLength " <> length TBasicType TFileName -> return $ apply $ M $ parenthesize $ - "unpackFileNameArrayWithLength " <> length + "unpackFileNameArrayWithLength " <> length TBasicType TUInt8 -> return $ apply $ M $ parenthesize $ - "unpackByteStringWithLength " <> length + "unpackByteStringWithLength " <> length TBasicType TPtr -> return $ apply $ M $ parenthesize $ - "unpackPtrArrayWithLength " <> length + "unpackPtrArrayWithLength " <> length TBasicType TBoolean -> return $ apply $ M $ parenthesize $ - "unpackMapStorableArrayWithLength (/= 0) " <> length + "unpackMapStorableArrayWithLength (/= 0) " <> length TBasicType TGType -> return $ apply $ M $ parenthesize $ - "unpackMapStorableArrayWithLength GType " <> length + "unpackMapStorableArrayWithLength GType " <> length TBasicType TFloat -> return $ apply $ M $ parenthesize $ - "unpackMapStorableArrayWithLength realToFrac " <> length + "unpackMapStorableArrayWithLength realToFrac " <> length TBasicType TDouble -> return $ apply $ M $ parenthesize $ - "unpackMapStorableArrayWithLength realToFrac " <> length + "unpackMapStorableArrayWithLength realToFrac " <> length + TBasicType TUniChar -> return $ apply $ M $ parenthesize $ + "unpackMapStorableArrayWithLength (SP.chr . P.fromIntegral) " <> length TBasicType _ -> return $ apply $ M $ parenthesize $ - "unpackStorableArrayWithLength " <> length + "unpackStorableArrayWithLength " <> length TGValue -> return $ apply $ M $ parenthesize $ - "B.GValue.unpackGValueArrayWithLength " <> length + "B.GValue.unpackGValueArrayWithLength " <> length TInterface _ -> do a <- findAPI t isScalar <- typeIsEnumOrFlag t diff --git a/lib/Data/GI/CodeGen/OverloadedMethods.hs b/lib/Data/GI/CodeGen/OverloadedMethods.hs --- a/lib/Data/GI/CodeGen/OverloadedMethods.hs +++ b/lib/Data/GI/CodeGen/OverloadedMethods.hs @@ -81,7 +81,7 @@ group $ do let resolver = "Resolve" <> name <> "Method" export (Section MethodSection) resolver - line $ "type family " <> resolver <> " (t :: Symbol) (o :: *) :: * where" + line $ "type family " <> resolver <> " (t :: Symbol) (o :: DK.Type) :: DK.Type where" indent $ forM_ infos $ \(label, info) -> do line $ resolver <> " \"" <> label <> "\" o = " <> info indent $ line $ resolver <> " l o = O.MethodResolutionFailed l o" diff --git a/lib/Data/GI/CodeGen/OverloadedSignals.hs b/lib/Data/GI/CodeGen/OverloadedSignals.hs --- a/lib/Data/GI/CodeGen/OverloadedSignals.hs +++ b/lib/Data/GI/CodeGen/OverloadedSignals.hs @@ -36,7 +36,7 @@ let signalListType = name <> "SignalList" line $ "type instance O.SignalList " <> name <> " = " <> signalListType line $ "type " <> signalListType <> " = ('[ " - <> T.intercalate ", " infos <> "] :: [(Symbol, *)])" + <> T.intercalate ", " infos <> "] :: [(Symbol, DK.Type)])" -- | Signal instances for interfaces. genInterfaceSignals :: Name -> Interface -> CodeGen e () @@ -51,4 +51,4 @@ let signalListType = name <> "SignalList" line $ "type instance O.SignalList " <> name <> " = " <> signalListType line $ "type " <> signalListType <> " = ('[ " - <> T.intercalate ", " infos <> "] :: [(Symbol, *)])" + <> T.intercalate ", " infos <> "] :: [(Symbol, DK.Type)])" diff --git a/lib/Data/GI/CodeGen/Overrides.hs b/lib/Data/GI/CodeGen/Overrides.hs --- a/lib/Data/GI/CodeGen/Overrides.hs +++ b/lib/Data/GI/CodeGen/Overrides.hs @@ -11,7 +11,9 @@ import Data.Traversable (traverse) #endif +#if MIN_VERSION_base(4,18,0) import Control.Monad (foldM) +#endif import Control.Monad.Except import Control.Monad.State import Control.Monad.Writer (WriterT, execWriterT, tell) diff --git a/lib/Data/GI/CodeGen/Properties.hs b/lib/Data/GI/CodeGen/Properties.hs --- a/lib/Data/GI/CodeGen/Properties.hs +++ b/lib/Data/GI/CodeGen/Properties.hs @@ -539,7 +539,7 @@ line $ "instance O.HasAttributeList " <> name line $ "type instance O.AttributeList " <> name <> " = " <> propListType line $ "type " <> propListType <> " = ('[ " - <> T.intercalate ", " allProps <> "] :: [(Symbol, *)])" + <> T.intercalate ", " allProps <> "] :: [(Symbol, DK.Type)])" -- | Generate gtk2hs compatible attribute labels (to ease -- porting). These are namespaced labels, for examples diff --git a/lib/Data/GI/CodeGen/Struct.hs b/lib/Data/GI/CodeGen/Struct.hs --- a/lib/Data/GI/CodeGen/Struct.hs +++ b/lib/Data/GI/CodeGen/Struct.hs @@ -458,7 +458,7 @@ line $ "instance O.HasAttributeList " <> name' line $ "type instance O.AttributeList " <> name' <> " = " <> attrListName line $ "type " <> attrListName <> " = ('[ " <> - T.intercalate ", " (catMaybes attrs) <> "] :: [(Symbol, *)])" + T.intercalate ", " (catMaybes attrs) <> "] :: [(Symbol, DK.Type)])" -- | Generate a constructor for a zero-filled struct/union of the given -- type, using the boxed (or GLib, for unboxed types) allocator.