WIP: IsForeignType

Author: jorisdral

hs-bindgen-runtime/hs-bindgen-runtime.cabal

@@ -55,6 +55,7 @@ library
     HsBindgen.Runtime.FunPtr
     HsBindgen.Runtime.HasCField
     HsBindgen.Runtime.IncompleteArray
+    HsBindgen.Runtime.IsForeignType
     HsBindgen.Runtime.LibC
     HsBindgen.Runtime.Marshal
     HsBindgen.Runtime.Prelude

hs-bindgen-runtime/src/HsBindgen/Runtime/Block.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 -- | Bare-bones support for blocks
 --
 -- TODO: Ideally we would at least support @Block_copy@ and @Block_release@.
@@ -7,7 +9,9 @@ module HsBindgen.Runtime.Block (
     Block(..)
   ) where
 
-import Foreign
+import Foreign (Ptr)
+
+import HsBindgen.Runtime.IsForeignType (IsForeignType, ViaNewtype (..))
 
 {-------------------------------------------------------------------------------
   Definition
@@ -27,3 +31,5 @@ import Foreign
 --
 -- > newtype VarCounter = VarCounter (Block (CInt -> IO CInt))
 newtype Block t = Block (Ptr ())
+
+deriving via ViaNewtype (Ptr ()) instance IsForeignType (Block t)

hs-bindgen-runtime/src/HsBindgen/Runtime/IsForeignType.hs

@@ -0,0 +1,327 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- TODO: finish documentation, including a manual section
+
+module HsBindgen.Runtime.IsForeignType (
+    -- $is-foreign-type
+    -- * Class
+    IsForeignType
+  , BaseForeignType
+  , toBaseForeignType
+  , fromBaseForeignType
+    -- ** Deriving-via
+  , ViaNewtype (..)
+    -- ** Re-exports
+  , module Foreign.C.Types
+  , module Foreign.C.Error
+#if MIN_VERSION_base(4, 18, 0)
+  , module Foreign.C.ConstPtr
+#endif
+  ) where
+
+import Data.Int
+import Data.Kind
+import Data.Word
+import Foreign.C.Error
+import Foreign.C.Types
+import Foreign.Ptr
+import Foreign.StablePtr
+
+#if MIN_VERSION_base(4, 18, 0)
+import Foreign.C.ConstPtr
+#endif
+
+{- $is-foreign-type
+
+The 'IsForeignType' class broadly captures Haskell's /foreign types/: types that
+are allowed to appear in foreign import declarations. The class can be used to
+map an arbitrary foreign type to its /base/ foreign type: a foreign type with
+all newtypes removed. This mapping can be useful in cases when newtypes are used
+in a foreign import declaration, but their newtype constructors are not in
+scope, in which case a foreign import declaration will fail to compile.
+
+=== Examples
+
+For example, if we define @MyInt@ in module @A@:
+
+> module A where
+>   newtype MyInt = MyInt Int
+>     deriving via ViaNewtype Int instance IsForeignType
+
+And then define a module @B@ that only imports the type @MyInt@ from module @A@
+without importing its constructor. A foreign import declaration like @foo@ in
+module @B@ would fail to compile because the compiler can not see that @MyInt@
+wraps a foreign type. A foreign import declaration like @bar@ will successfully
+compile because the 'IsForeignType' instance for the @MyInt@ newtype is in scope
+as long as module @B@ (transatively) imports module @A@. We can then define a
+function @bar'@ that maps the foreign base type to the foreign type that we want
+to use.
+
+> module B where
+>   import A (MyInt)
+>
+>   foreign import ccall "foo" foo :: MyInt -> IO ()
+>
+>   foreign import ccall "bar" bar ::
+>     BaseForeignType (MyInt -> IO ()) -- equal to Int -> IO ()
+>   bar' :: MyInt -> IO ()
+>   bar' = fromForeignBaseType bar
+
+Alternatively, @foo@ can of course be made to compile successfully by changing
+module @B@ so that it also imports the @MyInt@ construtor from module @A@. This
+is a completely valid solution, but the upside of the 'IsForeignType' class is
+that no fiddling with imports is required to get the right newtype constructors
+in scope. 'IsForeignType' is arguably even nicer when the newtype constructors
+are defined in modules that are depended on transitively, more so if these
+modules are defined other packages that are depended on transitively.
+
+@hs-bindgen@ uses the 'IsForeignType' class to generate imports that do not
+depend on newtype constructors being in scope. This makes the implementation of
+@hs-bindgen@ considerably simpler: it would otherwise have to track import
+dependencies to get the newtype constructors imports just right.
+
+=== Relation to the Haskell 2010 Language report
+
+The "Haskell 2010 Language" report provides grammars for foreign types. These
+grammars are named:
+
+* /basic foreign types/ (technically not specified as a proper pgrammar)
+* /foreign types/
+* /marshallable foreign result types/
+* /marshallable foreign types/
+
+We use the term "foreign type" to refer to a type in either of these grammars
+unless we specify that we are talking about the foreign type /grammar/
+explicitly.
+
+See the "8.4.2 Foreign Types" section of the report for more information:
+<https://www.haskell.org/onlinereport/haskell2010/haskellch8.html#x15-1560008.4.2>
+
+This module comes with a set of default 'IsForeignType' instances for these
+grammars, including instances for newtypes from the "Foreign.C" module hierarchy
+of the @base@ package. These instance should be sufficient for most basic use
+cases that do not involve other (custom) newtypes.
+
+=== Soundness and completeness
+
+In the "Haskell 2010 Language" report, the grammars for foreign types are
+separate. In our 'IsForeignType' class, we conflate these grammars for the sake
+of simplicity, because it is complex to encode the grammars into separate
+classes precisely. This has the caveat that the class and the default instances
+provided in this module are not /sound/ with respect to foreign types as
+described in the Haskell2010 report. For example:
+
+> foreign import ... foo :: IO CInt -> IO CInt
+
+The type of @foo@ is 'IsForeignType', but it is not a valid type for a foreign
+import. 'IO' should (for the most part) only appear in a function result.
+
+Moreover, instances of the 'IsForeignType' class are not generated magically for
+(custom) newtypes. This means that the class and its default instances provided
+in this module are not /complete/ with respect to foreign types as described in
+the Haskell2010 report. For example:
+
+> newtype MyCInt = MyCInt CInt
+> foreign import ... bar :: IO MyCInt -> IO CInt
+
+The type of @bar@ is not 'IsForeignType', but it /is/ a valid type for a foreign
+import, because the compiler can see that @MyCInt@ coerces to a 'CInt'. To make
+@bar@ compile, the user would have to derive an 'IsForeignType' instance using
+@deriving via 'ViaNewtype' 'CInt'@.
+
+=== Instances generated by @hs-bindgen@
+
+@hs-bindgen@ generates 'IsForeignType' instances for the newtypes that it
+generates if the underlying type has a 'IsForeignType' instance as well. It does
+this using newtype-deriving:
+
+> newtype S = S CInt
+>   deriving newtype IsForeignType
+> newtype T a = T a
+>   deriving newtype IsForeignType
+> newtype U = U (CChar -> IO CBool)
+>   deriving newtype IsForeignType
+
+If a user wants to provide an instance for a (custom) newtype, then they should
+be able to define one using newtype-deriving, provided the underlying type has a
+'IsForeignType' instance of course.
+-}
+
+{-------------------------------------------------------------------------------
+  Class
+-------------------------------------------------------------------------------}
+
+-- | Haskell types that are valid /foreign types/.
+class IsForeignType a where
+  -- |
+  --
+  -- > 'BaseForeignType' 'Errno' = 'CInt'
+  type BaseForeignType a :: Type
+  type BaseForeignType a = a
+  toBaseType :: a -> BaseForeignType a
+  fromBaseType :: BaseForeignType a -> a
+
+-- | Map a type to its base foreign
+toBaseForeignType :: IsForeignType a => a -> BaseForeignType a
+toBaseForeignType = toBaseType
+
+fromBaseForeignType :: IsForeignType a => BaseForeignType a -> a
+fromBaseForeignType = fromBaseType
+
+{-------------------------------------------------------------------------------
+  Deriving-via
+-------------------------------------------------------------------------------}
+
+newtype ViaIdentity a = ViaIdentity a
+
+instance IsForeignType (ViaIdentity a) where
+  type BaseForeignType (ViaIdentity a) = a
+
+  {-# INLINE toBaseType #-}
+  toBaseType (ViaIdentity x) = x
+
+  {-# INLINE fromBaseType #-}
+  fromBaseType x = ViaIdentity x
+
+newtype ViaNewtype a = ViaNewtype a
+
+instance IsForeignType a => IsForeignType (ViaNewtype a) where
+  type BaseForeignType (ViaNewtype a) = BaseForeignType a
+
+  {-# INLINE toBaseType #-}
+  toBaseType (ViaNewtype x) = toBaseType x
+
+  {-# INLINE fromBaseType #-}
+  fromBaseType x = ViaNewtype (fromBaseType x)
+
+{-------------------------------------------------------------------------------
+  Instances: foreign types
+-------------------------------------------------------------------------------}
+
+instance (IsForeignType a, IsForeignType b) => IsForeignType (a -> b) where
+  type BaseForeignType (a -> b) = BaseForeignType a -> BaseForeignType b
+
+  {-# INLINE toBaseType #-}
+  toBaseType f = \x -> toBaseType (f (fromBaseType x))
+
+  {-# INLINE fromBaseType #-}
+  fromBaseType f = \x -> fromBaseType (f (toBaseType x))
+
+{-------------------------------------------------------------------------------
+  Instances: marshallable foreign result types
+-------------------------------------------------------------------------------}
+
+deriving via ViaIdentity () instance IsForeignType ()
+
+instance IsForeignType a => IsForeignType (IO a) where
+  type BaseForeignType (IO a) = IO (BaseForeignType a)
+
+  {-# INLINE toBaseType #-}
+  toBaseType = fmap toBaseType
+
+  {-# INLINE fromBaseType #-}
+  fromBaseType = fmap fromBaseType
+
+{-------------------------------------------------------------------------------
+  Instances: marshallable foreign types
+-------------------------------------------------------------------------------}
+
+-- NOTE: we use 'ViaIdentity' rather than 'ViaNewtype' to derive 'IsForeignType'
+-- instances even for non-basic foreign types coming from the "Foreign.C"
+-- modules. Most of these types, like 'CInt', are newtypes around basic foreign
+-- types, but the specific basic foreign type depends on the platform\/operating
+-- system. This is not a problem: the constructors for these non-basic types are
+-- going to be in scope anyway. TODO: is this true?
+
+-- === Prelude ===
+
+-- Basic foreign types
+deriving via ViaIdentity Char instance IsForeignType Char
+deriving via ViaIdentity Int instance IsForeignType Int
+deriving via ViaIdentity Double instance IsForeignType Double
+deriving via ViaIdentity Float instance IsForeignType Float
+deriving via ViaIdentity Bool instance IsForeignType Bool
+
+-- === Data.Int ===
+
+-- Basic foreign types
+deriving via ViaIdentity Int8 instance IsForeignType Int8
+deriving via ViaIdentity Int16 instance IsForeignType Int16
+deriving via ViaIdentity Int32 instance IsForeignType Int32
+deriving via ViaIdentity Int64 instance IsForeignType Int64
+
+-- === Data.Word ===
+
+-- Basic foreign types
+deriving via ViaIdentity Word instance IsForeignType Word
+deriving via ViaIdentity Word8 instance IsForeignType Word8
+deriving via ViaIdentity Word16 instance IsForeignType Word16
+deriving via ViaIdentity Word32 instance IsForeignType Word32
+deriving via ViaIdentity Word64 instance IsForeignType Word64
+
+-- === Foreign.Ptr ===
+
+-- Basic foreign types
+deriving via ViaIdentity (Ptr a) instance IsForeignType (Ptr a)
+deriving via ViaIdentity (FunPtr a) instance IsForeignType (FunPtr a)
+
+-- Newtypes around basic foreign types
+deriving via ViaIdentity IntPtr instance IsForeignType IntPtr
+deriving via ViaIdentity WordPtr instance IsForeignType WordPtr
+
+-- === Foreign.StablePtr ===
+
+-- Basic foreign types
+deriving via ViaIdentity (StablePtr a) instance IsForeignType (StablePtr a)
+
+-- === Foreign.C.ConstPtr ===
+
+-- Newtypes around basic foreign types
+#if MIN_VERSION_base(4, 18, 0)
+deriving via ViaIdentity (ConstPtr a) instance IsForeignType (ConstPtr a)
+#endif
+
+-- === Foreign.C.Error ===
+
+-- Newtypes around basic foreign types
+deriving via ViaNewtype CInt instance IsForeignType Errno
+
+-- === Foreign.C.Types ===
+
+-- Newtypes around basic foreign types
+deriving via ViaIdentity CChar instance IsForeignType CChar
+deriving via ViaIdentity CSChar instance IsForeignType CSChar
+deriving via ViaIdentity CUChar instance IsForeignType CUChar
+deriving via ViaIdentity CShort instance IsForeignType CShort
+deriving via ViaIdentity CUShort instance IsForeignType CUShort
+deriving via ViaIdentity CInt instance IsForeignType CInt
+deriving via ViaIdentity CUInt instance IsForeignType CUInt
+deriving via ViaIdentity CLong instance IsForeignType CLong
+deriving via ViaIdentity CULong instance IsForeignType CULong
+deriving via ViaIdentity CPtrdiff instance IsForeignType CPtrdiff
+deriving via ViaIdentity CSize instance IsForeignType CSize
+deriving via ViaIdentity CWchar instance IsForeignType CWchar
+deriving via ViaIdentity CSigAtomic instance IsForeignType CSigAtomic
+deriving via ViaIdentity CLLong instance IsForeignType CLLong
+deriving via ViaIdentity CULLong instance IsForeignType CULLong
+deriving via ViaIdentity CBool instance IsForeignType CBool
+deriving via ViaIdentity CIntPtr instance IsForeignType CIntPtr
+deriving via ViaIdentity CUIntPtr instance IsForeignType CUIntPtr
+deriving via ViaIdentity CIntMax instance IsForeignType CIntMax
+deriving via ViaIdentity CUIntMax instance IsForeignType CUIntMax
+
+-- === Foreign.C.Types : Numeric types ===
+
+-- Newtypes around basic foreign types
+deriving via ViaIdentity CClock instance IsForeignType CClock
+deriving via ViaIdentity CTime instance IsForeignType CTime
+deriving via ViaIdentity CUSeconds instance IsForeignType CUSeconds
+deriving via ViaIdentity CSUSeconds instance IsForeignType CSUSeconds
+
+-- === Foreign.C.Types : Floating types ===
+
+-- Newtypes around basic foreign types
+deriving via ViaIdentity CFloat instance IsForeignType CFloat
+deriving via ViaIdentity CDouble instance IsForeignType CDouble