{-# LINE 1 "src/common/Language/Java/Inline/Internal/Magic.hsc" #-}
-- | Internal module defining some magic, kept separate from the rest, that
-- depends on compiler internals.

{-# 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



-- | The bytecode corresponding to a java class
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)

-- | Produces a Java class name from a package and a module name.
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)))

-- | Runs the given function for every class in the bytecode table.
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" #-}