{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Foreign.JNI.Types
  ( JType(..)
  , IsPrimitiveType
  , IsReferenceType
  , Sing
  , SJType(..)
  , type (<>)
    -- * JNI types
  , J(..)
  , jnull
  , upcast
  , arrayUpcast
  , unsafeCast
  , generic
  , unsafeUngeneric
  , jtypeOf
  , ReferenceTypeName
  , singToIsReferenceType
  , referenceTypeName
  , Signature
  , signature
  , MethodSignature
  , methodSignature
  , JVM(..)
  , JNIEnv(..)
  , JMethodID(..)
  , JFieldID(..)
  , JValue(..)
  , withJValues
    -- * Conversions
  , objectFromPtr
  , unsafeObjectToPtr
    -- * JNI defined object types
  , JObject
  , JClass
  , JString
  , JArray
  , JObjectArray
  , JBooleanArray
  , JByteArray
  , JCharArray
  , JShortArray
  , JIntArray
  , JLongArray
  , JFloatArray
  , JDoubleArray
  , JThrowable
  , JByteBuffer
  -- * inline-c contexts
  , jniCtx
  ) where

import Control.DeepSeq (NFData)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Builder.Prim as Prim
import Data.ByteString.Builder (Builder)
import Data.Char (chr, ord)
import Data.Constraint (Dict(..))
import Data.Int
import qualified Data.Map as Map
import Data.Singletons
import Data.Word
import Foreign.C (CChar)
import Foreign.ForeignPtr
  ( ForeignPtr
  , castForeignPtr
  , newForeignPtr_
  , withForeignPtr
  )
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Foreign.JNI.Internal
import Foreign.JNI.NativeMethod
import qualified Foreign.JNI.String as JNI
import Foreign.Marshal.Alloc (allocaBytesAligned)
import Foreign.Ptr
import Foreign.Storable (Storable(..))
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Language.C.Types (TypeSpecifier(TypeName))
import Language.C.Inline.Context (Context(..), fptrCtx)
import System.IO.Unsafe (unsafePerformIO)

-- | A JVM instance.
newtype JVM = JVM_ (Ptr JVM)
  deriving (JVM -> JVM -> Bool
(JVM -> JVM -> Bool) -> (JVM -> JVM -> Bool) -> Eq JVM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JVM -> JVM -> Bool
$c/= :: JVM -> JVM -> Bool
== :: JVM -> JVM -> Bool
$c== :: JVM -> JVM -> Bool
Eq, Int -> JVM -> ShowS
[JVM] -> ShowS
JVM -> String
(Int -> JVM -> ShowS)
-> (JVM -> String) -> ([JVM] -> ShowS) -> Show JVM
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JVM] -> ShowS
$cshowList :: [JVM] -> ShowS
show :: JVM -> String
$cshow :: JVM -> String
showsPrec :: Int -> JVM -> ShowS
$cshowsPrec :: Int -> JVM -> ShowS
Show, Ptr b -> Int -> IO JVM
Ptr b -> Int -> JVM -> IO ()
Ptr JVM -> IO JVM
Ptr JVM -> Int -> IO JVM
Ptr JVM -> Int -> JVM -> IO ()
Ptr JVM -> JVM -> IO ()
JVM -> Int
(JVM -> Int)
-> (JVM -> Int)
-> (Ptr JVM -> Int -> IO JVM)
-> (Ptr JVM -> Int -> JVM -> IO ())
-> (forall b. Ptr b -> Int -> IO JVM)
-> (forall b. Ptr b -> Int -> JVM -> IO ())
-> (Ptr JVM -> IO JVM)
-> (Ptr JVM -> JVM -> IO ())
-> Storable JVM
forall b. Ptr b -> Int -> IO JVM
forall b. Ptr b -> Int -> JVM -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr JVM -> JVM -> IO ()
$cpoke :: Ptr JVM -> JVM -> IO ()
peek :: Ptr JVM -> IO JVM
$cpeek :: Ptr JVM -> IO JVM
pokeByteOff :: Ptr b -> Int -> JVM -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> JVM -> IO ()
peekByteOff :: Ptr b -> Int -> IO JVM
$cpeekByteOff :: forall b. Ptr b -> Int -> IO JVM
pokeElemOff :: Ptr JVM -> Int -> JVM -> IO ()
$cpokeElemOff :: Ptr JVM -> Int -> JVM -> IO ()
peekElemOff :: Ptr JVM -> Int -> IO JVM
$cpeekElemOff :: Ptr JVM -> Int -> IO JVM
alignment :: JVM -> Int
$calignment :: JVM -> Int
sizeOf :: JVM -> Int
$csizeOf :: JVM -> Int
Storable, JVM -> ()
(JVM -> ()) -> NFData JVM
forall a. (a -> ()) -> NFData a
rnf :: JVM -> ()
$crnf :: JVM -> ()
NFData)

-- | The thread-local JNI context. Do not share this object between threads.
newtype JNIEnv = JNIEnv_ (Ptr JNIEnv)
  deriving (JNIEnv -> JNIEnv -> Bool
(JNIEnv -> JNIEnv -> Bool)
-> (JNIEnv -> JNIEnv -> Bool) -> Eq JNIEnv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JNIEnv -> JNIEnv -> Bool
$c/= :: JNIEnv -> JNIEnv -> Bool
== :: JNIEnv -> JNIEnv -> Bool
$c== :: JNIEnv -> JNIEnv -> Bool
Eq, Int -> JNIEnv -> ShowS
[JNIEnv] -> ShowS
JNIEnv -> String
(Int -> JNIEnv -> ShowS)
-> (JNIEnv -> String) -> ([JNIEnv] -> ShowS) -> Show JNIEnv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JNIEnv] -> ShowS
$cshowList :: [JNIEnv] -> ShowS
show :: JNIEnv -> String
$cshow :: JNIEnv -> String
showsPrec :: Int -> JNIEnv -> ShowS
$cshowsPrec :: Int -> JNIEnv -> ShowS
Show, Ptr b -> Int -> IO JNIEnv
Ptr b -> Int -> JNIEnv -> IO ()
Ptr JNIEnv -> IO JNIEnv
Ptr JNIEnv -> Int -> IO JNIEnv
Ptr JNIEnv -> Int -> JNIEnv -> IO ()
Ptr JNIEnv -> JNIEnv -> IO ()
JNIEnv -> Int
(JNIEnv -> Int)
-> (JNIEnv -> Int)
-> (Ptr JNIEnv -> Int -> IO JNIEnv)
-> (Ptr JNIEnv -> Int -> JNIEnv -> IO ())
-> (forall b. Ptr b -> Int -> IO JNIEnv)
-> (forall b. Ptr b -> Int -> JNIEnv -> IO ())
-> (Ptr JNIEnv -> IO JNIEnv)
-> (Ptr JNIEnv -> JNIEnv -> IO ())
-> Storable JNIEnv
forall b. Ptr b -> Int -> IO JNIEnv
forall b. Ptr b -> Int -> JNIEnv -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr JNIEnv -> JNIEnv -> IO ()
$cpoke :: Ptr JNIEnv -> JNIEnv -> IO ()
peek :: Ptr JNIEnv -> IO JNIEnv
$cpeek :: Ptr JNIEnv -> IO JNIEnv
pokeByteOff :: Ptr b -> Int -> JNIEnv -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> JNIEnv -> IO ()
peekByteOff :: Ptr b -> Int -> IO JNIEnv
$cpeekByteOff :: forall b. Ptr b -> Int -> IO JNIEnv
pokeElemOff :: Ptr JNIEnv -> Int -> JNIEnv -> IO ()
$cpokeElemOff :: Ptr JNIEnv -> Int -> JNIEnv -> IO ()
peekElemOff :: Ptr JNIEnv -> Int -> IO JNIEnv
$cpeekElemOff :: Ptr JNIEnv -> Int -> IO JNIEnv
alignment :: JNIEnv -> Int
$calignment :: JNIEnv -> Int
sizeOf :: JNIEnv -> Int
$csizeOf :: JNIEnv -> Int
Storable, JNIEnv -> ()
(JNIEnv -> ()) -> NFData JNIEnv
forall a. (a -> ()) -> NFData a
rnf :: JNIEnv -> ()
$crnf :: JNIEnv -> ()
NFData)

-- | A thread-local reference to a field of an object.
newtype JFieldID = JFieldID_ (Ptr JFieldID)
  deriving (JFieldID -> JFieldID -> Bool
(JFieldID -> JFieldID -> Bool)
-> (JFieldID -> JFieldID -> Bool) -> Eq JFieldID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JFieldID -> JFieldID -> Bool
$c/= :: JFieldID -> JFieldID -> Bool
== :: JFieldID -> JFieldID -> Bool
$c== :: JFieldID -> JFieldID -> Bool
Eq, Int -> JFieldID -> ShowS
[JFieldID] -> ShowS
JFieldID -> String
(Int -> JFieldID -> ShowS)
-> (JFieldID -> String) -> ([JFieldID] -> ShowS) -> Show JFieldID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JFieldID] -> ShowS
$cshowList :: [JFieldID] -> ShowS
show :: JFieldID -> String
$cshow :: JFieldID -> String
showsPrec :: Int -> JFieldID -> ShowS
$cshowsPrec :: Int -> JFieldID -> ShowS
Show, Ptr b -> Int -> IO JFieldID
Ptr b -> Int -> JFieldID -> IO ()
Ptr JFieldID -> IO JFieldID
Ptr JFieldID -> Int -> IO JFieldID
Ptr JFieldID -> Int -> JFieldID -> IO ()
Ptr JFieldID -> JFieldID -> IO ()
JFieldID -> Int
(JFieldID -> Int)
-> (JFieldID -> Int)
-> (Ptr JFieldID -> Int -> IO JFieldID)
-> (Ptr JFieldID -> Int -> JFieldID -> IO ())
-> (forall b. Ptr b -> Int -> IO JFieldID)
-> (forall b. Ptr b -> Int -> JFieldID -> IO ())
-> (Ptr JFieldID -> IO JFieldID)
-> (Ptr JFieldID -> JFieldID -> IO ())
-> Storable JFieldID
forall b. Ptr b -> Int -> IO JFieldID
forall b. Ptr b -> Int -> JFieldID -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr JFieldID -> JFieldID -> IO ()
$cpoke :: Ptr JFieldID -> JFieldID -> IO ()
peek :: Ptr JFieldID -> IO JFieldID
$cpeek :: Ptr JFieldID -> IO JFieldID
pokeByteOff :: Ptr b -> Int -> JFieldID -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> JFieldID -> IO ()
peekByteOff :: Ptr b -> Int -> IO JFieldID
$cpeekByteOff :: forall b. Ptr b -> Int -> IO JFieldID
pokeElemOff :: Ptr JFieldID -> Int -> JFieldID -> IO ()
$cpokeElemOff :: Ptr JFieldID -> Int -> JFieldID -> IO ()
peekElemOff :: Ptr JFieldID -> Int -> IO JFieldID
$cpeekElemOff :: Ptr JFieldID -> Int -> IO JFieldID
alignment :: JFieldID -> Int
$calignment :: JFieldID -> Int
sizeOf :: JFieldID -> Int
$csizeOf :: JFieldID -> Int
Storable, JFieldID -> ()
(JFieldID -> ()) -> NFData JFieldID
forall a. (a -> ()) -> NFData a
rnf :: JFieldID -> ()
$crnf :: JFieldID -> ()
NFData)

-- | A thread-local reference to a method of an object.
newtype JMethodID = JMethodID_ (Ptr JMethodID)
  deriving (JMethodID -> JMethodID -> Bool
(JMethodID -> JMethodID -> Bool)
-> (JMethodID -> JMethodID -> Bool) -> Eq JMethodID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JMethodID -> JMethodID -> Bool
$c/= :: JMethodID -> JMethodID -> Bool
== :: JMethodID -> JMethodID -> Bool
$c== :: JMethodID -> JMethodID -> Bool
Eq, Int -> JMethodID -> ShowS
[JMethodID] -> ShowS
JMethodID -> String
(Int -> JMethodID -> ShowS)
-> (JMethodID -> String)
-> ([JMethodID] -> ShowS)
-> Show JMethodID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JMethodID] -> ShowS
$cshowList :: [JMethodID] -> ShowS
show :: JMethodID -> String
$cshow :: JMethodID -> String
showsPrec :: Int -> JMethodID -> ShowS
$cshowsPrec :: Int -> JMethodID -> ShowS
Show, Ptr b -> Int -> IO JMethodID
Ptr b -> Int -> JMethodID -> IO ()
Ptr JMethodID -> IO JMethodID
Ptr JMethodID -> Int -> IO JMethodID
Ptr JMethodID -> Int -> JMethodID -> IO ()
Ptr JMethodID -> JMethodID -> IO ()
JMethodID -> Int
(JMethodID -> Int)
-> (JMethodID -> Int)
-> (Ptr JMethodID -> Int -> IO JMethodID)
-> (Ptr JMethodID -> Int -> JMethodID -> IO ())
-> (forall b. Ptr b -> Int -> IO JMethodID)
-> (forall b. Ptr b -> Int -> JMethodID -> IO ())
-> (Ptr JMethodID -> IO JMethodID)
-> (Ptr JMethodID -> JMethodID -> IO ())
-> Storable JMethodID
forall b. Ptr b -> Int -> IO JMethodID
forall b. Ptr b -> Int -> JMethodID -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr JMethodID -> JMethodID -> IO ()
$cpoke :: Ptr JMethodID -> JMethodID -> IO ()
peek :: Ptr JMethodID -> IO JMethodID
$cpeek :: Ptr JMethodID -> IO JMethodID
pokeByteOff :: Ptr b -> Int -> JMethodID -> IO ()
$cpokeByteOff :: forall b. Ptr b -> Int -> JMethodID -> IO ()
peekByteOff :: Ptr b -> Int -> IO JMethodID
$cpeekByteOff :: forall b. Ptr b -> Int -> IO JMethodID
pokeElemOff :: Ptr JMethodID -> Int -> JMethodID -> IO ()
$cpokeElemOff :: Ptr JMethodID -> Int -> JMethodID -> IO ()
peekElemOff :: Ptr JMethodID -> Int -> IO JMethodID
$cpeekElemOff :: Ptr JMethodID -> Int -> IO JMethodID
alignment :: JMethodID -> Int
$calignment :: JMethodID -> Int
sizeOf :: JMethodID -> Int
$csizeOf :: JMethodID -> Int
Storable, JMethodID -> ()
(JMethodID -> ()) -> NFData JMethodID
forall a. (a -> ()) -> NFData a
rnf :: JMethodID -> ()
$crnf :: JMethodID -> ()
NFData)

-- | Not part of the JNI. The kind of 'J' type indices. Useful to reflect the
-- object's class at the type-level.
data JType
  = Class Symbol                               -- ^ Class name
  | Iface Symbol                               -- ^ Interface name
  | Prim Symbol                                -- ^ Primitive type
  | Array JType                                -- ^ Array type
  | Generic JType [JType]                      -- ^ Parameterized (generic) type
  | Void                                       -- ^ Void special type

-- | The class of Java types that are "unboxed".
class SingI ty => IsPrimitiveType (ty :: JType)
instance KnownSymbol sym => IsPrimitiveType ('Prim sym)

class IsReferenceType (ty :: JType)
instance IsReferenceType ('Class sym)
instance IsReferenceType ('Iface sym)
instance IsReferenceType ('Array ty)
instance IsReferenceType ty => IsReferenceType ('Generic ty tys)

-- | Produces evidence for IsReferenceType from a `Sing ty`.
singToIsReferenceType :: Sing (ty :: JType) -> Maybe (Dict (IsReferenceType ty))
singToIsReferenceType :: Sing ty -> Maybe (Dict (IsReferenceType ty))
singToIsReferenceType Sing ty
tysing = case Sing ty
tysing of
    SClass _ -> Dict (IsReferenceType ty) -> Maybe (Dict (IsReferenceType ty))
forall a. a -> Maybe a
Just Dict (IsReferenceType ty)
forall (a :: Constraint). a => Dict a
Dict
    SPrim _ -> Maybe (Dict (IsReferenceType ty))
forall a. Maybe a
Nothing
    SIface _ -> Dict (IsReferenceType ty) -> Maybe (Dict (IsReferenceType ty))
forall a. a -> Maybe a
Just Dict (IsReferenceType ty)
forall (a :: Constraint). a => Dict a
Dict
    SArray _ -> Dict (IsReferenceType ty) -> Maybe (Dict (IsReferenceType ty))
forall a. a -> Maybe a
Just Dict (IsReferenceType ty)
forall (a :: Constraint). a => Dict a
Dict
    SGeneric tysing' _ -> (\Dict (IsReferenceType ty)
Dict -> Dict (IsReferenceType ty)
forall (a :: Constraint). a => Dict a
Dict) (Dict (IsReferenceType ty) -> Dict (IsReferenceType ty))
-> Maybe (Dict (IsReferenceType ty))
-> Maybe (Dict (IsReferenceType ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sing ty -> Maybe (Dict (IsReferenceType ty))
forall (ty :: JType). Sing ty -> Maybe (Dict (IsReferenceType ty))
singToIsReferenceType Sing ty
SJType ty
tysing'
    Sing ty
SVoid -> Maybe (Dict (IsReferenceType ty))
forall a. Maybe a
Nothing

type instance Sing = SJType
data SJType (a :: JType) where
  -- Using String instead of JNI.String for the singleton data constructors
  -- is an optimization. Otherwise, the comparisons in Language.Java.call
  -- and callStatic would involve allocations and cannot be cached.
  --
  -- See commit 3da51a4 and https://github.com/tweag/inline-java/issues/11
  SClass :: String -> SJType ('Class sym)
  SIface :: String -> SJType ('Iface sym)
  SPrim :: String -> SJType ('Prim sym)
  SArray :: SJType ty -> SJType ('Array ty)
  SGeneric :: SJType ty -> Sing tys -> SJType ('Generic ty tys)
  SVoid :: SJType 'Void

realShowsPrec :: Show a => Int -> a -> ShowS
realShowsPrec :: Int -> a -> ShowS
realShowsPrec = Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec

instance Show (SJType a) where
  showsPrec :: Int -> SJType a -> ShowS
showsPrec Int
d (SClass String
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"SClass " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
realShowsPrec Int
11 String
s
  showsPrec Int
d (SIface String
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"SIface " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
realShowsPrec Int
11 String
s
  showsPrec Int
d (SPrim String
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"SPrim " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
realShowsPrec Int
11 String
s
  showsPrec Int
d (SArray SJType ty
s) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"SArray " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SJType ty -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 SJType ty
s
  showsPrec Int
d (SGeneric SJType ty
s Sing tys
sargs) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"SGeneric " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SJType ty -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 SJType ty
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SList tys -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Sing tys
SList tys
sargs
  showsPrec Int
_ SJType a
SVoid = String -> ShowS
showString String
"SVoid"

-- XXX SingI constraint temporary hack because GHC 7.10 has trouble inferring
-- this constraint in 'signature'.
instance (KnownSymbol sym, SingI sym) => SingI ('Class (sym :: Symbol)) where
  sing :: Sing ('Class sym)
sing = String -> SJType ('Class sym)
forall (sym :: Symbol). String -> SJType ('Class sym)
SClass (String -> SJType ('Class sym)) -> String -> SJType ('Class sym)
forall a b. (a -> b) -> a -> b
$ Any sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall a. HasCallStack => a
forall (proxy :: Symbol -> *). proxy sym
undefined :: proxy sym)
instance (KnownSymbol sym, SingI sym) => SingI ('Iface (sym :: Symbol)) where
  sing :: Sing ('Iface sym)
sing = String -> SJType ('Iface sym)
forall (sym :: Symbol). String -> SJType ('Iface sym)
SIface (String -> SJType ('Iface sym)) -> String -> SJType ('Iface sym)
forall a b. (a -> b) -> a -> b
$ Any sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall a. HasCallStack => a
forall (proxy :: Symbol -> *). proxy sym
undefined :: proxy sym)
instance (KnownSymbol sym, SingI sym) => SingI ('Prim (sym :: Symbol)) where
  sing :: Sing ('Prim sym)
sing = String -> SJType ('Prim sym)
forall (sym :: Symbol). String -> SJType ('Prim sym)
SPrim (String -> SJType ('Prim sym)) -> String -> SJType ('Prim sym)
forall a b. (a -> b) -> a -> b
$ Any sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall a. HasCallStack => a
forall (proxy :: Symbol -> *). proxy sym
undefined :: proxy sym)
instance SingI ty => SingI ('Array ty) where
  sing :: Sing ('Array ty)
sing = SJType ty -> SJType ('Array ty)
forall (ty :: JType). SJType ty -> SJType ('Array ty)
SArray (SingI ty => Sing ty
forall k (a :: k). SingI a => Sing a
sing @ty)
instance (SingI ty, SingI tys) => SingI ('Generic ty tys) where
  sing :: Sing ('Generic ty tys)
sing = SJType ty -> Sing tys -> SJType ('Generic ty tys)
forall (ty :: JType) (tys :: [JType]).
SJType ty -> Sing tys -> SJType ('Generic ty tys)
SGeneric (SingI ty => Sing ty
forall k (a :: k). SingI a => Sing a
sing @ty) (SingI tys => Sing tys
forall k (a :: k). SingI a => Sing a
sing @tys)
instance SingI 'Void where
  sing :: Sing 'Void
sing = Sing 'Void
SJType 'Void
SVoid

-- | Shorthand for parametized Java types.
type a <> g = 'Generic a g

-- | Type indexed Java Objects.
newtype J (a :: JType) = J (ForeignPtr (J a))
  deriving (J a -> J a -> Bool
(J a -> J a -> Bool) -> (J a -> J a -> Bool) -> Eq (J a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (a :: JType). J a -> J a -> Bool
/= :: J a -> J a -> Bool
$c/= :: forall (a :: JType). J a -> J a -> Bool
== :: J a -> J a -> Bool
$c== :: forall (a :: JType). J a -> J a -> Bool
Eq, Int -> J a -> ShowS
[J a] -> ShowS
J a -> String
(Int -> J a -> ShowS)
-> (J a -> String) -> ([J a] -> ShowS) -> Show (J a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (a :: JType). Int -> J a -> ShowS
forall (a :: JType). [J a] -> ShowS
forall (a :: JType). J a -> String
showList :: [J a] -> ShowS
$cshowList :: forall (a :: JType). [J a] -> ShowS
show :: J a -> String
$cshow :: forall (a :: JType). J a -> String
showsPrec :: Int -> J a -> ShowS
$cshowsPrec :: forall (a :: JType). Int -> J a -> ShowS
Show)

type role J representational

-- | The null reference.
jnull :: J a
jnull :: J a
jnull = ForeignPtr (J a) -> J a
forall (a :: JType). ForeignPtr (J a) -> J a
J (ForeignPtr (J a) -> J a) -> ForeignPtr (J a) -> J a
forall a b. (a -> b) -> a -> b
$ IO (ForeignPtr (J a)) -> ForeignPtr (J a)
forall a. IO a -> a
unsafePerformIO (IO (ForeignPtr (J a)) -> ForeignPtr (J a))
-> IO (ForeignPtr (J a)) -> ForeignPtr (J a)
forall a b. (a -> b) -> a -> b
$ Ptr (J a) -> IO (ForeignPtr (J a))
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr (J a)
forall a. Ptr a
nullPtr

-- | Any object can be cast to @Object@.
upcast :: J a -> JObject
upcast :: J a -> JObject
upcast = J a -> JObject
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast

-- | Any array of a reference type can be casted to an array of @Object@s.
arrayUpcast :: IsReferenceType ty => J ('Array ty) -> JObjectArray
arrayUpcast :: J ('Array ty) -> JObjectArray
arrayUpcast = J ('Array ty) -> JObjectArray
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast

-- | Unsafe type cast. Should only be used to downcast.
unsafeCast :: J a -> J b
unsafeCast :: J a -> J b
unsafeCast (J ForeignPtr (J a)
x) = ForeignPtr (J b) -> J b
forall (a :: JType). ForeignPtr (J a) -> J a
J (ForeignPtr (J a) -> ForeignPtr (J b)
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (J a)
x)

-- | Parameterize the type of an object, making its type a /generic type/.
generic :: J a -> J (a <> g)
generic :: J a -> J (a <> g)
generic = J a -> J (a <> g)
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast

-- | Get the base type of a generic type.
unsafeUngeneric :: J (a <> g) -> J a
unsafeUngeneric :: J (a <> g) -> J a
unsafeUngeneric = J (a <> g) -> J a
forall (a :: JType) (b :: JType). J a -> J b
unsafeCast

-- | A union type for uniformly passing arguments to methods.
data JValue
  = JBoolean Word8
  | JByte CChar
  | JChar Word16
  | JShort Int16
  | JInt Int32
  | JLong Int64
  | JFloat Float
  | JDouble Double
  | forall a. SingI a => JObject {-# UNPACK #-} !(J a)

instance Show JValue where
  show :: JValue -> String
show (JBoolean Word8
x) = String
"JBoolean " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
x
  show (JByte CChar
x) = String
"JByte " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CChar -> String
forall a. Show a => a -> String
show CChar
x
  show (JChar Word16
x) = String
"JChar " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
x
  show (JShort Int16
x) = String
"JShort " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int16 -> String
forall a. Show a => a -> String
show Int16
x
  show (JInt Int32
x) = String
"JInt " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
x
  show (JLong Int64
x) = String
"JLong " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
x
  show (JFloat Float
x) = String
"JFloat " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
x
  show (JDouble Double
x) = String
"JDouble " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
x
  show (JObject J a
x) = String
"JObject " String -> ShowS
forall a. [a] -> [a] -> [a]
++ J a -> String
forall a. Show a => a -> String
show J a
x

instance Eq JValue where
  (JBoolean Word8
x) == :: JValue -> JValue -> Bool
== (JBoolean Word8
y) = Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
y
  (JByte CChar
x) == (JByte CChar
y) = CChar
x CChar -> CChar -> Bool
forall a. Eq a => a -> a -> Bool
== CChar
y
  (JChar Word16
x) == (JChar Word16
y) = Word16
x Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
y
  (JShort Int16
x) == (JShort Int16
y) = Int16
x Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
y
  (JInt Int32
x) == (JInt Int32
y) = Int32
x Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
y
  (JLong Int64
x) == (JLong Int64
y) = Int64
x Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
y
  (JFloat Float
x) == (JFloat Float
y) = Float
x Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
y
  (JDouble Double
x) == (JDouble Double
y) = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y
  (JObject (J ForeignPtr (J a)
x)) == (JObject (J ForeignPtr (J a)
y)) = ForeignPtr (J a) -> ForeignPtr Any
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (J a)
x ForeignPtr Any -> ForeignPtr Any -> Bool
forall a. Eq a => a -> a -> Bool
== ForeignPtr (J a) -> ForeignPtr Any
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr ForeignPtr (J a)
y
  JValue
_ == JValue
_ = Bool
False

sizeOfJValue, alignmentJValue :: Int
sizeOfJValue :: Int
sizeOfJValue      = Int
8
alignmentJValue :: Int
alignmentJValue   = Int
8

-- | @withJValue jvalues f@ provides a pointer to an array containing the given
-- @jvalues@.
--
-- The array is valid only while evaluating @f@.
withJValues :: [JValue] -> (Ptr JValue -> IO a) -> IO a
withJValues :: [JValue] -> (Ptr JValue -> IO a) -> IO a
withJValues [JValue]
args Ptr JValue -> IO a
f =
    Int -> Int -> (Ptr JValue -> IO a) -> IO a
forall a b. Int -> Int -> (Ptr a -> IO b) -> IO b
allocaBytesAligned (Int
sizeOfJValue Int -> Int -> Int
forall a. Num a => a -> a -> a
* [JValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JValue]
args) Int
alignmentJValue ((Ptr JValue -> IO a) -> IO a) -> (Ptr JValue -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr JValue
p ->
      ((IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a)
-> (IO a -> IO a) -> [IO a -> IO a] -> IO a -> IO a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (IO a -> IO a) -> (IO a -> IO a) -> IO a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) IO a -> IO a
forall a. a -> a
id ((Int -> JValue -> IO a -> IO a)
-> [Int] -> [JValue] -> [IO a -> IO a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Ptr JValue -> Int -> JValue -> IO a -> IO a
forall a. Ptr JValue -> Int -> JValue -> IO a -> IO a
withJValueOff Ptr JValue
p) [Int
0..] [JValue]
args) (Ptr JValue -> IO a
f Ptr JValue
p)

-- @withJValueOff p n jvalue io@ writes the given @jvalue@ to @p `plusPtr` n@
-- and runs @io@.
--
-- The jvalue is guaranteed to stay valid while @io@ evaluates.
withJValueOff :: Ptr JValue -> Int -> JValue -> IO a -> IO a
withJValueOff :: Ptr JValue -> Int -> JValue -> IO a -> IO a
withJValueOff Ptr JValue
p Int
n JValue
jvalue IO a
io = case JValue
jvalue of
    JBoolean Word8
x -> Ptr Any -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Word8
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
    JByte    CChar
x -> Ptr Any -> Int -> CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset CChar
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
    JChar    Word16
x -> Ptr Any -> Int -> Word16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Word16
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
    JShort   Int16
x -> Ptr Any -> Int -> Int16 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Int16
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
    JInt     Int32
x -> Ptr Any -> Int -> Int32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Int32
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
    JLong    Int64
x -> Ptr Any -> Int -> Int64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Int64
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
    JFloat   Float
x -> Ptr Any -> Int -> Float -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Float
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
    JDouble  Double
x -> Ptr Any -> Int -> Double -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Double
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io

    JObject (J ForeignPtr (J a)
x) -> ForeignPtr (J a) -> (Ptr (J a) -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (J a)
x ((Ptr (J a) -> IO a) -> IO a) -> (Ptr (J a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr (J a)
xp ->
      Ptr Any -> Int -> Ptr (J a) -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr JValue -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr JValue
p) Int
offset Ptr (J a)
xp IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
io
  where
    offset :: Int
offset = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sizeOfJValue

-- | Get the Java type of a value.
jtypeOf :: JValue -> SomeSing JType
jtypeOf :: JValue -> SomeSing JType
jtypeOf (JBoolean Word8
_) = Sing ('Prim "boolean") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "boolean")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "boolean"))
jtypeOf (JByte CChar
_) = Sing ('Prim "byte") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "byte")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "byte"))
jtypeOf (JChar Word16
_) = Sing ('Prim "char") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "char")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "char"))
jtypeOf (JShort Int16
_) = Sing ('Prim "short") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "short")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "short"))
jtypeOf (JInt Int32
_) = Sing ('Prim "int") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "int")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "int"))
jtypeOf (JLong Int64
_) = Sing ('Prim "long") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "long")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "long"))
jtypeOf (JFloat Float
_) = Sing ('Prim "float") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "float")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "float"))
jtypeOf (JDouble Double
_) = Sing ('Prim "double") -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing ('Prim "double")
forall k (a :: k). SingI a => Sing a
sing :: Sing ('Prim "double"))
jtypeOf (JObject (J a
_ :: J ty)) = Sing a -> SomeSing JType
forall k (a :: k). Sing a -> SomeSing k
SomeSing (Sing a
forall k (a :: k). SingI a => Sing a
sing :: Sing ty)

-- | Create a null-terminated string.
build :: Builder -> JNI.String
build :: Builder -> String
build =
  ByteString -> String
JNI.unsafeFromByteString (ByteString -> String)
-> (Builder -> ByteString) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> (Builder -> Builder) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char7 Char
'\NUL')

-- | The name of a type, suitable for passing to 'Foreign.JNI.findClass'.
referenceTypeName :: IsReferenceType ty => Sing (ty :: JType) -> ReferenceTypeName
referenceTypeName :: Sing ty -> ReferenceTypeName
referenceTypeName (SClass sym) = String -> ReferenceTypeName
ReferenceTypeName (String -> ReferenceTypeName) -> String -> ReferenceTypeName
forall a b. (a -> b) -> a -> b
$ Builder -> String
build (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$ String -> Builder
classSymbolBuilder String
sym
referenceTypeName (SIface sym) = String -> ReferenceTypeName
ReferenceTypeName (String -> ReferenceTypeName) -> String -> ReferenceTypeName
forall a b. (a -> b) -> a -> b
$ Builder -> String
build (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$ String -> Builder
classSymbolBuilder String
sym
referenceTypeName ty :: Sing ty
ty@(SArray _) = String -> ReferenceTypeName
ReferenceTypeName (String -> ReferenceTypeName) -> String -> ReferenceTypeName
forall a b. (a -> b) -> a -> b
$ Builder -> String
build (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$ Sing ('Array ty) -> Builder
forall (ty :: JType). Sing ty -> Builder
signatureBuilder Sing ty
Sing ('Array ty)
ty
referenceTypeName (SGeneric ty@(SClass _) _) = Sing ('Class sym) -> ReferenceTypeName
forall (ty :: JType).
IsReferenceType ty =>
Sing ty -> ReferenceTypeName
referenceTypeName Sing ('Class sym)
SJType ty
ty
referenceTypeName (SGeneric ty@(SIface _) _) = Sing ('Iface sym) -> ReferenceTypeName
forall (ty :: JType).
IsReferenceType ty =>
Sing ty -> ReferenceTypeName
referenceTypeName Sing ('Iface sym)
SJType ty
ty
referenceTypeName Sing ty
_ = String -> ReferenceTypeName
forall a. HasCallStack => String -> a
error String
"referenceTypeName: Impossible."

classSymbolBuilder :: String -> Builder
classSymbolBuilder :: String -> Builder
classSymbolBuilder String
sym =
    FixedPrim Word8 -> ByteString -> Builder
Prim.primMapByteStringFixed (Word8 -> Word8
forall p. Integral p => p -> p
subst (Word8 -> Word8) -> FixedPrim Word8 -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
Prim.>$< FixedPrim Word8
Prim.word8)
      (String -> ByteString
JNI.toByteString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> String
JNI.fromChars String
sym)
  where
    subst :: p -> p
subst (Int -> Char
chr (Int -> Char) -> (p -> Int) -> p -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Char
'.') = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'/')
    subst p
x = p
x

signatureBuilder :: Sing (ty :: JType) -> Builder
signatureBuilder :: Sing ty -> Builder
signatureBuilder (SClass sym) = Char -> Builder
Builder.char7 Char
'L' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
classSymbolBuilder String
sym Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char7 Char
';'
signatureBuilder (SIface sym) = Char -> Builder
Builder.char7 Char
'L' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
classSymbolBuilder String
sym Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char7 Char
';'
signatureBuilder (SPrim "boolean") = Char -> Builder
Builder.char7 Char
'Z'
signatureBuilder (SPrim "byte") = Char -> Builder
Builder.char7 Char
'B'
signatureBuilder (SPrim "char") = Char -> Builder
Builder.char7 Char
'C'
signatureBuilder (SPrim "short") = Char -> Builder
Builder.char7 Char
'S'
signatureBuilder (SPrim "int") = Char -> Builder
Builder.char7 Char
'I'
signatureBuilder (SPrim "long") = Char -> Builder
Builder.char7 Char
'J'
signatureBuilder (SPrim "float") = Char -> Builder
Builder.char7 Char
'F'
signatureBuilder (SPrim "double") = Char -> Builder
Builder.char7 Char
'D'
signatureBuilder (SPrim sym) = String -> Builder
forall a. HasCallStack => String -> a
error (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String
"Unknown primitive: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sym
signatureBuilder (SArray ty) = Char -> Builder
Builder.char7 Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Sing ty -> Builder
forall (ty :: JType). Sing ty -> Builder
signatureBuilder Sing ty
SJType ty
ty
signatureBuilder (SGeneric ty _) = Sing ty -> Builder
forall (ty :: JType). Sing ty -> Builder
signatureBuilder Sing ty
SJType ty
ty
signatureBuilder Sing ty
SVoid = Char -> Builder
Builder.char7 Char
'V'

-- | Construct a JNI type signature from a Java type.
signature :: Sing (ty :: JType) -> Signature
signature :: Sing ty -> Signature
signature = String -> Signature
Signature (String -> Signature)
-> (SJType ty -> String) -> SJType ty -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> String
build (Builder -> String)
-> (SJType ty -> Builder) -> SJType ty -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SJType ty -> Builder
forall (ty :: JType). Sing ty -> Builder
signatureBuilder

-- | Construct a method's JNI type signature, given the type of the arguments
-- and the return type.
methodSignature
  :: [SomeSing JType]
  -> Sing (ty :: JType)
  -> MethodSignature
methodSignature :: [SomeSing JType] -> Sing ty -> MethodSignature
methodSignature [SomeSing JType]
args Sing ty
ret =
    String -> MethodSignature
MethodSignature (String -> MethodSignature) -> String -> MethodSignature
forall a b. (a -> b) -> a -> b
$
    Builder -> String
build (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$
    Char -> Builder
Builder.char7 Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((SomeSing JType -> Builder) -> [SomeSing JType] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\(SomeSing Sing a
s) -> Sing a -> Builder
forall (ty :: JType). Sing ty -> Builder
signatureBuilder Sing a
s) [SomeSing JType]
args) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Char -> Builder
Builder.char7 Char
')' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Sing ty -> Builder
forall (ty :: JType). Sing ty -> Builder
signatureBuilder Sing ty
ret

-- | Turn the raw pointer into an object.
objectFromPtr :: Ptr (J a) -> IO (J a)
objectFromPtr :: Ptr (J a) -> IO (J a)
objectFromPtr Ptr (J a)
ptr = ForeignPtr (J a) -> J a
forall (a :: JType). ForeignPtr (J a) -> J a
J (ForeignPtr (J a) -> J a) -> IO (ForeignPtr (J a)) -> IO (J a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (J a) -> IO (ForeignPtr (J a))
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr (J a)
ptr

-- | Get a raw pointer to an object. This is unsafe because if the argument is
-- the last usage occurrence of the given foreign pointer, then its finalizer(s)
-- will be run, which potentially invalidates the plain pointer just obtained.
unsafeObjectToPtr :: J a -> Ptr (J a)
unsafeObjectToPtr :: J a -> Ptr (J a)
unsafeObjectToPtr (J ForeignPtr (J a)
fptr) = ForeignPtr (J a) -> Ptr (J a)
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr (J a)
fptr

type JObject = J ('Class "java.lang.Object")
type JClass = J ('Class "java.lang.Class")
type JString = J ('Class "java.lang.String")
type JThrowable = J ('Class "java.lang.Throwable")
type JArray a = J ('Array a)
type JObjectArray = JArray ('Class "java.lang.Object")
type JBooleanArray = JArray ('Prim "boolean")
type JByteArray = JArray ('Prim "byte")
type JCharArray = JArray ('Prim "char")
type JShortArray = JArray ('Prim "short")
type JIntArray = JArray ('Prim "int")
type JLongArray = JArray ('Prim "long")
type JFloatArray = JArray ('Prim "float")
type JDoubleArray = JArray ('Prim "double")
type JByteBuffer = J ('Class "java.nio.ByteBuffer")

jniCtx :: Context
jniCtx :: Context
jniCtx = Context
forall a. Monoid a => a
mempty { ctxTypesTable :: TypesTable
ctxTypesTable = [(TypeSpecifier, TypeQ)] -> TypesTable
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(TypeSpecifier, TypeQ)]
tytab } Context -> Context -> Context
forall a. Semigroup a => a -> a -> a
<> Context
fptrCtx
  where
    tytab :: [(TypeSpecifier, TypeQ)]
tytab =
      [ -- Primitive types
        (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jboolean", [t| Word8 |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jbyte", [t| CChar |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jchar", [t| Word16 |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jshort", [t| Int16 |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jint", [t| Int32 |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jlong", [t| Int64 |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jfloat", [t| Float |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jdouble", [t| Double |])
      -- Reference types
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jobject", [t| Ptr JObject |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jclass", [t| Ptr JClass |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jstring", [t| Ptr JString |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jarray", [t| Ptr JObject |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jobjectArray", [t| Ptr JObjectArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jbooleanArray", [t| Ptr JBooleanArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jbyteArray", [t| Ptr JByteArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jcharArray", [t| Ptr JCharArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jshortArray", [t| Ptr JShortArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jintArray", [t| Ptr JIntArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jlongArray", [t| Ptr JLongArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jfloatArray", [t| Ptr JFloatArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jdoubleArray", [t| Ptr JDoubleArray |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jthrowable", [t| Ptr JThrowable |])
      -- Internal types
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"JavaVM", [t| JVM |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"JNIEnv", [t| JNIEnv |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"JNINativeMethod", [t| JNINativeMethod |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jfieldID", [t| JFieldID |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jmethodID", [t| JMethodID |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jsize", [t| Int32 |])
      , (CIdentifier -> TypeSpecifier
TypeName CIdentifier
"jvalue", [t| JValue |])
      ]