{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE ViewPatterns          #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TemplateHaskell       #-}
{-|
Copyright   : (c) Christian Gram Kalhauge, 2017
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu

This module contains the 'Constant' type and the 'ConstantPool'. These
are essential for accessing data in the class-file.
-}

module Language.JVM.Constant
  ( Constant(..)
  , constantSize
  , typeToStr
  , Referenceable(..)

  -- * JValue
  , JValue(..)
  , VInteger
  , VLong
  , VDouble
  , VFloat
  , VString

    -- * Special constants
  , ClassName(..)
  , InClass(..)
  , InRefType(..)
  , parseAbsMethodId
  , AbsFieldId(..)
  , AbsInterfaceMethodId(..)
  , AbsVariableMethodId(..)
  , MethodId(..)
  , FieldId(..)
  , NameAndType(..)
  , MethodDescriptor
  , FieldDescriptor
  , MethodHandle(..)
  , MethodHandleField(..)
  , MethodHandleMethod(..)
  , MethodHandleInterface(..)
  , MethodHandleFieldKind(..)
  , InvokeDynamic(..)

  -- * re-exports
  , High
  , Low
  )
where

import           Control.DeepSeq                ( NFData )
import           Control.Monad.Reader
import           Data.Binary
import           Data.String
import           Data.Binary.IEEE754
import qualified Data.ByteString               as BS
import           Data.Int
import qualified Data.Text                     as Text
import qualified Data.Text.Encoding.Error      as TE
import           GHC.Generics                   ( Generic )
import           Numeric                        ( showHex )
import           Prelude                 hiding ( fail
                                                , lookup
                                                )

import           Language.JVM.Stage
import           Language.JVM.TH
import           Language.JVM.Type
import           Language.JVM.Utils


-- | A constant is a multi word item in the 'ConstantPool'. Each of
-- the constructors are pretty much self-explanatory from the types.
data Constant r
  = CString !SizedByteString16
  | CInteger !Int32
  | CFloat !Float
  | CLong !Int64
  | CDouble !Double
  | CClassRef !(Ref Text.Text r)
  | CStringRef !(Ref BS.ByteString r)
  | CFieldRef !(Choice (Index, Index) AbsFieldId r)
  | CMethodRef !(Choice (Index, Index) (InRefType MethodId) r)
  | CInterfaceMethodRef !(Choice (Index, Index) (InRefType MethodId) r)
  | CNameAndType !(Ref Text.Text r) !(Ref Text.Text r)
  | CMethodHandle !(MethodHandle r)
  | CMethodType !(Ref MethodDescriptor r)
  | CInvokeDynamic !(InvokeDynamic r)

--deriving (Show, Eq, Generic, NFData)

-- | An method which is from an interface
newtype AbsInterfaceMethodId = AbsInterfaceMethodId
  { AbsInterfaceMethodId -> InRefType MethodId
interfaceMethodId :: InRefType MethodId
  } deriving (Int -> AbsInterfaceMethodId -> ShowS
[AbsInterfaceMethodId] -> ShowS
AbsInterfaceMethodId -> String
(Int -> AbsInterfaceMethodId -> ShowS)
-> (AbsInterfaceMethodId -> String)
-> ([AbsInterfaceMethodId] -> ShowS)
-> Show AbsInterfaceMethodId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsInterfaceMethodId] -> ShowS
$cshowList :: [AbsInterfaceMethodId] -> ShowS
show :: AbsInterfaceMethodId -> String
$cshow :: AbsInterfaceMethodId -> String
showsPrec :: Int -> AbsInterfaceMethodId -> ShowS
$cshowsPrec :: Int -> AbsInterfaceMethodId -> ShowS
Show, AbsInterfaceMethodId -> AbsInterfaceMethodId -> Bool
(AbsInterfaceMethodId -> AbsInterfaceMethodId -> Bool)
-> (AbsInterfaceMethodId -> AbsInterfaceMethodId -> Bool)
-> Eq AbsInterfaceMethodId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsInterfaceMethodId -> AbsInterfaceMethodId -> Bool
$c/= :: AbsInterfaceMethodId -> AbsInterfaceMethodId -> Bool
== :: AbsInterfaceMethodId -> AbsInterfaceMethodId -> Bool
$c== :: AbsInterfaceMethodId -> AbsInterfaceMethodId -> Bool
Eq, (forall x. AbsInterfaceMethodId -> Rep AbsInterfaceMethodId x)
-> (forall x. Rep AbsInterfaceMethodId x -> AbsInterfaceMethodId)
-> Generic AbsInterfaceMethodId
forall x. Rep AbsInterfaceMethodId x -> AbsInterfaceMethodId
forall x. AbsInterfaceMethodId -> Rep AbsInterfaceMethodId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsInterfaceMethodId x -> AbsInterfaceMethodId
$cfrom :: forall x. AbsInterfaceMethodId -> Rep AbsInterfaceMethodId x
Generic, AbsInterfaceMethodId -> ()
(AbsInterfaceMethodId -> ()) -> NFData AbsInterfaceMethodId
forall a. (a -> ()) -> NFData a
rnf :: AbsInterfaceMethodId -> ()
$crnf :: AbsInterfaceMethodId -> ()
NFData)

-- | An method which can be from an interface
data AbsVariableMethodId = AbsVariableMethodId
  { AbsVariableMethodId -> Bool
variableIsInterface :: !Bool
  , AbsVariableMethodId -> InRefType MethodId
variableMethodId    :: !(InRefType MethodId)
  } deriving (Int -> AbsVariableMethodId -> ShowS
[AbsVariableMethodId] -> ShowS
AbsVariableMethodId -> String
(Int -> AbsVariableMethodId -> ShowS)
-> (AbsVariableMethodId -> String)
-> ([AbsVariableMethodId] -> ShowS)
-> Show AbsVariableMethodId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AbsVariableMethodId] -> ShowS
$cshowList :: [AbsVariableMethodId] -> ShowS
show :: AbsVariableMethodId -> String
$cshow :: AbsVariableMethodId -> String
showsPrec :: Int -> AbsVariableMethodId -> ShowS
$cshowsPrec :: Int -> AbsVariableMethodId -> ShowS
Show, AbsVariableMethodId -> AbsVariableMethodId -> Bool
(AbsVariableMethodId -> AbsVariableMethodId -> Bool)
-> (AbsVariableMethodId -> AbsVariableMethodId -> Bool)
-> Eq AbsVariableMethodId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsVariableMethodId -> AbsVariableMethodId -> Bool
$c/= :: AbsVariableMethodId -> AbsVariableMethodId -> Bool
== :: AbsVariableMethodId -> AbsVariableMethodId -> Bool
$c== :: AbsVariableMethodId -> AbsVariableMethodId -> Bool
Eq, (forall x. AbsVariableMethodId -> Rep AbsVariableMethodId x)
-> (forall x. Rep AbsVariableMethodId x -> AbsVariableMethodId)
-> Generic AbsVariableMethodId
forall x. Rep AbsVariableMethodId x -> AbsVariableMethodId
forall x. AbsVariableMethodId -> Rep AbsVariableMethodId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsVariableMethodId x -> AbsVariableMethodId
$cfrom :: forall x. AbsVariableMethodId -> Rep AbsVariableMethodId x
Generic, AbsVariableMethodId -> ()
(AbsVariableMethodId -> ()) -> NFData AbsVariableMethodId
forall a. (a -> ()) -> NFData a
rnf :: AbsVariableMethodId -> ()
$crnf :: AbsVariableMethodId -> ()
NFData)

-- | The union type over the different method handles.
data MethodHandle r
  = MHField !(MethodHandleField r)
  | MHMethod !(MethodHandleMethod r)
  | MHInterface !(MethodHandleInterface r)

data MethodHandleField r = MethodHandleField
  { MethodHandleField r -> MethodHandleFieldKind
methodHandleFieldKind :: !MethodHandleFieldKind
  , MethodHandleField r -> Ref AbsFieldId r
methodHandleFieldRef  :: !(Ref AbsFieldId r)
  }

data MethodHandleFieldKind
  = MHGetField
  | MHGetStatic
  | MHPutField
  | MHPutStatic
  deriving (MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
(MethodHandleFieldKind -> MethodHandleFieldKind -> Bool)
-> (MethodHandleFieldKind -> MethodHandleFieldKind -> Bool)
-> Eq MethodHandleFieldKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
$c/= :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
== :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
$c== :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
Eq, Int -> MethodHandleFieldKind -> ShowS
[MethodHandleFieldKind] -> ShowS
MethodHandleFieldKind -> String
(Int -> MethodHandleFieldKind -> ShowS)
-> (MethodHandleFieldKind -> String)
-> ([MethodHandleFieldKind] -> ShowS)
-> Show MethodHandleFieldKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MethodHandleFieldKind] -> ShowS
$cshowList :: [MethodHandleFieldKind] -> ShowS
show :: MethodHandleFieldKind -> String
$cshow :: MethodHandleFieldKind -> String
showsPrec :: Int -> MethodHandleFieldKind -> ShowS
$cshowsPrec :: Int -> MethodHandleFieldKind -> ShowS
Show, MethodHandleFieldKind -> ()
(MethodHandleFieldKind -> ()) -> NFData MethodHandleFieldKind
forall a. (a -> ()) -> NFData a
rnf :: MethodHandleFieldKind -> ()
$crnf :: MethodHandleFieldKind -> ()
NFData, (forall x. MethodHandleFieldKind -> Rep MethodHandleFieldKind x)
-> (forall x. Rep MethodHandleFieldKind x -> MethodHandleFieldKind)
-> Generic MethodHandleFieldKind
forall x. Rep MethodHandleFieldKind x -> MethodHandleFieldKind
forall x. MethodHandleFieldKind -> Rep MethodHandleFieldKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MethodHandleFieldKind x -> MethodHandleFieldKind
$cfrom :: forall x. MethodHandleFieldKind -> Rep MethodHandleFieldKind x
Generic, Eq MethodHandleFieldKind
Eq MethodHandleFieldKind
-> (MethodHandleFieldKind -> MethodHandleFieldKind -> Ordering)
-> (MethodHandleFieldKind -> MethodHandleFieldKind -> Bool)
-> (MethodHandleFieldKind -> MethodHandleFieldKind -> Bool)
-> (MethodHandleFieldKind -> MethodHandleFieldKind -> Bool)
-> (MethodHandleFieldKind -> MethodHandleFieldKind -> Bool)
-> (MethodHandleFieldKind
    -> MethodHandleFieldKind -> MethodHandleFieldKind)
-> (MethodHandleFieldKind
    -> MethodHandleFieldKind -> MethodHandleFieldKind)
-> Ord MethodHandleFieldKind
MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
MethodHandleFieldKind -> MethodHandleFieldKind -> Ordering
MethodHandleFieldKind
-> MethodHandleFieldKind -> MethodHandleFieldKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MethodHandleFieldKind
-> MethodHandleFieldKind -> MethodHandleFieldKind
$cmin :: MethodHandleFieldKind
-> MethodHandleFieldKind -> MethodHandleFieldKind
max :: MethodHandleFieldKind
-> MethodHandleFieldKind -> MethodHandleFieldKind
$cmax :: MethodHandleFieldKind
-> MethodHandleFieldKind -> MethodHandleFieldKind
>= :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
$c>= :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
> :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
$c> :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
<= :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
$c<= :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
< :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
$c< :: MethodHandleFieldKind -> MethodHandleFieldKind -> Bool
compare :: MethodHandleFieldKind -> MethodHandleFieldKind -> Ordering
$ccompare :: MethodHandleFieldKind -> MethodHandleFieldKind -> Ordering
$cp1Ord :: Eq MethodHandleFieldKind
Ord)

data MethodHandleMethod r
  = MHInvokeVirtual !(Ref (InRefType MethodId) r)
  | MHInvokeStatic !(Ref AbsVariableMethodId r)
  -- ^ Since version 52.0
  | MHInvokeSpecial !(Ref AbsVariableMethodId r)
  -- ^ Since version 52.0
  | MHNewInvokeSpecial !(Ref (InRefType MethodId) r)

newtype MethodHandleInterface r = MethodHandleInterface
  {  MethodHandleInterface r -> Ref AbsInterfaceMethodId r
methodHandleInterfaceRef :: Ref AbsInterfaceMethodId r
  }

data InvokeDynamic r = InvokeDynamic
  { InvokeDynamic r -> Word16
invokeDynamicAttrIndex :: !Word16
  , InvokeDynamic r -> Ref MethodId r
invokeDynamicMethod    :: !(Ref MethodId r)
  }

-- | Hack that returns the name of a constant.
typeToStr :: Constant r -> String
typeToStr :: Constant r -> String
typeToStr Constant r
c = case Constant r
c of
  CString             SizedByteString16
_ -> String
"CString"
  CInteger            Int32
_ -> String
"CInteger"
  CFloat              Float
_ -> String
"CFloat"
  CLong               Int64
_ -> String
"CLong"
  CDouble             Double
_ -> String
"CDouble"
  CClassRef           Ref Text r
_ -> String
"CClassRef"
  CStringRef          Ref ByteString r
_ -> String
"CStringRef"
  CFieldRef           Choice (Word16, Word16) AbsFieldId r
_ -> String
"CFieldRef"
  CMethodRef          Choice (Word16, Word16) (InRefType MethodId) r
_ -> String
"CMethodRef"
  CInterfaceMethodRef Choice (Word16, Word16) (InRefType MethodId) r
_ -> String
"CInterfaceMethodRef"
  CNameAndType Ref Text r
_ Ref Text r
_      -> String
"CNameAndType"
  CMethodHandle  MethodHandle r
_      -> String
"CMethodHandle"
  CMethodType    Ref MethodDescriptor r
_      -> String
"CMethodType"
  CInvokeDynamic InvokeDynamic r
_      -> String
"CInvokeDynamic"

instance Binary (Constant Low) where
  get :: Get (Constant Low)
get = do
    Word8
ident <- Get Word8
getWord8
    case Word8
ident of
      Word8
1  -> SizedByteString16 -> Constant Low
forall r. SizedByteString16 -> Constant r
CString (SizedByteString16 -> Constant Low)
-> Get SizedByteString16 -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get SizedByteString16
forall t. Binary t => Get t
get
      Word8
3  -> Int32 -> Constant Low
forall r. Int32 -> Constant r
CInteger (Int32 -> Constant Low) -> Get Int32 -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
forall t. Binary t => Get t
get
      Word8
4  -> Float -> Constant Low
forall r. Float -> Constant r
CFloat (Float -> Constant Low) -> Get Float -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat32be
      Word8
5  -> Int64 -> Constant Low
forall r. Int64 -> Constant r
CLong (Int64 -> Constant Low) -> Get Int64 -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
forall t. Binary t => Get t
get
      Word8
6  -> Double -> Constant Low
forall r. Double -> Constant r
CDouble (Double -> Constant Low) -> Get Double -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getFloat64be
      Word8
7  -> Word16 -> Constant Low
forall r. Ref Text r -> Constant r
CClassRef (Word16 -> Constant Low) -> Get Word16 -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
8  -> Word16 -> Constant Low
forall r. Ref ByteString r -> Constant r
CStringRef (Word16 -> Constant Low) -> Get Word16 -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
9  -> (Word16, Word16) -> Constant Low
forall r. Choice (Word16, Word16) AbsFieldId r -> Constant r
CFieldRef ((Word16, Word16) -> Constant Low)
-> Get (Word16, Word16) -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Word16, Word16)
forall t. Binary t => Get t
get
      Word8
10 -> (Word16, Word16) -> Constant Low
forall r.
Choice (Word16, Word16) (InRefType MethodId) r -> Constant r
CMethodRef ((Word16, Word16) -> Constant Low)
-> Get (Word16, Word16) -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Word16, Word16)
forall t. Binary t => Get t
get
      Word8
11 -> (Word16, Word16) -> Constant Low
forall r.
Choice (Word16, Word16) (InRefType MethodId) r -> Constant r
CInterfaceMethodRef ((Word16, Word16) -> Constant Low)
-> Get (Word16, Word16) -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Word16, Word16)
forall t. Binary t => Get t
get
      Word8
12 -> Word16 -> Word16 -> Constant Low
forall r. Ref Text r -> Ref Text r -> Constant r
CNameAndType (Word16 -> Word16 -> Constant Low)
-> Get Word16 -> Get (Word16 -> Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get Get (Word16 -> Constant Low) -> Get Word16 -> Get (Constant Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
forall t. Binary t => Get t
get
      Word8
15 -> MethodHandle Low -> Constant Low
forall r. MethodHandle r -> Constant r
CMethodHandle (MethodHandle Low -> Constant Low)
-> Get (MethodHandle Low) -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (MethodHandle Low)
forall t. Binary t => Get t
get
      Word8
16 -> Word16 -> Constant Low
forall r. Ref MethodDescriptor r -> Constant r
CMethodType (Word16 -> Constant Low) -> Get Word16 -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
18 -> InvokeDynamic Low -> Constant Low
forall r. InvokeDynamic r -> Constant r
CInvokeDynamic (InvokeDynamic Low -> Constant Low)
-> Get (InvokeDynamic Low) -> Get (Constant Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (InvokeDynamic Low)
forall t. Binary t => Get t
get
      Word8
_  -> String -> Get (Constant Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Constant Low)) -> String -> Get (Constant Low)
forall a b. (a -> b) -> a -> b
$ String
"Unknown identifier " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ident

  put :: Constant Low -> Put
put Constant Low
x = case Constant Low
x of
    CString SizedByteString16
bs -> do
      Word8 -> Put
putWord8 Word8
1
      SizedByteString16 -> Put
forall t. Binary t => t -> Put
put SizedByteString16
bs
    CInteger Int32
i -> do
      Word8 -> Put
putWord8 Word8
3
      Int32 -> Put
forall t. Binary t => t -> Put
put Int32
i
    CFloat Float
i -> do
      Word8 -> Put
putWord8 Word8
4
      Float -> Put
putFloat32be Float
i
    CLong Int64
i -> do
      Word8 -> Put
putWord8 Word8
5
      Int64 -> Put
forall t. Binary t => t -> Put
put Int64
i
    CDouble Double
i -> do
      Word8 -> Put
putWord8 Word8
6
      Double -> Put
putFloat64be Double
i
    CClassRef Ref Text Low
i -> do
      Word8 -> Put
putWord8 Word8
7
      Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref Text Low
i
    CStringRef Ref ByteString Low
i -> do
      Word8 -> Put
putWord8 Word8
8
      Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref ByteString Low
i
    CFieldRef Choice (Word16, Word16) AbsFieldId Low
i -> do
      Word8 -> Put
putWord8 Word8
9
      (Word16, Word16) -> Put
forall t. Binary t => t -> Put
put (Word16, Word16)
Choice (Word16, Word16) AbsFieldId Low
i
    CMethodRef Choice (Word16, Word16) (InRefType MethodId) Low
i -> do
      Word8 -> Put
putWord8 Word8
10
      (Word16, Word16) -> Put
forall t. Binary t => t -> Put
put (Word16, Word16)
Choice (Word16, Word16) (InRefType MethodId) Low
i
    CInterfaceMethodRef Choice (Word16, Word16) (InRefType MethodId) Low
i -> do
      Word8 -> Put
putWord8 Word8
11
      (Word16, Word16) -> Put
forall t. Binary t => t -> Put
put (Word16, Word16)
Choice (Word16, Word16) (InRefType MethodId) Low
i
    CNameAndType Ref Text Low
i Ref Text Low
j -> do
      Word8 -> Put
putWord8 Word8
12
      Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref Text Low
i
      Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref Text Low
j
    CMethodHandle MethodHandle Low
h -> do
      Word8 -> Put
putWord8 Word8
15
      MethodHandle Low -> Put
forall t. Binary t => t -> Put
put MethodHandle Low
h
    CMethodType Ref MethodDescriptor Low
i -> do
      Word8 -> Put
putWord8 Word8
16
      Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref MethodDescriptor Low
i
    CInvokeDynamic InvokeDynamic Low
i -> do
      Word8 -> Put
putWord8 Word8
18
      InvokeDynamic Low -> Put
forall t. Binary t => t -> Put
put InvokeDynamic Low
i

instance Binary (MethodHandle Low) where
  get :: Get (MethodHandle Low)
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
1 -> MethodHandleField Low -> MethodHandle Low
forall r. MethodHandleField r -> MethodHandle r
MHField (MethodHandleField Low -> MethodHandle Low)
-> (Word16 -> MethodHandleField Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodHandleFieldKind
-> Ref AbsFieldId Low -> MethodHandleField Low
forall r.
MethodHandleFieldKind -> Ref AbsFieldId r -> MethodHandleField r
MethodHandleField MethodHandleFieldKind
MHGetField (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
2 -> MethodHandleField Low -> MethodHandle Low
forall r. MethodHandleField r -> MethodHandle r
MHField (MethodHandleField Low -> MethodHandle Low)
-> (Word16 -> MethodHandleField Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodHandleFieldKind
-> Ref AbsFieldId Low -> MethodHandleField Low
forall r.
MethodHandleFieldKind -> Ref AbsFieldId r -> MethodHandleField r
MethodHandleField MethodHandleFieldKind
MHGetStatic (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
3 -> MethodHandleField Low -> MethodHandle Low
forall r. MethodHandleField r -> MethodHandle r
MHField (MethodHandleField Low -> MethodHandle Low)
-> (Word16 -> MethodHandleField Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodHandleFieldKind
-> Ref AbsFieldId Low -> MethodHandleField Low
forall r.
MethodHandleFieldKind -> Ref AbsFieldId r -> MethodHandleField r
MethodHandleField MethodHandleFieldKind
MHPutField (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
4 -> MethodHandleField Low -> MethodHandle Low
forall r. MethodHandleField r -> MethodHandle r
MHField (MethodHandleField Low -> MethodHandle Low)
-> (Word16 -> MethodHandleField Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodHandleFieldKind
-> Ref AbsFieldId Low -> MethodHandleField Low
forall r.
MethodHandleFieldKind -> Ref AbsFieldId r -> MethodHandleField r
MethodHandleField MethodHandleFieldKind
MHPutStatic (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get

      Word8
5 -> MethodHandleMethod Low -> MethodHandle Low
forall r. MethodHandleMethod r -> MethodHandle r
MHMethod (MethodHandleMethod Low -> MethodHandle Low)
-> (Word16 -> MethodHandleMethod Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> MethodHandleMethod Low
forall r. Ref (InRefType MethodId) r -> MethodHandleMethod r
MHInvokeVirtual (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
6 -> MethodHandleMethod Low -> MethodHandle Low
forall r. MethodHandleMethod r -> MethodHandle r
MHMethod (MethodHandleMethod Low -> MethodHandle Low)
-> (Word16 -> MethodHandleMethod Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> MethodHandleMethod Low
forall r. Ref AbsVariableMethodId r -> MethodHandleMethod r
MHInvokeStatic (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
7 -> MethodHandleMethod Low -> MethodHandle Low
forall r. MethodHandleMethod r -> MethodHandle r
MHMethod (MethodHandleMethod Low -> MethodHandle Low)
-> (Word16 -> MethodHandleMethod Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> MethodHandleMethod Low
forall r. Ref AbsVariableMethodId r -> MethodHandleMethod r
MHInvokeSpecial (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get
      Word8
8 -> MethodHandleMethod Low -> MethodHandle Low
forall r. MethodHandleMethod r -> MethodHandle r
MHMethod (MethodHandleMethod Low -> MethodHandle Low)
-> (Word16 -> MethodHandleMethod Low) -> Word16 -> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> MethodHandleMethod Low
forall r. Ref (InRefType MethodId) r -> MethodHandleMethod r
MHNewInvokeSpecial (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get

      Word8
9 -> MethodHandleInterface Low -> MethodHandle Low
forall r. MethodHandleInterface r -> MethodHandle r
MHInterface (MethodHandleInterface Low -> MethodHandle Low)
-> (Word16 -> MethodHandleInterface Low)
-> Word16
-> MethodHandle Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> MethodHandleInterface Low
forall r. Ref AbsInterfaceMethodId r -> MethodHandleInterface r
MethodHandleInterface (Word16 -> MethodHandle Low)
-> Get Word16 -> Get (MethodHandle Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
forall t. Binary t => Get t
get

      Word8
_ -> String -> Get (MethodHandle Low)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (MethodHandle Low))
-> String -> Get (MethodHandle Low)
forall a b. (a -> b) -> a -> b
$ String
"Unknown method handle kind 'x" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
w String
"'"

  put :: MethodHandle Low -> Put
put MethodHandle Low
x = case MethodHandle Low
x of
    MHField MethodHandleField Low
h -> do
      Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ case MethodHandleField Low -> MethodHandleFieldKind
forall r. MethodHandleField r -> MethodHandleFieldKind
methodHandleFieldKind MethodHandleField Low
h of
        MethodHandleFieldKind
MHGetField  -> Word8
1
        MethodHandleFieldKind
MHGetStatic -> Word8
2
        MethodHandleFieldKind
MHPutField  -> Word8
3
        MethodHandleFieldKind
MHPutStatic -> Word8
4
      Word16 -> Put
forall t. Binary t => t -> Put
put (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MethodHandleField Low -> Ref AbsFieldId Low
forall r. MethodHandleField r -> Ref AbsFieldId r
methodHandleFieldRef MethodHandleField Low
h

    MHMethod MethodHandleMethod Low
h -> case MethodHandleMethod Low
h of
      MHInvokeVirtual    Ref (InRefType MethodId) Low
m -> Word8 -> Put
putWord8 Word8
5 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref (InRefType MethodId) Low
m
      MHInvokeStatic     Ref AbsVariableMethodId Low
m -> Word8 -> Put
putWord8 Word8
6 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref AbsVariableMethodId Low
m
      MHInvokeSpecial    Ref AbsVariableMethodId Low
m -> Word8 -> Put
putWord8 Word8
7 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref AbsVariableMethodId Low
m
      MHNewInvokeSpecial Ref (InRefType MethodId) Low
m -> Word8 -> Put
putWord8 Word8
8 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
forall t. Binary t => t -> Put
put Word16
Ref (InRefType MethodId) Low
m

    MHInterface MethodHandleInterface Low
h -> do
      Word8 -> Put
putWord8 Word8
9
      Word16 -> Put
forall t. Binary t => t -> Put
put (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ MethodHandleInterface Low -> Ref AbsInterfaceMethodId Low
forall r. MethodHandleInterface r -> Ref AbsInterfaceMethodId r
methodHandleInterfaceRef MethodHandleInterface Low
h

-- | Some of the 'Constant's take up more space in the constant pool than other.
-- Notice that 'Language.JVM.Constant.String' and 'MethodType' is not of size
-- 32, but is still awarded value 1. This is due to an
-- [inconsistency](http://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.4.5)
-- in JVM.
constantSize :: Constant r -> Index
constantSize :: Constant r -> Word16
constantSize Constant r
x = case Constant r
x of
  CDouble Double
_ -> Word16
2
  CLong   Int64
_ -> Word16
2
  Constant r
_         -> Word16
1

-- | 'Referenceable' is something that can exist in the constant pool.
class Referenceable a where
  fromConst
    :: (Monad m)
    => (forall a'. String -> m a')
    -> Constant High
    -> m a
  toConst
    :: (Monad m)
    => a
    -> m (Constant High)

instance Referenceable (Constant High) where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m (Constant High)
fromConst forall a'. String -> m a'
_ = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return
  toConst :: Constant High -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return

instance TextSerializable a => Referenceable (NameAndType a) where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m (NameAndType a)
fromConst forall a'. String -> m a'
err (CNameAndType Ref Text High
rn Ref Text High
txt) = do
    a
md <- (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall a'. String -> m a'
err a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> m a) -> Either String a -> m a
forall a b. (a -> b) -> a -> b
$ Text -> Either String a
forall a. TextSerializable a => Text -> Either String a
deserialize Text
Ref Text High
txt
    NameAndType a -> m (NameAndType a)
forall (m :: * -> *) a. Monad m => a -> m a
return (NameAndType a -> m (NameAndType a))
-> NameAndType a -> m (NameAndType a)
forall a b. (a -> b) -> a -> b
$ Text -> a -> NameAndType a
forall a. Text -> a -> NameAndType a
NameAndType Text
Ref Text High
rn a
md
  fromConst forall a'. String -> m a'
e Constant High
c = String
-> (String -> m (NameAndType a))
-> Constant High
-> m (NameAndType a)
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"CNameAndType" String -> m (NameAndType a)
forall a'. String -> m a'
e Constant High
c

  toConst :: NameAndType a -> m (Constant High)
toConst (NameAndType Text
rn a
md) = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Ref Text High -> Ref Text High -> Constant High
forall r. Ref Text r -> Ref Text r -> Constant r
CNameAndType Text
Ref Text High
rn (a -> Text
forall a. TextSerializable a => a -> Text
serialize a
md)

-- TODO: Find good encoding of string.
instance Referenceable Text.Text where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m Text
fromConst forall a'. String -> m a'
err Constant High
c = case Constant High
c of
    CString SizedByteString16
str -> case SizedByteString16 -> Either UnicodeException Text
forall w. SizedByteString w -> Either UnicodeException Text
sizedByteStringToText SizedByteString16
str of
      Left (TE.DecodeError String
msg Maybe Word8
_) ->
        String -> m Text
forall a'. String -> m a'
err (String -> m Text) -> String -> m Text
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> String
badEncoding String
msg (SizedByteString16 -> ByteString
forall w. SizedByteString w -> ByteString
unSizedByteString SizedByteString16
str)
      Left  UnicodeException
_   -> String -> m Text
forall a. HasCallStack => String -> a
error String
"This is deprecated in the api"
      Right Text
txt -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
txt
    Constant High
a -> String -> m Text
forall a'. String -> m a'
err (String -> m Text) -> String -> m Text
forall a b. (a -> b) -> a -> b
$ String -> Constant High -> String
forall r. String -> Constant r -> String
wrongType String
"String" Constant High
a

  toConst :: Text -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (Text -> Constant High) -> Text -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteString16 -> Constant High
forall r. SizedByteString16 -> Constant r
CString (SizedByteString16 -> Constant High)
-> (Text -> SizedByteString16) -> Text -> Constant High
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SizedByteString16
forall w. Text -> SizedByteString w
sizedByteStringFromText

instance Referenceable BS.ByteString where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m ByteString
fromConst forall a'. String -> m a'
err Constant High
c = case Constant High
c of
    CString SizedByteString16
str -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ SizedByteString16 -> ByteString
forall w. SizedByteString w -> ByteString
unSizedByteString SizedByteString16
str
    Constant High
a           -> String -> m ByteString
forall a'. String -> m a'
err (String -> m ByteString) -> String -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> Constant High -> String
forall r. String -> Constant r -> String
wrongType String
"String" Constant High
a
  toConst :: ByteString -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (ByteString -> Constant High) -> ByteString -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteString16 -> Constant High
forall r. SizedByteString16 -> Constant r
CString (SizedByteString16 -> Constant High)
-> (ByteString -> SizedByteString16) -> ByteString -> Constant High
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SizedByteString16
forall w. ByteString -> SizedByteString w
SizedByteString


instance Referenceable ClassName where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m ClassName
fromConst forall a'. String -> m a'
err = \case
    CClassRef Ref Text High
r -> case Text -> Either String ClassName
textCls Text
Ref Text High
r of
      Right ClassName
cn -> ClassName -> m ClassName
forall (m :: * -> *) a. Monad m => a -> m a
return ClassName
cn
      Left String
msg ->
        String -> m ClassName
forall a'. String -> m a'
err (String -> m ClassName) -> String -> m ClassName
forall a b. (a -> b) -> a -> b
$ String
"Could not read class name: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
Ref Text High
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
    Constant High
a -> String -> m ClassName
forall a'. String -> m a'
err (String -> m ClassName) -> String -> m ClassName
forall a b. (a -> b) -> a -> b
$ String -> Constant High -> String
forall r. String -> Constant r -> String
wrongType String
"ClassRef" Constant High
a

  toConst :: ClassName -> m (Constant High)
toConst (ClassName -> Text
classNameAsText -> Text
txt) = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (Text -> Constant High) -> Text -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Constant High
forall r. Ref Text r -> Constant r
CClassRef (Text -> m (Constant High)) -> Text -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Text
txt

instance Referenceable JRefType where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m JRefType
fromConst forall a'. String -> m a'
err = \case
    CClassRef Ref Text High
r -> case Parser JRefType -> Text -> Either String JRefType
forall a. Parser a -> Text -> Either String a
deserializeWith Parser JRefType
parseFlatJRefType Text
Ref Text High
r of
      Right JRefType
t -> JRefType -> m JRefType
forall (m :: * -> *) a. Monad m => a -> m a
return JRefType
t
      Left String
msg ->
        String -> m JRefType
forall a'. String -> m a'
err
          (String -> m JRefType) -> String -> m JRefType
forall a b. (a -> b) -> a -> b
$  String
"Could not read the flat reference type: "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
Ref Text High
r
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
          String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
    Constant High
a -> String -> m JRefType
forall a'. String -> m a'
err (String -> m JRefType) -> String -> m JRefType
forall a b. (a -> b) -> a -> b
$ String -> Constant High -> String
forall r. String -> Constant r -> String
wrongType String
"ClassRef" Constant High
a
  toConst :: JRefType -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (JRefType -> Constant High) -> JRefType -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Constant High
forall r. Ref Text r -> Constant r
CClassRef (Text -> Constant High)
-> (JRefType -> Text) -> JRefType -> Constant High
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (JRefType -> Builder) -> JRefType -> Text
forall a. (a -> Builder) -> a -> Text
serializeWith JRefType -> Builder
serializeFlatJRefType

instance Referenceable ReturnDescriptor where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m ReturnDescriptor
fromConst forall a'. String -> m a'
err = (forall a'. String -> m a') -> Constant High -> m Text
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
(forall a'. String -> m a') -> Constant High -> m a
fromConst forall a'. String -> m a'
err (Constant High -> m Text)
-> (Text -> m ReturnDescriptor)
-> Constant High
-> m ReturnDescriptor
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> m ReturnDescriptor)
-> (ReturnDescriptor -> m ReturnDescriptor)
-> Either String ReturnDescriptor
-> m ReturnDescriptor
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m ReturnDescriptor
forall a'. String -> m a'
err ReturnDescriptor -> m ReturnDescriptor
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ReturnDescriptor -> m ReturnDescriptor)
-> (Text -> Either String ReturnDescriptor)
-> Text
-> m ReturnDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ReturnDescriptor
forall a. TextSerializable a => Text -> Either String a
deserialize
  toConst :: ReturnDescriptor -> m (Constant High)
toConst = Text -> m (Constant High)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
a -> m (Constant High)
toConst (Text -> m (Constant High))
-> (ReturnDescriptor -> Text)
-> ReturnDescriptor
-> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReturnDescriptor -> Text
forall a. TextSerializable a => a -> Text
serialize

instance Referenceable MethodDescriptor where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m MethodDescriptor
fromConst forall a'. String -> m a'
err = (forall a'. String -> m a') -> Constant High -> m Text
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
(forall a'. String -> m a') -> Constant High -> m a
fromConst forall a'. String -> m a'
err (Constant High -> m Text)
-> (Text -> m MethodDescriptor)
-> Constant High
-> m MethodDescriptor
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> m MethodDescriptor)
-> (MethodDescriptor -> m MethodDescriptor)
-> Either String MethodDescriptor
-> m MethodDescriptor
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m MethodDescriptor
forall a'. String -> m a'
err MethodDescriptor -> m MethodDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String MethodDescriptor -> m MethodDescriptor)
-> (Text -> Either String MethodDescriptor)
-> Text
-> m MethodDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String MethodDescriptor
forall a. TextSerializable a => Text -> Either String a
deserialize
  toConst :: MethodDescriptor -> m (Constant High)
toConst = Text -> m (Constant High)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
a -> m (Constant High)
toConst (Text -> m (Constant High))
-> (MethodDescriptor -> Text)
-> MethodDescriptor
-> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodDescriptor -> Text
forall a. TextSerializable a => a -> Text
serialize

instance Referenceable FieldDescriptor where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m FieldDescriptor
fromConst forall a'. String -> m a'
err = (forall a'. String -> m a') -> Constant High -> m Text
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
(forall a'. String -> m a') -> Constant High -> m a
fromConst forall a'. String -> m a'
err (Constant High -> m Text)
-> (Text -> m FieldDescriptor)
-> Constant High
-> m FieldDescriptor
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String -> m FieldDescriptor)
-> (FieldDescriptor -> m FieldDescriptor)
-> Either String FieldDescriptor
-> m FieldDescriptor
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m FieldDescriptor
forall a'. String -> m a'
err FieldDescriptor -> m FieldDescriptor
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String FieldDescriptor -> m FieldDescriptor)
-> (Text -> Either String FieldDescriptor)
-> Text
-> m FieldDescriptor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String FieldDescriptor
forall a. TextSerializable a => Text -> Either String a
deserialize
  toConst :: FieldDescriptor -> m (Constant High)
toConst = Text -> m (Constant High)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
a -> m (Constant High)
toConst (Text -> m (Constant High))
-> (FieldDescriptor -> Text)
-> FieldDescriptor
-> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescriptor -> Text
forall a. TextSerializable a => a -> Text
serialize

instance Referenceable MethodId where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m MethodId
fromConst forall a'. String -> m a'
err Constant High
x = NameAndType MethodDescriptor -> MethodId
MethodId (NameAndType MethodDescriptor -> MethodId)
-> m (NameAndType MethodDescriptor) -> m MethodId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a'. String -> m a')
-> Constant High -> m (NameAndType MethodDescriptor)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
(forall a'. String -> m a') -> Constant High -> m a
fromConst forall a'. String -> m a'
err Constant High
x
  toConst :: MethodId -> m (Constant High)
toConst (MethodId NameAndType MethodDescriptor
s) = NameAndType MethodDescriptor -> m (Constant High)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
a -> m (Constant High)
toConst NameAndType MethodDescriptor
s

instance Referenceable FieldId where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m FieldId
fromConst forall a'. String -> m a'
err Constant High
x = NameAndType FieldDescriptor -> FieldId
FieldId (NameAndType FieldDescriptor -> FieldId)
-> m (NameAndType FieldDescriptor) -> m FieldId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a'. String -> m a')
-> Constant High -> m (NameAndType FieldDescriptor)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
(forall a'. String -> m a') -> Constant High -> m a
fromConst forall a'. String -> m a'
err Constant High
x
  toConst :: FieldId -> m (Constant High)
toConst (FieldId NameAndType FieldDescriptor
s) = NameAndType FieldDescriptor -> m (Constant High)
forall a (m :: * -> *).
(Referenceable a, Monad m) =>
a -> m (Constant High)
toConst NameAndType FieldDescriptor
s

instance Referenceable AbsFieldId where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m AbsFieldId
fromConst forall a'. String -> m a'
err = \case
    CFieldRef Choice (Word16, Word16) AbsFieldId High
s -> AbsFieldId -> m AbsFieldId
forall (m :: * -> *) a. Monad m => a -> m a
return Choice (Word16, Word16) AbsFieldId High
AbsFieldId
s
    Constant High
c           -> String -> (String -> m AbsFieldId) -> Constant High -> m AbsFieldId
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"CFieldRef" String -> m AbsFieldId
forall a'. String -> m a'
err Constant High
c

  toConst :: AbsFieldId -> m (Constant High)
toConst AbsFieldId
s = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Choice (Word16, Word16) AbsFieldId High -> Constant High
forall r. Choice (Word16, Word16) AbsFieldId r -> Constant r
CFieldRef Choice (Word16, Word16) AbsFieldId High
AbsFieldId
s

instance Referenceable (InRefType MethodId) where
  fromConst :: (forall a'. String -> m a')
-> Constant High -> m (InRefType MethodId)
fromConst forall a'. String -> m a'
err = \case
    CMethodRef Choice (Word16, Word16) (InRefType MethodId) High
s -> InRefType MethodId -> m (InRefType MethodId)
forall (m :: * -> *) a. Monad m => a -> m a
return (InRefType MethodId -> m (InRefType MethodId))
-> InRefType MethodId -> m (InRefType MethodId)
forall a b. (a -> b) -> a -> b
$ Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s
    Constant High
c            -> String
-> (String -> m (InRefType MethodId))
-> Constant High
-> m (InRefType MethodId)
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"CMethodRef" String -> m (InRefType MethodId)
forall a'. String -> m a'
err Constant High
c

  toConst :: InRefType MethodId -> m (Constant High)
toConst InRefType MethodId
s = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Choice (Word16, Word16) (InRefType MethodId) High -> Constant High
forall r.
Choice (Word16, Word16) (InRefType MethodId) r -> Constant r
CMethodRef Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s

instance Referenceable AbsVariableMethodId where
  fromConst :: (forall a'. String -> m a')
-> Constant High -> m AbsVariableMethodId
fromConst forall a'. String -> m a'
err = \case
    CMethodRef          Choice (Word16, Word16) (InRefType MethodId) High
s -> AbsVariableMethodId -> m AbsVariableMethodId
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsVariableMethodId -> m AbsVariableMethodId)
-> AbsVariableMethodId -> m AbsVariableMethodId
forall a b. (a -> b) -> a -> b
$ Bool -> InRefType MethodId -> AbsVariableMethodId
AbsVariableMethodId Bool
False Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s
    CInterfaceMethodRef Choice (Word16, Word16) (InRefType MethodId) High
s -> AbsVariableMethodId -> m AbsVariableMethodId
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsVariableMethodId -> m AbsVariableMethodId)
-> AbsVariableMethodId -> m AbsVariableMethodId
forall a b. (a -> b) -> a -> b
$ Bool -> InRefType MethodId -> AbsVariableMethodId
AbsVariableMethodId Bool
True Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s
    Constant High
c                     -> String
-> (String -> m AbsVariableMethodId)
-> Constant High
-> m AbsVariableMethodId
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"CMethodRef or CInterfaceMethodRef" String -> m AbsVariableMethodId
forall a'. String -> m a'
err Constant High
c

  toConst :: AbsVariableMethodId -> m (Constant High)
toConst (AbsVariableMethodId Bool
t InRefType MethodId
s) =
    Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ if Bool
t then Choice (Word16, Word16) (InRefType MethodId) High -> Constant High
forall r.
Choice (Word16, Word16) (InRefType MethodId) r -> Constant r
CInterfaceMethodRef Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s else Choice (Word16, Word16) (InRefType MethodId) High -> Constant High
forall r.
Choice (Word16, Word16) (InRefType MethodId) r -> Constant r
CMethodRef Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s

instance Referenceable AbsInterfaceMethodId where
  fromConst :: (forall a'. String -> m a')
-> Constant High -> m AbsInterfaceMethodId
fromConst forall a'. String -> m a'
_   (CInterfaceMethodRef Choice (Word16, Word16) (InRefType MethodId) High
s) = AbsInterfaceMethodId -> m AbsInterfaceMethodId
forall (m :: * -> *) a. Monad m => a -> m a
return (AbsInterfaceMethodId -> m AbsInterfaceMethodId)
-> (InRefType MethodId -> AbsInterfaceMethodId)
-> InRefType MethodId
-> m AbsInterfaceMethodId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InRefType MethodId -> AbsInterfaceMethodId
AbsInterfaceMethodId (InRefType MethodId -> m AbsInterfaceMethodId)
-> InRefType MethodId -> m AbsInterfaceMethodId
forall a b. (a -> b) -> a -> b
$ Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s
  fromConst forall a'. String -> m a'
err Constant High
c                       = String
-> (String -> m AbsInterfaceMethodId)
-> Constant High
-> m AbsInterfaceMethodId
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"CInterfaceMethodRef" String -> m AbsInterfaceMethodId
forall a'. String -> m a'
err Constant High
c

  toConst :: AbsInterfaceMethodId -> m (Constant High)
toConst (AbsInterfaceMethodId InRefType MethodId
s) = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ Choice (Word16, Word16) (InRefType MethodId) High -> Constant High
forall r.
Choice (Word16, Word16) (InRefType MethodId) r -> Constant r
CInterfaceMethodRef Choice (Word16, Word16) (InRefType MethodId) High
InRefType MethodId
s


instance Referenceable (InvokeDynamic High) where
  fromConst :: (forall a'. String -> m a')
-> Constant High -> m (InvokeDynamic High)
fromConst forall a'. String -> m a'
_   (CInvokeDynamic InvokeDynamic High
c) = InvokeDynamic High -> m (InvokeDynamic High)
forall (m :: * -> *) a. Monad m => a -> m a
return InvokeDynamic High
c
  fromConst forall a'. String -> m a'
err Constant High
c                  = String
-> (String -> m (InvokeDynamic High))
-> Constant High
-> m (InvokeDynamic High)
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"CInvokeDynamic" String -> m (InvokeDynamic High)
forall a'. String -> m a'
err Constant High
c

  toConst :: InvokeDynamic High -> m (Constant High)
toConst InvokeDynamic High
s = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ InvokeDynamic High -> Constant High
forall r. InvokeDynamic r -> Constant r
CInvokeDynamic InvokeDynamic High
s

instance Referenceable (MethodHandle High) where
  fromConst :: (forall a'. String -> m a')
-> Constant High -> m (MethodHandle High)
fromConst forall a'. String -> m a'
_   (CMethodHandle MethodHandle High
c) = MethodHandle High -> m (MethodHandle High)
forall (m :: * -> *) a. Monad m => a -> m a
return MethodHandle High
c
  fromConst forall a'. String -> m a'
err Constant High
c                 = String
-> (String -> m (MethodHandle High))
-> Constant High
-> m (MethodHandle High)
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"CMethodHandle" String -> m (MethodHandle High)
forall a'. String -> m a'
err Constant High
c

  toConst :: MethodHandle High -> m (Constant High)
toConst MethodHandle High
s = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> Constant High -> m (Constant High)
forall a b. (a -> b) -> a -> b
$ MethodHandle High -> Constant High
forall r. MethodHandle r -> Constant r
CMethodHandle MethodHandle High
s


expected :: String -> (String -> a) -> (Constant r) -> a
expected :: String -> (String -> a) -> Constant r -> a
expected String
name String -> a
err Constant r
c = String -> a
err (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String -> Constant r -> String
forall r. String -> Constant r -> String
wrongType String
name Constant r
c


wrongType :: String -> Constant r -> String
wrongType :: String -> Constant r -> String
wrongType String
n Constant r
c = String
"Expected '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"', but found '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Constant r -> String
forall r. Constant r -> String
typeToStr Constant r
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."

badEncoding :: String -> BS.ByteString -> String
badEncoding :: String -> ByteString -> String
badEncoding String
str ByteString
bs = String
"Could not encode '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs

-- $(deriveBaseWithBinary ''MethodId)
-- $(deriveBaseWithBinary ''FieldId)

$(deriveBase ''Constant)
$(deriveBase ''MethodHandle)
$(deriveBase ''MethodHandleField)
$(deriveBase ''MethodHandleMethod)
$(deriveBase ''MethodHandleInterface)
$(deriveBaseWithBinary ''InvokeDynamic)

-- $(deriveBaseWithBinary ''AbsMethodId)
-- $(deriveBaseWithBinary ''AbsFieldId)
-- $(deriveBaseWithBinary ''AbsInterfaceMethodId)
-- $(deriveBaseWithBinary ''AbsVariableMethodId)

type VInteger = Int32
type VLong = Int64
type VFloat = Float
type VDouble = Double
type VString = BS.ByteString

instance Referenceable VInteger where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m Int32
fromConst forall a'. String -> m a'
err = \case
    CInteger Int32
i -> Int32 -> m Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
i
    Constant High
x          -> String -> (String -> m Int32) -> Constant High -> m Int32
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"Integer" String -> m Int32
forall a'. String -> m a'
err Constant High
x
  toConst :: Int32 -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (Int32 -> Constant High) -> Int32 -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Constant High
forall r. Int32 -> Constant r
CInteger

instance Referenceable VLong where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m Int64
fromConst forall a'. String -> m a'
err = \case
    CLong Int64
i -> Int64 -> m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
i
    Constant High
x       -> String -> (String -> m Int64) -> Constant High -> m Int64
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"Long" String -> m Int64
forall a'. String -> m a'
err Constant High
x
  toConst :: Int64 -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (Int64 -> Constant High) -> Int64 -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Constant High
forall r. Int64 -> Constant r
CLong

instance Referenceable VFloat where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m Float
fromConst forall a'. String -> m a'
err = \case
    CFloat Float
i -> Float -> m Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
i
    Constant High
x        -> String -> (String -> m Float) -> Constant High -> m Float
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"Float" String -> m Float
forall a'. String -> m a'
err Constant High
x
  toConst :: Float -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (Float -> Constant High) -> Float -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Constant High
forall r. Float -> Constant r
CFloat

instance Referenceable VDouble where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m Double
fromConst forall a'. String -> m a'
err = \case
    CDouble Double
i -> Double -> m Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
i
    Constant High
x         -> String -> (String -> m Double) -> Constant High -> m Double
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"Double" String -> m Double
forall a'. String -> m a'
err Constant High
x
  toConst :: Double -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (Double -> Constant High) -> Double -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Constant High
forall r. Double -> Constant r
CDouble

-- instance Referenceable VString where
--   fromConst err = \case
--     CStringRef i -> return i
--     x -> expected "StringRef" err x
--   toConst = return . CStringRef

-- | A constant pool value in java
data JValue
  = VInteger VInteger
  | VLong VLong
  | VFloat VFloat
  | VDouble VDouble
  | VString VString
  | VClass JRefType
  | VMethodType MethodDescriptor
  | VMethodHandle (MethodHandle High)
  deriving (Int -> JValue -> ShowS
[JValue] -> ShowS
JValue -> String
(Int -> JValue -> ShowS)
-> (JValue -> String) -> ([JValue] -> ShowS) -> Show JValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JValue] -> ShowS
$cshowList :: [JValue] -> ShowS
show :: JValue -> String
$cshow :: JValue -> String
showsPrec :: Int -> JValue -> ShowS
$cshowsPrec :: Int -> JValue -> ShowS
Show, JValue -> JValue -> Bool
(JValue -> JValue -> Bool)
-> (JValue -> JValue -> Bool) -> Eq JValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JValue -> JValue -> Bool
$c/= :: JValue -> JValue -> Bool
== :: JValue -> JValue -> Bool
$c== :: JValue -> JValue -> Bool
Eq, (forall x. JValue -> Rep JValue x)
-> (forall x. Rep JValue x -> JValue) -> Generic JValue
forall x. Rep JValue x -> JValue
forall x. JValue -> Rep JValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JValue x -> JValue
$cfrom :: forall x. JValue -> Rep JValue x
Generic, JValue -> ()
(JValue -> ()) -> NFData JValue
forall a. (a -> ()) -> NFData a
rnf :: JValue -> ()
$crnf :: JValue -> ()
NFData)

instance Referenceable JValue where
  fromConst :: (forall a'. String -> m a') -> Constant High -> m JValue
fromConst forall a'. String -> m a'
err = \case
    CStringRef Ref ByteString High
s -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ ByteString -> JValue
VString ByteString
Ref ByteString High
s
    CInteger   Int32
i -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ Int32 -> JValue
VInteger Int32
i
    CFloat     Float
f -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ Float -> JValue
VFloat Float
f
    CLong      Int64
l -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ Int64 -> JValue
VLong Int64
l
    CDouble    Double
d -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ Double -> JValue
VDouble Double
d
    CClassRef  Ref Text High
r -> case Parser JRefType -> Text -> Either String JRefType
forall a. Parser a -> Text -> Either String a
deserializeWith Parser JRefType
parseFlatJRefType Text
Ref Text High
r of
      Right JRefType
rt -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ JRefType -> JValue
VClass JRefType
rt
      Left String
msg ->
        String -> m JValue
forall a'. String -> m a'
err (String -> m JValue) -> String -> m JValue
forall a b. (a -> b) -> a -> b
$ String
"Could not parse reftype " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
Ref Text High
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
    CMethodHandle MethodHandle High
m -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ MethodHandle High -> JValue
VMethodHandle MethodHandle High
m
    CMethodType   Ref MethodDescriptor High
t -> JValue -> m JValue
forall (m :: * -> *) a. Monad m => a -> m a
return (JValue -> m JValue) -> JValue -> m JValue
forall a b. (a -> b) -> a -> b
$ MethodDescriptor -> JValue
VMethodType Ref MethodDescriptor High
MethodDescriptor
t
    Constant High
x               -> String -> (String -> m JValue) -> Constant High -> m JValue
forall a r. String -> (String -> a) -> Constant r -> a
expected String
"Value" String -> m JValue
forall a'. String -> m a'
err Constant High
x
  {-# INLINE fromConst #-}

  toConst :: JValue -> m (Constant High)
toConst = Constant High -> m (Constant High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Constant High -> m (Constant High))
-> (JValue -> Constant High) -> JValue -> m (Constant High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    VString       ByteString
s -> Ref ByteString High -> Constant High
forall r. Ref ByteString r -> Constant r
CStringRef ByteString
Ref ByteString High
s
    VInteger      Int32
i -> Int32 -> Constant High
forall r. Int32 -> Constant r
CInteger Int32
i
    VFloat        Float
f -> Float -> Constant High
forall r. Float -> Constant r
CFloat Float
f
    VLong         Int64
l -> Int64 -> Constant High
forall r. Int64 -> Constant r
CLong Int64
l
    VDouble       Double
d -> Double -> Constant High
forall r. Double -> Constant r
CDouble Double
d
    VClass ((JRefType -> Builder) -> JRefType -> Text
forall a. (a -> Builder) -> a -> Text
serializeWith JRefType -> Builder
serializeFlatJRefType -> Text
r) -> Ref Text High -> Constant High
forall r. Ref Text r -> Constant r
CClassRef Text
Ref Text High
r
    VMethodHandle MethodHandle High
m -> MethodHandle High -> Constant High
forall r. MethodHandle r -> Constant r
CMethodHandle MethodHandle High
m
    VMethodType   MethodDescriptor
t -> Ref MethodDescriptor High -> Constant High
forall r. Ref MethodDescriptor r -> Constant r
CMethodType Ref MethodDescriptor High
MethodDescriptor
t
  {-# INLINE toConst #-}