{-# LINE 1 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
module Language.Java.Inline.Internal.Magic
( DotClass(..)
, JavaImport(..)
, forEachDotClass
, mangleClassName
) where
import Control.Monad (forM_)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Unsafe as BS
import Data.Char (isAlphaNum)
import Data.Data
import Foreign.C.String (peekCString)
import Foreign.C.Types (CSize)
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Foreign.Storable
import qualified Language.Haskell.TH.Syntax as TH
data DotClass = DotClass
{ DotClass -> String
className :: String
, DotClass -> ByteString
classBytecode :: ByteString
}
data JavaImport = JavaImport String Integer
deriving (Typeable JavaImport
DataType
Constr
Typeable JavaImport
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JavaImport -> c JavaImport)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JavaImport)
-> (JavaImport -> Constr)
-> (JavaImport -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JavaImport))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c JavaImport))
-> ((forall b. Data b => b -> b) -> JavaImport -> JavaImport)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r)
-> (forall u. (forall d. Data d => d -> u) -> JavaImport -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> JavaImport -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport)
-> Data JavaImport
JavaImport -> DataType
JavaImport -> Constr
(forall b. Data b => b -> b) -> JavaImport -> JavaImport
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JavaImport -> c JavaImport
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JavaImport
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JavaImport -> u
forall u. (forall d. Data d => d -> u) -> JavaImport -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JavaImport
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JavaImport -> c JavaImport
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JavaImport)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JavaImport)
$cJavaImport :: Constr
$tJavaImport :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
gmapMp :: (forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
gmapM :: (forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JavaImport -> m JavaImport
gmapQi :: Int -> (forall d. Data d => d -> u) -> JavaImport -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JavaImport -> u
gmapQ :: (forall d. Data d => d -> u) -> JavaImport -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JavaImport -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JavaImport -> r
gmapT :: (forall b. Data b => b -> b) -> JavaImport -> JavaImport
$cgmapT :: (forall b. Data b => b -> b) -> JavaImport -> JavaImport
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JavaImport)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JavaImport)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JavaImport)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JavaImport)
dataTypeOf :: JavaImport -> DataType
$cdataTypeOf :: JavaImport -> DataType
toConstr :: JavaImport -> Constr
$ctoConstr :: JavaImport -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JavaImport
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JavaImport
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JavaImport -> c JavaImport
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JavaImport -> c JavaImport
$cp1Data :: Typeable JavaImport
Data, JavaImport -> Q Exp
JavaImport -> Q (TExp JavaImport)
(JavaImport -> Q Exp)
-> (JavaImport -> Q (TExp JavaImport)) -> Lift JavaImport
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: JavaImport -> Q (TExp JavaImport)
$cliftTyped :: JavaImport -> Q (TExp JavaImport)
lift :: JavaImport -> Q Exp
$clift :: JavaImport -> Q Exp
TH.Lift)
mangleClassName :: String -> String -> String
mangleClassName :: String -> String -> String
mangleClassName String
pkgname String
modname = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Inline__"
, (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum String
pkgname
, String
"_"
, (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\case Char
'.' -> Char
'_'; Char
x -> Char
x) String
modname
]
foreign import capi unsafe "&inline_java_bctable" bctable :: Ptr (Ptr DotClass)
peekDotClass :: Ptr DotClass -> IO DotClass
peekDotClass :: Ptr DotClass -> IO DotClass
peekDotClass Ptr DotClass
ptr = do
CSize
sz <- (\Ptr DotClass
hsc_ptr -> Ptr DotClass -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DotClass
hsc_ptr Int
8) Ptr DotClass
ptr
{-# LINE 63 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
bc <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 64 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
DotClass
<$> ((\hsc_ptr -> peekByteOff hsc_ptr 0) ptr >>= peekCString)
{-# LINE 66 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
<*> (BS.unsafePackCStringLen (bc, fromIntegral (sz :: CSize)))
forEachDotClass :: (DotClass -> IO ()) -> IO ()
forEachDotClass :: (DotClass -> IO ()) -> IO ()
forEachDotClass DotClass -> IO ()
f = Ptr (Ptr DotClass) -> IO (Ptr DotClass)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr DotClass)
bctable IO (Ptr DotClass) -> (Ptr DotClass -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr DotClass -> IO ()
go
where
go :: Ptr DotClass -> IO ()
go :: Ptr DotClass -> IO ()
go Ptr DotClass
tbl
| Ptr DotClass
tbl Ptr DotClass -> Ptr DotClass -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr DotClass
forall a. Ptr a
nullPtr = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Ptr Any
dcs_ptr <- (\Ptr DotClass
hsc_ptr -> Ptr DotClass -> Int -> IO (Ptr Any)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DotClass
hsc_ptr Int
8) Ptr DotClass
tbl
{-# LINE 77 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
Int
tbl_sz <- (\Ptr DotClass
hsc_ptr -> Ptr DotClass -> Int -> IO Int
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DotClass
hsc_ptr Int
16) Ptr DotClass
tbl
{-# LINE 78 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
[Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..(Int
tbl_szInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
let dc_sz :: Int
dc_sz = (Int
24)
{-# LINE 80 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
DotClass -> IO ()
f (DotClass -> IO ()) -> IO DotClass -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr DotClass -> IO DotClass
peekDotClass (Ptr Any
dcs_ptr Ptr Any -> Int -> Ptr DotClass
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
dc_sz))
(\Ptr DotClass
hsc_ptr -> Ptr DotClass -> Int -> IO (Ptr DotClass)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr DotClass
hsc_ptr Int
0) Ptr DotClass
tbl IO (Ptr DotClass) -> (Ptr DotClass -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr DotClass -> IO ()
go
{-# LINE 82 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}