clr-marshal 0.1.0.0 → 0.2.0.0

raw patch · 4 files changed

+61/−87 lines, 4 filesdep −clr-hostnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies removed: clr-host

API changes (from Hackage documentation)

Files

• clr-marshal.cabal +4/−5
• src/Clr/Marshal.hs +3/−35
• src/Clr/Marshal/Host.hs +0/−47
• src/Clr/MarshalF.hs +54/−0

@@ -1,5 +1,5 @@ name:                clr-marshal-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Marshaling for the clr description:         A common dependency for other clr packages, marshalling between Haskell & CLR data types. homepage:            https://gitlab.com/tim-m89/clr-haskell/tree/master/libs/clr-marshal@@ -8,19 +8,18 @@ license:             BSD3 license-file:        LICENSE author:              Tim Matthews-maintainer:          tim.matthews7@gmail.com+maintainer:          pepeiborra@gmail.com copyright:           Copyright: (c) 2016-2017 Tim Matthews category:            Language, FFI, CLR, .NET  source-repository head     type:            git-    location:        https://gitlab.com/tim-m89/clr-haskell/tree/master+    location:        https://gitlab.com/tim-m89/clr-haskell/tree/master/libs/clr-marshal  library   hs-source-dirs:      src   default-language:    Haskell2010   exposed-modules:     Clr.Marshal-                       Clr.Marshal.Host+                     , Clr.MarshalF   build-depends:       base >= 4.7 && < 5-                     , clr-host                      , text

@@ -1,18 +1,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE BangPatterns #-} module Clr.Marshal where -import Clr.Host.BStr-import Data.Coerce-import Data.Text-import Data.Text.Foreign-import Data.Word--import Foreign.Ptr-import Foreign.Storable- -- -- Conversion from a high level Haskell type a a raw bridge type --@@ -50,19 +40,6 @@   marshal (x1,x2,x3,x4,x5) f = marshal x1 $ \x1'-> marshal x2 $ \x2'-> marshal x3 $ \x3'-> marshal x4 $ \x4'-> marshal x5 $ \x5'-> f (x1', x2', x3', x4', x5')  ----- BStr instance----instance Marshal Text BStr where-  marshal x f = do-    bstr <- useAsPtr x (\p-> \l-> allocBStr p l)-    !res <- f bstr-    freeBStr bstr-    return res--instance Marshal String BStr where-  marshal x f = marshal (pack x) f---- -- Conversion from a raw bridge type of a methods result to a high level Haskell type -- class Unmarshal a b where@@ -75,17 +52,8 @@   unmarshal = return  ----- BStr instances+-- If we can convert a -> IO b, then we can also convert IO a -> IO b ---instance Unmarshal BStr Text where-  unmarshal x = do-    let charSize = 2-    let ptrData   = coerce x              :: Ptr Word16-    let ptrLen    = plusPtr ptrData (-4)  :: Ptr Word16-    lenBytes     <- peek ptrLen-    !t <- fromPtr ptrData $ fromIntegral $ lenBytes `div` charSize-    freeBStr x-    return t+instance {-# OVERLAPPABLE #-} (Unmarshal a b) => Unmarshal (IO a) b where+  unmarshal x = x >>= \x'-> unmarshal x' -instance Unmarshal BStr String where-  unmarshal x = unmarshal x >>= return . unpack

@@ -1,47 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Clr.Marshal.Host where--import Clr.Marshal--import Clr.Host-import Clr.Host.BStr--import Data.Coerce-import Data.Word-import Foreign.Ptr---- | @'unsafeGetPointerToMethod' m@ returns a function pointer to the method @m@---  as implemented in the Salsa .NET driver assembly (Salsa.dll).  It is safe only---  if the type of the resulting function pointer matches that of the method given.-unsafeGetPointerToMethod :: String -> IO (FunPtr a)-unsafeGetPointerToMethod methodName = do-  result <- marshal methodName $ \(methodName'::BStr) -> getPointerToMethodRaw >>= \f-> f $ coerce methodName'-  if result == nullFunPtr-    then error $ "Unable to execute Salsa.dll method '" ++ methodName ++ "'."-    else return result--getPointerToMethodRaw :: IO (GetPtrToMethod a)-getPointerToMethodRaw = getPtrToMethod_get >>= return . makeGetPtrToMethod--foreign import ccall "dynamic" makeGetPtrToMethod :: GetPtrToMethodFunPtr a -> GetPtrToMethod a---- | @'getMethodStub' c m s@ returns a function pointer to a function that, when---   called, invokes the method with name @m@ and signature @s@ in class @c@.------   @s@ should be a semi-colon delimited list of parameter types indicating the---   desired overload of the given method.-getMethodStub :: String -> String -> String -> IO (FunPtr f)-getMethodStub className methodName parameterTypeNames = do-  marshal className $ \className' ->-    marshal methodName $ \methodName' ->-      marshal parameterTypeNames $ \parameterTypeNames' ->-        getMethodStubRaw >>= \f-> return $ f className' methodName' parameterTypeNames'--getMethodStubRaw :: IO (GetMethodStubDelegate a)-getMethodStubRaw = unsafeGetPointerToMethod "GetMethodStub" >>= return . makeGetMethodStubDelegate--type GetMethodStubDelegate a = BStr -> BStr -> BStr -> FunPtr a-foreign import ccall "dynamic" makeGetMethodStubDelegate :: FunPtr (GetMethodStubDelegate a) -> GetMethodStubDelegate a--

@@ -0,0 +1,54 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE PolyKinds #-}++module Clr.MarshalF where++import Clr.Marshal++import Data.Kind+import GHC.TypeLits++class MarshalF (n::Nat) (from::Type) (to::Type) where+  marshalF :: from -> to++instance (Unmarshal x y) => MarshalF 0 x (IO y) where+  marshalF = unmarshal++instance ( Marshal y0 x0+         , Unmarshal xr yr+         ) => MarshalF 1 (x0 -> xr) (y0 -> IO yr) where+  marshalF f y0 = marshal y0 (unmarshal . f)++instance ( Marshal y0 x0+         , Marshal y1 x1+         , Unmarshal xr yr+         ) => MarshalF 2 (x0 -> x1 -> xr) (y0 -> y1 -> IO yr) where+  marshalF f y0 y1 = marshal y0 (\x0-> marshal y1 (unmarshal . f x0))++instance ( Marshal y0 x0+         , Marshal y1 x1+         , Marshal y2 x2+         , Unmarshal xr yr+         ) => MarshalF 3 (x0 -> x1 -> x2 -> xr) (y0 -> y1 -> y2 -> IO yr) where+  marshalF f y0 y1 y2 = marshal y0 $ \x0-> marshal y1 $ \x1 -> marshal y2 (unmarshal . f x0 x1)++instance ( Marshal y0 x0+         , Marshal y1 x1+         , Marshal y2 x2+         , Marshal y3 x3+         , Unmarshal xr yr+         ) => MarshalF 4 (x0 -> x1 -> x2 -> x3 -> xr) (y0 -> y1 -> y2 -> y3 -> IO yr) where+  marshalF f y0 y1 y2 y3 = marshal y0 $ \x0-> marshal y1 $ \x1 -> marshal y2 $ \x2 -> marshal y3 (unmarshal . f x0 x1 x2)++instance ( Marshal y0 x0+         , Marshal y1 x1+         , Marshal y2 x2+         , Marshal y3 x3+         , Marshal y4 x4+         , Unmarshal xr yr+         ) => MarshalF 5 (x0 -> x1 -> x2 -> x3 -> x4 -> xr) (y0 -> y1 -> y2 -> y3 -> y4 -> IO yr) where+  marshalF f y0 y1 y2 y3 y4 = marshal y0 $ \x0-> marshal y1 $ \x1 -> marshal y2 $ \x2 -> marshal y3 $ \x3 -> marshal y4 (unmarshal . f x0 x1 x2 x3)