{-# LANGUAGE DeriveAnyClass              #-}
{-# LANGUAGE ViewPatterns                #-}
{-# LANGUAGE StandaloneDeriving          #-}
{-# LANGUAGE TypeFamilies                #-}
{-# LANGUAGE TemplateHaskell             #-}
{-# LANGUAGE DeriveGeneric               #-}
{-# LANGUAGE LambdaCase                  #-}
{-# LANGUAGE FlexibleInstances           #-}
{-# LANGUAGE OverloadedStrings           #-}
{-|
Module      : Language.JVM.Type
Copyright   : (c) Christian Gram Kalhauge, 2018
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu

This module contains the 'JType', 'ClassName', 'MethodDescriptor', and
'FieldDescriptor'.
-}
module Language.JVM.Type
  (
  -- * Base types
  -- ** ClassName
    ClassName(classNameAsText)
  , textCls
  , textClsOrFail
  , strClsOrFail
  , dotCls
  , unsafeTextCls
  , parseClassName
  , serializeClassName

  -- ** JType
  , JType(..)
  , jTypeSize
  , parseJType
  , serializeJType
  , JBaseType(..)
  , jBaseTypeToChar
  , jBaseTypeSize
  , parseJBaseType
  , serializeJBaseType
  , JRefType(..)
  , refTypeDepth
  , parseJRefType
  , serializeJRefType
  , parseFlatJRefType
  , serializeFlatJRefType

  -- ** MethodDescriptor
  , MethodDescriptor(..)
  , parseMethodDescriptor
  , serializeMethodDescriptor
  , ReturnDescriptor(..)
  , parseReturnDescriptor
  , serializeReturnDescriptor

  -- ** FieldDescriptor
  , FieldDescriptor(..)
  , parseFieldDescriptor
  , serializeFieldDescriptor

  -- ** NameAndType
  , NameAndType(..)
  , parseNameAndType
  , serializeNameAndType
  , WithName(..)
  , AsNameAndType(..)

  -- ** MethodId
  , MethodId(..)
  , parseMethodId
  , serializeMethodId

  -- ** FieldId
  , FieldId(..)
  , parseFieldId
  , serializeFieldId

  -- ** InClass
  , InClass(..)
  , parseInClass
  , serializeInClass

  -- ** InRefType
  , InRefType(..)
  , parseInRefType
  , serializeInRefType
  , inRefTypeAsInClass

  -- ** AbsMethodId
  , AbsMethodId(..)
  , parseAbsMethodId
  , serializeAbsMethodId

  -- ** AbsFieldId
  , AbsFieldId(..)
  , parseAbsFieldId
  , serializeAbsFieldId

  -- * Re-export
  , module Language.JVM.TextSerializable
  )
where

-- base
import           Data.String
import           Control.Applicative
import           Data.Semigroup
import           GHC.Generics                   ( Generic )
import           Prelude                 hiding ( takeWhile )

-- deepseq
import           Control.DeepSeq                ( NFData )

-- attoparsec
import           Data.Attoparsec.Text

-- text
import qualified Data.Text                     as Text
import           Data.Text.Lazy.Builder        as Builder

-- jvm-binary
import           Language.JVM.TextSerializable

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> let parseTestOne p = parseTest (p <* endOfInput)

-- | A class name
newtype ClassName = ClassName
  { ClassName -> Text
classNameAsText :: Text.Text
  } deriving (ClassName -> ClassName -> Bool
(ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool) -> Eq ClassName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassName -> ClassName -> Bool
$c/= :: ClassName -> ClassName -> Bool
== :: ClassName -> ClassName -> Bool
$c== :: ClassName -> ClassName -> Bool
Eq, Eq ClassName
Eq ClassName
-> (ClassName -> ClassName -> Ordering)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> Bool)
-> (ClassName -> ClassName -> ClassName)
-> (ClassName -> ClassName -> ClassName)
-> Ord ClassName
ClassName -> ClassName -> Bool
ClassName -> ClassName -> Ordering
ClassName -> ClassName -> ClassName
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 :: ClassName -> ClassName -> ClassName
$cmin :: ClassName -> ClassName -> ClassName
max :: ClassName -> ClassName -> ClassName
$cmax :: ClassName -> ClassName -> ClassName
>= :: ClassName -> ClassName -> Bool
$c>= :: ClassName -> ClassName -> Bool
> :: ClassName -> ClassName -> Bool
$c> :: ClassName -> ClassName -> Bool
<= :: ClassName -> ClassName -> Bool
$c<= :: ClassName -> ClassName -> Bool
< :: ClassName -> ClassName -> Bool
$c< :: ClassName -> ClassName -> Bool
compare :: ClassName -> ClassName -> Ordering
$ccompare :: ClassName -> ClassName -> Ordering
$cp1Ord :: Eq ClassName
Ord, (forall x. ClassName -> Rep ClassName x)
-> (forall x. Rep ClassName x -> ClassName) -> Generic ClassName
forall x. Rep ClassName x -> ClassName
forall x. ClassName -> Rep ClassName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClassName x -> ClassName
$cfrom :: forall x. ClassName -> Rep ClassName x
Generic, ClassName -> ()
(ClassName -> ()) -> NFData ClassName
forall a. (a -> ()) -> NFData a
rnf :: ClassName -> ()
$crnf :: ClassName -> ()
NFData)

-- | Parses a ClassName from Text, might fail.
textCls :: Text.Text -> Either String ClassName
textCls :: Text -> Either String ClassName
textCls = Text -> Either String ClassName
forall a. TextSerializable a => Text -> Either String a
deserialize

-- | Converts a text directly into a ClassName, will fail silently and
-- might corrupt data.
unsafeTextCls :: Text.Text -> ClassName
unsafeTextCls :: Text -> ClassName
unsafeTextCls = Text -> ClassName
ClassName

-- | Parses a ClassName from String, might fail with an exception.
-- *warning* Unpure.
strClsOrFail :: String -> ClassName
strClsOrFail :: String -> ClassName
strClsOrFail = Text -> ClassName
textClsOrFail (Text -> ClassName) -> (String -> Text) -> String -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- | Parses a ClassName from String, might fail with an exception.
-- *warning* Unpure.
textClsOrFail :: Text.Text -> ClassName
textClsOrFail :: Text -> ClassName
textClsOrFail = (String -> ClassName)
-> (ClassName -> ClassName) -> Either String ClassName -> ClassName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ClassName
forall a. HasCallStack => String -> a
error ClassName -> ClassName
forall a. a -> a
id (Either String ClassName -> ClassName)
-> (Text -> Either String ClassName) -> Text -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ClassName
forall a. TextSerializable a => Text -> Either String a
deserialize

-- | Takes the dot representation and converts it into a class.
dotCls :: Text.Text -> Either String ClassName
dotCls :: Text -> Either String ClassName
dotCls = Text -> Either String ClassName
textCls (Text -> Either String ClassName)
-> (Text -> Text) -> Text -> Either String ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> Text -> Text
Text.map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
'/' else Char
c)

-- | Parse a 'ClassName', should not be any of '.;[<>:',
--
-- >>> deserialize parseClassName "java/lang/Object"
-- Right "java/lang/Object"
--
-- >>> deserialize parseClassName "java;"
-- Left "endOfInput"
parseClassName :: Parser ClassName
parseClassName :: Parser ClassName
parseClassName = Text -> ClassName
ClassName (Text -> ClassName) -> Parser Text Text -> Parser ClassName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
takeWhile1 (String -> Char -> Bool
notInClass String
".;[<>:") Parser ClassName -> String -> Parser ClassName
forall i a. Parser i a -> String -> Parser i a
<?> String
"ClassName"

-- | Display a ClassName
serializeClassName :: ClassName -> Builder
serializeClassName :: ClassName -> Builder
serializeClassName = Text -> Builder
Builder.fromText (Text -> Builder) -> (ClassName -> Text) -> ClassName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassName -> Text
classNameAsText

instance TextSerializable ClassName where
  parseText :: Parser ClassName
parseText = Parser ClassName
parseClassName
  toBuilder :: ClassName -> Builder
toBuilder = ClassName -> Builder
serializeClassName

-- | A 'JRefType' is a Class or an Array.
data JRefType
  = JTClass !ClassName
  | JTArray !JType
  deriving (JRefType -> JRefType -> Bool
(JRefType -> JRefType -> Bool)
-> (JRefType -> JRefType -> Bool) -> Eq JRefType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JRefType -> JRefType -> Bool
$c/= :: JRefType -> JRefType -> Bool
== :: JRefType -> JRefType -> Bool
$c== :: JRefType -> JRefType -> Bool
Eq, Eq JRefType
Eq JRefType
-> (JRefType -> JRefType -> Ordering)
-> (JRefType -> JRefType -> Bool)
-> (JRefType -> JRefType -> Bool)
-> (JRefType -> JRefType -> Bool)
-> (JRefType -> JRefType -> Bool)
-> (JRefType -> JRefType -> JRefType)
-> (JRefType -> JRefType -> JRefType)
-> Ord JRefType
JRefType -> JRefType -> Bool
JRefType -> JRefType -> Ordering
JRefType -> JRefType -> JRefType
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 :: JRefType -> JRefType -> JRefType
$cmin :: JRefType -> JRefType -> JRefType
max :: JRefType -> JRefType -> JRefType
$cmax :: JRefType -> JRefType -> JRefType
>= :: JRefType -> JRefType -> Bool
$c>= :: JRefType -> JRefType -> Bool
> :: JRefType -> JRefType -> Bool
$c> :: JRefType -> JRefType -> Bool
<= :: JRefType -> JRefType -> Bool
$c<= :: JRefType -> JRefType -> Bool
< :: JRefType -> JRefType -> Bool
$c< :: JRefType -> JRefType -> Bool
compare :: JRefType -> JRefType -> Ordering
$ccompare :: JRefType -> JRefType -> Ordering
$cp1Ord :: Eq JRefType
Ord, (forall x. JRefType -> Rep JRefType x)
-> (forall x. Rep JRefType x -> JRefType) -> Generic JRefType
forall x. Rep JRefType x -> JRefType
forall x. JRefType -> Rep JRefType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JRefType x -> JRefType
$cfrom :: forall x. JRefType -> Rep JRefType x
Generic, JRefType -> ()
(JRefType -> ()) -> NFData JRefType
forall a. (a -> ()) -> NFData a
rnf :: JRefType -> ()
$crnf :: JRefType -> ()
NFData)

-- | The number of nested arrays
refTypeDepth :: JRefType -> Int
refTypeDepth :: JRefType -> Int
refTypeDepth = \case
  JTArray (JTRef JRefType
a) -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ JRefType -> Int
refTypeDepth JRefType
a
  JTArray JType
_         -> Int
1
  JTClass ClassName
_         -> Int
0

-- | Parses a 'JRefType'
parseJRefType :: Parser JRefType
parseJRefType :: Parser JRefType
parseJRefType =
  [Parser JRefType] -> Parser JRefType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ JType -> JRefType
JTArray (JType -> JRefType) -> Parser Text JType -> Parser JRefType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'[' Parser Char -> Parser Text JType -> Parser Text JType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text JType
parseJType)
      , ClassName -> JRefType
JTClass (ClassName -> JRefType) -> Parser ClassName -> Parser JRefType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'L' Parser Char -> Parser ClassName -> Parser ClassName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ClassName
parseClassName Parser ClassName -> Parser Char -> Parser ClassName
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
';')
      ]
    Parser JRefType -> String -> Parser JRefType
forall i a. Parser i a -> String -> Parser i a
<?> String
"JRefType"

serializeJRefType :: JRefType -> Builder
serializeJRefType :: JRefType -> Builder
serializeJRefType = \case
  JTArray JType
a -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> JType -> Builder
serializeJType JType
a
  JTClass ClassName
a -> Builder
"L" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ClassName -> Builder
serializeClassName ClassName
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
";"

instance TextSerializable JRefType where
  parseText :: Parser JRefType
parseText = Parser JRefType
parseJRefType
  toBuilder :: JRefType -> Builder
toBuilder = JRefType -> Builder
serializeJRefType

-- | Parses a 'JRefType' but does not require an 'L' infront of
-- the class name, and ';'
-- >>> deserialize parseFlatJRefType "java/lang/Object"
-- Right "Ljava/lang/Object;"
-- >>> deserialize parseFlatJRefType "[I"
-- Right "[I"
parseFlatJRefType :: Parser JRefType
parseFlatJRefType :: Parser JRefType
parseFlatJRefType =
  [Parser JRefType] -> Parser JRefType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [JType -> JRefType
JTArray (JType -> JRefType) -> Parser Text JType -> Parser JRefType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'[' Parser Char -> Parser Text JType -> Parser Text JType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text JType
parseJType), ClassName -> JRefType
JTClass (ClassName -> JRefType) -> Parser ClassName -> Parser JRefType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClassName
parseClassName]
    Parser JRefType -> String -> Parser JRefType
forall i a. Parser i a -> String -> Parser i a
<?> String
"flat JRefType"

serializeFlatJRefType :: JRefType -> Builder
serializeFlatJRefType :: JRefType -> Builder
serializeFlatJRefType = \case
  JTArray JType
a -> Builder
"[" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> JType -> Builder
serializeJType JType
a
  JTClass ClassName
a -> ClassName -> Builder
serializeClassName ClassName
a

-- | The Jvm Primitive Types
data JBaseType
  = JTByte
  | JTChar
  | JTDouble
  | JTFloat
  | JTInt
  | JTLong
  | JTShort
  | JTBoolean
  deriving (JBaseType -> JBaseType -> Bool
(JBaseType -> JBaseType -> Bool)
-> (JBaseType -> JBaseType -> Bool) -> Eq JBaseType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JBaseType -> JBaseType -> Bool
$c/= :: JBaseType -> JBaseType -> Bool
== :: JBaseType -> JBaseType -> Bool
$c== :: JBaseType -> JBaseType -> Bool
Eq, Eq JBaseType
Eq JBaseType
-> (JBaseType -> JBaseType -> Ordering)
-> (JBaseType -> JBaseType -> Bool)
-> (JBaseType -> JBaseType -> Bool)
-> (JBaseType -> JBaseType -> Bool)
-> (JBaseType -> JBaseType -> Bool)
-> (JBaseType -> JBaseType -> JBaseType)
-> (JBaseType -> JBaseType -> JBaseType)
-> Ord JBaseType
JBaseType -> JBaseType -> Bool
JBaseType -> JBaseType -> Ordering
JBaseType -> JBaseType -> JBaseType
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 :: JBaseType -> JBaseType -> JBaseType
$cmin :: JBaseType -> JBaseType -> JBaseType
max :: JBaseType -> JBaseType -> JBaseType
$cmax :: JBaseType -> JBaseType -> JBaseType
>= :: JBaseType -> JBaseType -> Bool
$c>= :: JBaseType -> JBaseType -> Bool
> :: JBaseType -> JBaseType -> Bool
$c> :: JBaseType -> JBaseType -> Bool
<= :: JBaseType -> JBaseType -> Bool
$c<= :: JBaseType -> JBaseType -> Bool
< :: JBaseType -> JBaseType -> Bool
$c< :: JBaseType -> JBaseType -> Bool
compare :: JBaseType -> JBaseType -> Ordering
$ccompare :: JBaseType -> JBaseType -> Ordering
$cp1Ord :: Eq JBaseType
Ord, (forall x. JBaseType -> Rep JBaseType x)
-> (forall x. Rep JBaseType x -> JBaseType) -> Generic JBaseType
forall x. Rep JBaseType x -> JBaseType
forall x. JBaseType -> Rep JBaseType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JBaseType x -> JBaseType
$cfrom :: forall x. JBaseType -> Rep JBaseType x
Generic, JBaseType -> ()
(JBaseType -> ()) -> NFData JBaseType
forall a. (a -> ()) -> NFData a
rnf :: JBaseType -> ()
$crnf :: JBaseType -> ()
NFData)

-- | Get the corresponding `Char` of a `JBaseType`
jBaseTypeToChar :: JBaseType -> Char
jBaseTypeToChar :: JBaseType -> Char
jBaseTypeToChar = \case
  JBaseType
JTByte    -> Char
'B'
  JBaseType
JTChar    -> Char
'C'
  JBaseType
JTDouble  -> Char
'D'
  JBaseType
JTFloat   -> Char
'F'
  JBaseType
JTInt     -> Char
'I'
  JBaseType
JTLong    -> Char
'J'
  JBaseType
JTShort   -> Char
'S'
  JBaseType
JTBoolean -> Char
'Z'

-- | Doubles and Longs have size two in the stack.
jBaseTypeSize :: JBaseType -> Int
jBaseTypeSize :: JBaseType -> Int
jBaseTypeSize = \case
  JBaseType
JTDouble -> Int
2
  JBaseType
JTLong   -> Int
2
  JBaseType
_        -> Int
1

-- | Parse a JBaseType
parseJBaseType :: Parser JBaseType
parseJBaseType :: Parser JBaseType
parseJBaseType = Parser JBaseType -> Parser JBaseType
forall i a. Parser i a -> Parser i a
try (Parser JBaseType -> Parser JBaseType)
-> (Parser JBaseType -> Parser JBaseType)
-> Parser JBaseType
-> Parser JBaseType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parser JBaseType -> String -> Parser JBaseType
forall i a. Parser i a -> String -> Parser i a
<?> String
"JBaseType") (Parser JBaseType -> Parser JBaseType)
-> Parser JBaseType -> Parser JBaseType
forall a b. (a -> b) -> a -> b
$ Parser Char
anyChar Parser Char -> (Char -> Parser JBaseType) -> Parser JBaseType
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Char
'B' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTByte
  Char
'C' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTChar
  Char
'D' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTDouble
  Char
'F' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTFloat
  Char
'I' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTInt
  Char
'J' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTLong
  Char
'S' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTShort
  Char
'Z' -> JBaseType -> Parser JBaseType
forall (m :: * -> *) a. Monad m => a -> m a
return JBaseType
JTBoolean
  Char
s   -> String -> Parser JBaseType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser JBaseType) -> String -> Parser JBaseType
forall a b. (a -> b) -> a -> b
$ String
"Unknown char " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
s

-- | Serializes JBaseType
serializeJBaseType :: JBaseType -> Builder
serializeJBaseType :: JBaseType -> Builder
serializeJBaseType = Char -> Builder
Builder.singleton (Char -> Builder) -> (JBaseType -> Char) -> JBaseType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JBaseType -> Char
jBaseTypeToChar

instance TextSerializable JBaseType where
  parseText :: Parser JBaseType
parseText = Parser JBaseType
parseJBaseType
  toBuilder :: JBaseType -> Builder
toBuilder = JBaseType -> Builder
serializeJBaseType


-- | A 'JType' is either a simple type or a Reftype
data JType
  = JTBase !JBaseType
  | JTRef !JRefType
  deriving (JType -> JType -> Bool
(JType -> JType -> Bool) -> (JType -> JType -> Bool) -> Eq JType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JType -> JType -> Bool
$c/= :: JType -> JType -> Bool
== :: JType -> JType -> Bool
$c== :: JType -> JType -> Bool
Eq, Eq JType
Eq JType
-> (JType -> JType -> Ordering)
-> (JType -> JType -> Bool)
-> (JType -> JType -> Bool)
-> (JType -> JType -> Bool)
-> (JType -> JType -> Bool)
-> (JType -> JType -> JType)
-> (JType -> JType -> JType)
-> Ord JType
JType -> JType -> Bool
JType -> JType -> Ordering
JType -> JType -> JType
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 :: JType -> JType -> JType
$cmin :: JType -> JType -> JType
max :: JType -> JType -> JType
$cmax :: JType -> JType -> JType
>= :: JType -> JType -> Bool
$c>= :: JType -> JType -> Bool
> :: JType -> JType -> Bool
$c> :: JType -> JType -> Bool
<= :: JType -> JType -> Bool
$c<= :: JType -> JType -> Bool
< :: JType -> JType -> Bool
$c< :: JType -> JType -> Bool
compare :: JType -> JType -> Ordering
$ccompare :: JType -> JType -> Ordering
$cp1Ord :: Eq JType
Ord, (forall x. JType -> Rep JType x)
-> (forall x. Rep JType x -> JType) -> Generic JType
forall x. Rep JType x -> JType
forall x. JType -> Rep JType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JType x -> JType
$cfrom :: forall x. JType -> Rep JType x
Generic, JType -> ()
(JType -> ()) -> NFData JType
forall a. (a -> ()) -> NFData a
rnf :: JType -> ()
$crnf :: JType -> ()
NFData)

-- | Parse a JType
parseJType :: Parser JType
parseJType :: Parser Text JType
parseJType =
  [Parser Text JType] -> Parser Text JType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [JRefType -> JType
JTRef (JRefType -> JType) -> Parser JRefType -> Parser Text JType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JRefType
parseJRefType, JBaseType -> JType
JTBase (JBaseType -> JType) -> Parser JBaseType -> Parser Text JType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JBaseType
parseJBaseType] Parser Text JType -> String -> Parser Text JType
forall i a. Parser i a -> String -> Parser i a
<?> String
"JType"

-- | Serialize 'JType'
serializeJType :: JType -> Builder
serializeJType :: JType -> Builder
serializeJType = \case
  JTRef  JRefType
r -> JRefType -> Builder
serializeJRefType JRefType
r
  JTBase JBaseType
r -> JBaseType -> Builder
serializeJBaseType JBaseType
r

instance TextSerializable JType where
  parseText :: Parser Text JType
parseText = Parser Text JType
parseJType
  toBuilder :: JType -> Builder
toBuilder = JType -> Builder
serializeJType

-- | jTypes also have different sizes.
jTypeSize :: JType -> Int
jTypeSize :: JType -> Int
jTypeSize = \case
  JTBase JBaseType
a -> JBaseType -> Int
jBaseTypeSize JBaseType
a
  JTRef  JRefType
_ -> Int
1

-- | A ReturnDescriptor is maybe a type, otherwise it is void.
-- https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.3.3
newtype ReturnDescriptor =
  ReturnDescriptor { ReturnDescriptor -> Maybe JType
asMaybeJType :: Maybe JType }
  deriving (Eq ReturnDescriptor
Eq ReturnDescriptor
-> (ReturnDescriptor -> ReturnDescriptor -> Ordering)
-> (ReturnDescriptor -> ReturnDescriptor -> Bool)
-> (ReturnDescriptor -> ReturnDescriptor -> Bool)
-> (ReturnDescriptor -> ReturnDescriptor -> Bool)
-> (ReturnDescriptor -> ReturnDescriptor -> Bool)
-> (ReturnDescriptor -> ReturnDescriptor -> ReturnDescriptor)
-> (ReturnDescriptor -> ReturnDescriptor -> ReturnDescriptor)
-> Ord ReturnDescriptor
ReturnDescriptor -> ReturnDescriptor -> Bool
ReturnDescriptor -> ReturnDescriptor -> Ordering
ReturnDescriptor -> ReturnDescriptor -> ReturnDescriptor
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 :: ReturnDescriptor -> ReturnDescriptor -> ReturnDescriptor
$cmin :: ReturnDescriptor -> ReturnDescriptor -> ReturnDescriptor
max :: ReturnDescriptor -> ReturnDescriptor -> ReturnDescriptor
$cmax :: ReturnDescriptor -> ReturnDescriptor -> ReturnDescriptor
>= :: ReturnDescriptor -> ReturnDescriptor -> Bool
$c>= :: ReturnDescriptor -> ReturnDescriptor -> Bool
> :: ReturnDescriptor -> ReturnDescriptor -> Bool
$c> :: ReturnDescriptor -> ReturnDescriptor -> Bool
<= :: ReturnDescriptor -> ReturnDescriptor -> Bool
$c<= :: ReturnDescriptor -> ReturnDescriptor -> Bool
< :: ReturnDescriptor -> ReturnDescriptor -> Bool
$c< :: ReturnDescriptor -> ReturnDescriptor -> Bool
compare :: ReturnDescriptor -> ReturnDescriptor -> Ordering
$ccompare :: ReturnDescriptor -> ReturnDescriptor -> Ordering
$cp1Ord :: Eq ReturnDescriptor
Ord, ReturnDescriptor -> ReturnDescriptor -> Bool
(ReturnDescriptor -> ReturnDescriptor -> Bool)
-> (ReturnDescriptor -> ReturnDescriptor -> Bool)
-> Eq ReturnDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnDescriptor -> ReturnDescriptor -> Bool
$c/= :: ReturnDescriptor -> ReturnDescriptor -> Bool
== :: ReturnDescriptor -> ReturnDescriptor -> Bool
$c== :: ReturnDescriptor -> ReturnDescriptor -> Bool
Eq, (forall x. ReturnDescriptor -> Rep ReturnDescriptor x)
-> (forall x. Rep ReturnDescriptor x -> ReturnDescriptor)
-> Generic ReturnDescriptor
forall x. Rep ReturnDescriptor x -> ReturnDescriptor
forall x. ReturnDescriptor -> Rep ReturnDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReturnDescriptor x -> ReturnDescriptor
$cfrom :: forall x. ReturnDescriptor -> Rep ReturnDescriptor x
Generic, ReturnDescriptor -> ()
(ReturnDescriptor -> ()) -> NFData ReturnDescriptor
forall a. (a -> ()) -> NFData a
rnf :: ReturnDescriptor -> ()
$crnf :: ReturnDescriptor -> ()
NFData)

-- | A ReturnDescriptor is either A JType or A 'void' V annotaiton:
--
-- >>> deserialize parseReturnDescriptor "V"
-- Right Nothing
--
-- >>> parseTest parseReturnDescriptor "[I"
-- Right (Just "[I")
parseReturnDescriptor :: Parser ReturnDescriptor
parseReturnDescriptor :: Parser ReturnDescriptor
parseReturnDescriptor =
  Maybe JType -> ReturnDescriptor
ReturnDescriptor
    (Maybe JType -> ReturnDescriptor)
-> Parser Text (Maybe JType) -> Parser ReturnDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Parser Text (Maybe JType)] -> Parser Text (Maybe JType)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Char -> Parser Char
char Char
'V' Parser Char
-> Parser Text (Maybe JType) -> Parser Text (Maybe JType)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe JType -> Parser Text (Maybe JType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe JType
forall a. Maybe a
Nothing, JType -> Maybe JType
forall a. a -> Maybe a
Just (JType -> Maybe JType)
-> Parser Text JType -> Parser Text (Maybe JType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text JType
parseJType]
    Parser ReturnDescriptor -> String -> Parser ReturnDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"return type"

serializeReturnDescriptor :: ReturnDescriptor -> Builder
serializeReturnDescriptor :: ReturnDescriptor -> Builder
serializeReturnDescriptor =
  Builder -> (JType -> Builder) -> Maybe JType -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Builder
Builder.singleton Char
'V') JType -> Builder
serializeJType (Maybe JType -> Builder)
-> (ReturnDescriptor -> Maybe JType) -> ReturnDescriptor -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReturnDescriptor -> Maybe JType
asMaybeJType

instance TextSerializable ReturnDescriptor where
  toBuilder :: ReturnDescriptor -> Builder
toBuilder = ReturnDescriptor -> Builder
serializeReturnDescriptor
  parseText :: Parser ReturnDescriptor
parseText = Parser ReturnDescriptor
parseReturnDescriptor

-- | Method Descriptor
data MethodDescriptor = MethodDescriptor
  { MethodDescriptor -> [JType]
methodDescriptorArguments  :: ! [JType]
  , MethodDescriptor -> ReturnDescriptor
methodDescriptorReturnType :: ! ReturnDescriptor
  } deriving (Eq MethodDescriptor
Eq MethodDescriptor
-> (MethodDescriptor -> MethodDescriptor -> Ordering)
-> (MethodDescriptor -> MethodDescriptor -> Bool)
-> (MethodDescriptor -> MethodDescriptor -> Bool)
-> (MethodDescriptor -> MethodDescriptor -> Bool)
-> (MethodDescriptor -> MethodDescriptor -> Bool)
-> (MethodDescriptor -> MethodDescriptor -> MethodDescriptor)
-> (MethodDescriptor -> MethodDescriptor -> MethodDescriptor)
-> Ord MethodDescriptor
MethodDescriptor -> MethodDescriptor -> Bool
MethodDescriptor -> MethodDescriptor -> Ordering
MethodDescriptor -> MethodDescriptor -> MethodDescriptor
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 :: MethodDescriptor -> MethodDescriptor -> MethodDescriptor
$cmin :: MethodDescriptor -> MethodDescriptor -> MethodDescriptor
max :: MethodDescriptor -> MethodDescriptor -> MethodDescriptor
$cmax :: MethodDescriptor -> MethodDescriptor -> MethodDescriptor
>= :: MethodDescriptor -> MethodDescriptor -> Bool
$c>= :: MethodDescriptor -> MethodDescriptor -> Bool
> :: MethodDescriptor -> MethodDescriptor -> Bool
$c> :: MethodDescriptor -> MethodDescriptor -> Bool
<= :: MethodDescriptor -> MethodDescriptor -> Bool
$c<= :: MethodDescriptor -> MethodDescriptor -> Bool
< :: MethodDescriptor -> MethodDescriptor -> Bool
$c< :: MethodDescriptor -> MethodDescriptor -> Bool
compare :: MethodDescriptor -> MethodDescriptor -> Ordering
$ccompare :: MethodDescriptor -> MethodDescriptor -> Ordering
$cp1Ord :: Eq MethodDescriptor
Ord, MethodDescriptor -> MethodDescriptor -> Bool
(MethodDescriptor -> MethodDescriptor -> Bool)
-> (MethodDescriptor -> MethodDescriptor -> Bool)
-> Eq MethodDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodDescriptor -> MethodDescriptor -> Bool
$c/= :: MethodDescriptor -> MethodDescriptor -> Bool
== :: MethodDescriptor -> MethodDescriptor -> Bool
$c== :: MethodDescriptor -> MethodDescriptor -> Bool
Eq, (forall x. MethodDescriptor -> Rep MethodDescriptor x)
-> (forall x. Rep MethodDescriptor x -> MethodDescriptor)
-> Generic MethodDescriptor
forall x. Rep MethodDescriptor x -> MethodDescriptor
forall x. MethodDescriptor -> Rep MethodDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MethodDescriptor x -> MethodDescriptor
$cfrom :: forall x. MethodDescriptor -> Rep MethodDescriptor x
Generic, MethodDescriptor -> ()
(MethodDescriptor -> ()) -> NFData MethodDescriptor
forall a. (a -> ()) -> NFData a
rnf :: MethodDescriptor -> ()
$crnf :: MethodDescriptor -> ()
NFData)

-- | A 'MethodDescriptor' is just a list of types
--
-- >>> deserialize parseMethodDescriptor "(II)V"
-- Right "(II)V"
parseMethodDescriptor :: Parser MethodDescriptor
parseMethodDescriptor :: Parser MethodDescriptor
parseMethodDescriptor = (Parser MethodDescriptor -> String -> Parser MethodDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"MethodDescriptor") (Parser MethodDescriptor -> Parser MethodDescriptor)
-> Parser MethodDescriptor -> Parser MethodDescriptor
forall a b. (a -> b) -> a -> b
$ do
  [JType]
args <- Char -> Parser Char
char Char
'(' Parser Char -> Parser Text [JType] -> Parser Text [JType]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Text JType -> Parser Text [JType]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text JType
parseJType Parser Text [JType] -> String -> Parser Text [JType]
forall i a. Parser i a -> String -> Parser i a
<?> String
"method arguments") Parser Text [JType] -> Parser Char -> Parser Text [JType]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
')'
  [JType] -> ReturnDescriptor -> MethodDescriptor
MethodDescriptor [JType]
args (ReturnDescriptor -> MethodDescriptor)
-> Parser ReturnDescriptor -> Parser MethodDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ReturnDescriptor
parseReturnDescriptor

serializeMethodDescriptor :: MethodDescriptor -> Builder
serializeMethodDescriptor :: MethodDescriptor -> Builder
serializeMethodDescriptor (MethodDescriptor [JType]
args ReturnDescriptor
rt) =
  Char -> Builder
singleton Char
'('
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (JType -> Builder) -> [JType] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap JType -> Builder
serializeJType [JType]
args
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
')'
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ReturnDescriptor -> Builder
serializeReturnDescriptor ReturnDescriptor
rt

instance TextSerializable MethodDescriptor where
  toBuilder :: MethodDescriptor -> Builder
toBuilder = MethodDescriptor -> Builder
serializeMethodDescriptor
  parseText :: Parser MethodDescriptor
parseText = Parser MethodDescriptor
parseMethodDescriptor

-- | Field Descriptor
newtype FieldDescriptor = FieldDescriptor
  { FieldDescriptor -> JType
fieldDescriptorType :: JType
  } deriving (Eq FieldDescriptor
Eq FieldDescriptor
-> (FieldDescriptor -> FieldDescriptor -> Ordering)
-> (FieldDescriptor -> FieldDescriptor -> Bool)
-> (FieldDescriptor -> FieldDescriptor -> Bool)
-> (FieldDescriptor -> FieldDescriptor -> Bool)
-> (FieldDescriptor -> FieldDescriptor -> Bool)
-> (FieldDescriptor -> FieldDescriptor -> FieldDescriptor)
-> (FieldDescriptor -> FieldDescriptor -> FieldDescriptor)
-> Ord FieldDescriptor
FieldDescriptor -> FieldDescriptor -> Bool
FieldDescriptor -> FieldDescriptor -> Ordering
FieldDescriptor -> FieldDescriptor -> FieldDescriptor
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 :: FieldDescriptor -> FieldDescriptor -> FieldDescriptor
$cmin :: FieldDescriptor -> FieldDescriptor -> FieldDescriptor
max :: FieldDescriptor -> FieldDescriptor -> FieldDescriptor
$cmax :: FieldDescriptor -> FieldDescriptor -> FieldDescriptor
>= :: FieldDescriptor -> FieldDescriptor -> Bool
$c>= :: FieldDescriptor -> FieldDescriptor -> Bool
> :: FieldDescriptor -> FieldDescriptor -> Bool
$c> :: FieldDescriptor -> FieldDescriptor -> Bool
<= :: FieldDescriptor -> FieldDescriptor -> Bool
$c<= :: FieldDescriptor -> FieldDescriptor -> Bool
< :: FieldDescriptor -> FieldDescriptor -> Bool
$c< :: FieldDescriptor -> FieldDescriptor -> Bool
compare :: FieldDescriptor -> FieldDescriptor -> Ordering
$ccompare :: FieldDescriptor -> FieldDescriptor -> Ordering
$cp1Ord :: Eq FieldDescriptor
Ord, FieldDescriptor -> FieldDescriptor -> Bool
(FieldDescriptor -> FieldDescriptor -> Bool)
-> (FieldDescriptor -> FieldDescriptor -> Bool)
-> Eq FieldDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldDescriptor -> FieldDescriptor -> Bool
$c/= :: FieldDescriptor -> FieldDescriptor -> Bool
== :: FieldDescriptor -> FieldDescriptor -> Bool
$c== :: FieldDescriptor -> FieldDescriptor -> Bool
Eq, (forall x. FieldDescriptor -> Rep FieldDescriptor x)
-> (forall x. Rep FieldDescriptor x -> FieldDescriptor)
-> Generic FieldDescriptor
forall x. Rep FieldDescriptor x -> FieldDescriptor
forall x. FieldDescriptor -> Rep FieldDescriptor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldDescriptor x -> FieldDescriptor
$cfrom :: forall x. FieldDescriptor -> Rep FieldDescriptor x
Generic, FieldDescriptor -> ()
(FieldDescriptor -> ()) -> NFData FieldDescriptor
forall a. (a -> ()) -> NFData a
rnf :: FieldDescriptor -> ()
$crnf :: FieldDescriptor -> ()
NFData)

-- | A 'FieldDescriptor' is just a JType
--
-- >>> deserialize parseMethodDescriptor "I"
-- Right "I"
parseFieldDescriptor :: Parser FieldDescriptor
parseFieldDescriptor :: Parser FieldDescriptor
parseFieldDescriptor = (Parser FieldDescriptor -> String -> Parser FieldDescriptor
forall i a. Parser i a -> String -> Parser i a
<?> String
"FieldDescriptor") (Parser FieldDescriptor -> Parser FieldDescriptor)
-> Parser FieldDescriptor -> Parser FieldDescriptor
forall a b. (a -> b) -> a -> b
$ do
  JType -> FieldDescriptor
FieldDescriptor (JType -> FieldDescriptor)
-> Parser Text JType -> Parser FieldDescriptor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text JType
parseJType

serializeFieldDescriptor :: FieldDescriptor -> Builder
serializeFieldDescriptor :: FieldDescriptor -> Builder
serializeFieldDescriptor = JType -> Builder
serializeJType (JType -> Builder)
-> (FieldDescriptor -> JType) -> FieldDescriptor -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescriptor -> JType
fieldDescriptorType

instance TextSerializable FieldDescriptor where
  parseText :: Parser FieldDescriptor
parseText = Parser FieldDescriptor
parseFieldDescriptor
  toBuilder :: FieldDescriptor -> Builder
toBuilder = FieldDescriptor -> Builder
serializeFieldDescriptor

-- | A name and a type
data NameAndType a = NameAndType !Text.Text !a
  deriving (Int -> NameAndType a -> String -> String
[NameAndType a] -> String -> String
NameAndType a -> String
(Int -> NameAndType a -> String -> String)
-> (NameAndType a -> String)
-> ([NameAndType a] -> String -> String)
-> Show (NameAndType a)
forall a. Show a => Int -> NameAndType a -> String -> String
forall a. Show a => [NameAndType a] -> String -> String
forall a. Show a => NameAndType a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NameAndType a] -> String -> String
$cshowList :: forall a. Show a => [NameAndType a] -> String -> String
show :: NameAndType a -> String
$cshow :: forall a. Show a => NameAndType a -> String
showsPrec :: Int -> NameAndType a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> NameAndType a -> String -> String
Show, NameAndType a -> NameAndType a -> Bool
(NameAndType a -> NameAndType a -> Bool)
-> (NameAndType a -> NameAndType a -> Bool) -> Eq (NameAndType a)
forall a. Eq a => NameAndType a -> NameAndType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameAndType a -> NameAndType a -> Bool
$c/= :: forall a. Eq a => NameAndType a -> NameAndType a -> Bool
== :: NameAndType a -> NameAndType a -> Bool
$c== :: forall a. Eq a => NameAndType a -> NameAndType a -> Bool
Eq, Eq (NameAndType a)
Eq (NameAndType a)
-> (NameAndType a -> NameAndType a -> Ordering)
-> (NameAndType a -> NameAndType a -> Bool)
-> (NameAndType a -> NameAndType a -> Bool)
-> (NameAndType a -> NameAndType a -> Bool)
-> (NameAndType a -> NameAndType a -> Bool)
-> (NameAndType a -> NameAndType a -> NameAndType a)
-> (NameAndType a -> NameAndType a -> NameAndType a)
-> Ord (NameAndType a)
NameAndType a -> NameAndType a -> Bool
NameAndType a -> NameAndType a -> Ordering
NameAndType a -> NameAndType a -> NameAndType a
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
forall a. Ord a => Eq (NameAndType a)
forall a. Ord a => NameAndType a -> NameAndType a -> Bool
forall a. Ord a => NameAndType a -> NameAndType a -> Ordering
forall a. Ord a => NameAndType a -> NameAndType a -> NameAndType a
min :: NameAndType a -> NameAndType a -> NameAndType a
$cmin :: forall a. Ord a => NameAndType a -> NameAndType a -> NameAndType a
max :: NameAndType a -> NameAndType a -> NameAndType a
$cmax :: forall a. Ord a => NameAndType a -> NameAndType a -> NameAndType a
>= :: NameAndType a -> NameAndType a -> Bool
$c>= :: forall a. Ord a => NameAndType a -> NameAndType a -> Bool
> :: NameAndType a -> NameAndType a -> Bool
$c> :: forall a. Ord a => NameAndType a -> NameAndType a -> Bool
<= :: NameAndType a -> NameAndType a -> Bool
$c<= :: forall a. Ord a => NameAndType a -> NameAndType a -> Bool
< :: NameAndType a -> NameAndType a -> Bool
$c< :: forall a. Ord a => NameAndType a -> NameAndType a -> Bool
compare :: NameAndType a -> NameAndType a -> Ordering
$ccompare :: forall a. Ord a => NameAndType a -> NameAndType a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (NameAndType a)
Ord, (forall x. NameAndType a -> Rep (NameAndType a) x)
-> (forall x. Rep (NameAndType a) x -> NameAndType a)
-> Generic (NameAndType a)
forall x. Rep (NameAndType a) x -> NameAndType a
forall x. NameAndType a -> Rep (NameAndType a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (NameAndType a) x -> NameAndType a
forall a x. NameAndType a -> Rep (NameAndType a) x
$cto :: forall a x. Rep (NameAndType a) x -> NameAndType a
$cfrom :: forall a x. NameAndType a -> Rep (NameAndType a) x
Generic, NameAndType a -> ()
(NameAndType a -> ()) -> NFData (NameAndType a)
forall a. NFData a => NameAndType a -> ()
forall a. (a -> ()) -> NFData a
rnf :: NameAndType a -> ()
$crnf :: forall a. NFData a => NameAndType a -> ()
NFData)

class WithName n where
  type WithNameId n
  (<:>) :: Text.Text -> n -> WithNameId n

class AsNameAndType n where
  type TypeDescriptor n

  toNameAndType :: n -> NameAndType (TypeDescriptor n)

  ntDescriptor :: n -> TypeDescriptor n
  ntDescriptor (n -> NameAndType (TypeDescriptor n)
forall n. AsNameAndType n => n -> NameAndType (TypeDescriptor n)
toNameAndType -> NameAndType Text
_ TypeDescriptor n
d) = TypeDescriptor n
d

  ntName :: n -> Text.Text
  ntName (n -> NameAndType (TypeDescriptor n)
forall n. AsNameAndType n => n -> NameAndType (TypeDescriptor n)
toNameAndType -> NameAndType Text
t TypeDescriptor n
_) = Text
t

instance AsNameAndType (NameAndType a) where
  type TypeDescriptor (NameAndType a) = a
  toNameAndType :: NameAndType a -> NameAndType (TypeDescriptor (NameAndType a))
toNameAndType = NameAndType a -> NameAndType (TypeDescriptor (NameAndType a))
forall a. a -> a
id


-- | A 'FieldDescriptor' is just a JType
--
-- >>> deserialize (parseNameAndType parseMethodDescriptor) "method:(I)V"
-- Right "method:(I)V"
parseNameAndType :: Parser a -> Parser (NameAndType a)
parseNameAndType :: Parser a -> Parser (NameAndType a)
parseNameAndType Parser a
parser = (Parser (NameAndType a) -> String -> Parser (NameAndType a)
forall i a. Parser i a -> String -> Parser i a
<?> String
"NameAndType") (Parser (NameAndType a) -> Parser (NameAndType a))
-> Parser (NameAndType a) -> Parser (NameAndType a)
forall a b. (a -> b) -> a -> b
$ do
  String
_name <- Parser Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 (Char -> Parser Char
notChar Char
':') Parser Text String -> Parser Char -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
':'
  Text -> a -> NameAndType a
forall a. Text -> a -> NameAndType a
NameAndType (String -> Text
Text.pack String
_name) (a -> NameAndType a) -> Parser a -> Parser (NameAndType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
parser

serializeNameAndType :: (a -> Builder) -> NameAndType a -> Builder
serializeNameAndType :: (a -> Builder) -> NameAndType a -> Builder
serializeNameAndType a -> Builder
serializer (NameAndType Text
_name a
descr) =
  Text -> Builder
fromText Text
_name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
serializer a
descr

-- | A FieldId
newtype FieldId =
  FieldId { FieldId -> NameAndType FieldDescriptor
fieldIdAsNameAndType :: NameAndType FieldDescriptor }
  deriving (Eq FieldId
Eq FieldId
-> (FieldId -> FieldId -> Ordering)
-> (FieldId -> FieldId -> Bool)
-> (FieldId -> FieldId -> Bool)
-> (FieldId -> FieldId -> Bool)
-> (FieldId -> FieldId -> Bool)
-> (FieldId -> FieldId -> FieldId)
-> (FieldId -> FieldId -> FieldId)
-> Ord FieldId
FieldId -> FieldId -> Bool
FieldId -> FieldId -> Ordering
FieldId -> FieldId -> FieldId
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 :: FieldId -> FieldId -> FieldId
$cmin :: FieldId -> FieldId -> FieldId
max :: FieldId -> FieldId -> FieldId
$cmax :: FieldId -> FieldId -> FieldId
>= :: FieldId -> FieldId -> Bool
$c>= :: FieldId -> FieldId -> Bool
> :: FieldId -> FieldId -> Bool
$c> :: FieldId -> FieldId -> Bool
<= :: FieldId -> FieldId -> Bool
$c<= :: FieldId -> FieldId -> Bool
< :: FieldId -> FieldId -> Bool
$c< :: FieldId -> FieldId -> Bool
compare :: FieldId -> FieldId -> Ordering
$ccompare :: FieldId -> FieldId -> Ordering
$cp1Ord :: Eq FieldId
Ord, FieldId -> FieldId -> Bool
(FieldId -> FieldId -> Bool)
-> (FieldId -> FieldId -> Bool) -> Eq FieldId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldId -> FieldId -> Bool
$c/= :: FieldId -> FieldId -> Bool
== :: FieldId -> FieldId -> Bool
$c== :: FieldId -> FieldId -> Bool
Eq, (forall x. FieldId -> Rep FieldId x)
-> (forall x. Rep FieldId x -> FieldId) -> Generic FieldId
forall x. Rep FieldId x -> FieldId
forall x. FieldId -> Rep FieldId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldId x -> FieldId
$cfrom :: forall x. FieldId -> Rep FieldId x
Generic, FieldId -> ()
(FieldId -> ()) -> NFData FieldId
forall a. (a -> ()) -> NFData a
rnf :: FieldId -> ()
$crnf :: FieldId -> ()
NFData)

parseFieldId :: Parser FieldId
parseFieldId :: Parser FieldId
parseFieldId = NameAndType FieldDescriptor -> FieldId
FieldId (NameAndType FieldDescriptor -> FieldId)
-> Parser Text (NameAndType FieldDescriptor) -> Parser FieldId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FieldDescriptor -> Parser Text (NameAndType FieldDescriptor)
forall a. Parser a -> Parser (NameAndType a)
parseNameAndType Parser FieldDescriptor
parseFieldDescriptor

serializeFieldId :: FieldId -> Builder
serializeFieldId :: FieldId -> Builder
serializeFieldId =
  (FieldDescriptor -> Builder)
-> NameAndType FieldDescriptor -> Builder
forall a. (a -> Builder) -> NameAndType a -> Builder
serializeNameAndType FieldDescriptor -> Builder
serializeFieldDescriptor (NameAndType FieldDescriptor -> Builder)
-> (FieldId -> NameAndType FieldDescriptor) -> FieldId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldId -> NameAndType FieldDescriptor
fieldIdAsNameAndType

instance TextSerializable FieldId where
  parseText :: Parser FieldId
parseText = Parser FieldId
parseFieldId
  toBuilder :: FieldId -> Builder
toBuilder = FieldId -> Builder
serializeFieldId

instance WithName FieldDescriptor where
  type WithNameId FieldDescriptor = FieldId
  Text
t <:> :: Text -> FieldDescriptor -> WithNameId FieldDescriptor
<:> FieldDescriptor
mt = NameAndType FieldDescriptor -> FieldId
FieldId (Text -> FieldDescriptor -> NameAndType FieldDescriptor
forall a. Text -> a -> NameAndType a
NameAndType Text
t FieldDescriptor
mt)

instance AsNameAndType FieldId where
  type TypeDescriptor FieldId = FieldDescriptor
  toNameAndType :: FieldId -> NameAndType (TypeDescriptor FieldId)
toNameAndType = FieldId -> NameAndType (TypeDescriptor FieldId)
FieldId -> NameAndType FieldDescriptor
fieldIdAsNameAndType


-- | A MethodId
newtype MethodId =
  MethodId { MethodId -> NameAndType MethodDescriptor
methodIdAsNameAndType :: NameAndType MethodDescriptor }
  deriving (Eq MethodId
Eq MethodId
-> (MethodId -> MethodId -> Ordering)
-> (MethodId -> MethodId -> Bool)
-> (MethodId -> MethodId -> Bool)
-> (MethodId -> MethodId -> Bool)
-> (MethodId -> MethodId -> Bool)
-> (MethodId -> MethodId -> MethodId)
-> (MethodId -> MethodId -> MethodId)
-> Ord MethodId
MethodId -> MethodId -> Bool
MethodId -> MethodId -> Ordering
MethodId -> MethodId -> MethodId
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 :: MethodId -> MethodId -> MethodId
$cmin :: MethodId -> MethodId -> MethodId
max :: MethodId -> MethodId -> MethodId
$cmax :: MethodId -> MethodId -> MethodId
>= :: MethodId -> MethodId -> Bool
$c>= :: MethodId -> MethodId -> Bool
> :: MethodId -> MethodId -> Bool
$c> :: MethodId -> MethodId -> Bool
<= :: MethodId -> MethodId -> Bool
$c<= :: MethodId -> MethodId -> Bool
< :: MethodId -> MethodId -> Bool
$c< :: MethodId -> MethodId -> Bool
compare :: MethodId -> MethodId -> Ordering
$ccompare :: MethodId -> MethodId -> Ordering
$cp1Ord :: Eq MethodId
Ord, MethodId -> MethodId -> Bool
(MethodId -> MethodId -> Bool)
-> (MethodId -> MethodId -> Bool) -> Eq MethodId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodId -> MethodId -> Bool
$c/= :: MethodId -> MethodId -> Bool
== :: MethodId -> MethodId -> Bool
$c== :: MethodId -> MethodId -> Bool
Eq, (forall x. MethodId -> Rep MethodId x)
-> (forall x. Rep MethodId x -> MethodId) -> Generic MethodId
forall x. Rep MethodId x -> MethodId
forall x. MethodId -> Rep MethodId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MethodId x -> MethodId
$cfrom :: forall x. MethodId -> Rep MethodId x
Generic, MethodId -> ()
(MethodId -> ()) -> NFData MethodId
forall a. (a -> ()) -> NFData a
rnf :: MethodId -> ()
$crnf :: MethodId -> ()
NFData)

parseMethodId :: Parser MethodId
parseMethodId :: Parser MethodId
parseMethodId = NameAndType MethodDescriptor -> MethodId
MethodId (NameAndType MethodDescriptor -> MethodId)
-> Parser Text (NameAndType MethodDescriptor) -> Parser MethodId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MethodDescriptor
-> Parser Text (NameAndType MethodDescriptor)
forall a. Parser a -> Parser (NameAndType a)
parseNameAndType Parser MethodDescriptor
parseMethodDescriptor

serializeMethodId :: MethodId -> Builder
serializeMethodId :: MethodId -> Builder
serializeMethodId =
  (MethodDescriptor -> Builder)
-> NameAndType MethodDescriptor -> Builder
forall a. (a -> Builder) -> NameAndType a -> Builder
serializeNameAndType MethodDescriptor -> Builder
serializeMethodDescriptor (NameAndType MethodDescriptor -> Builder)
-> (MethodId -> NameAndType MethodDescriptor)
-> MethodId
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodId -> NameAndType MethodDescriptor
methodIdAsNameAndType

instance TextSerializable MethodId where
  parseText :: Parser MethodId
parseText = Parser MethodId
parseMethodId
  toBuilder :: MethodId -> Builder
toBuilder = MethodId -> Builder
serializeMethodId

instance WithName MethodDescriptor where
  type WithNameId MethodDescriptor = MethodId
  Text
t <:> :: Text -> MethodDescriptor -> WithNameId MethodDescriptor
<:> MethodDescriptor
mt = NameAndType MethodDescriptor -> MethodId
MethodId (Text -> MethodDescriptor -> NameAndType MethodDescriptor
forall a. Text -> a -> NameAndType a
NameAndType Text
t MethodDescriptor
mt)

instance AsNameAndType MethodId where
  type TypeDescriptor MethodId = MethodDescriptor
  toNameAndType :: MethodId -> NameAndType (TypeDescriptor MethodId)
toNameAndType = MethodId -> NameAndType (TypeDescriptor MethodId)
MethodId -> NameAndType MethodDescriptor
methodIdAsNameAndType

-- | A method or Field in a Class
data InClass a = InClass
  { InClass a -> ClassName
inClassName :: !ClassName
  , InClass a -> a
inClassId :: !a
  } deriving (InClass a -> InClass a -> Bool
(InClass a -> InClass a -> Bool)
-> (InClass a -> InClass a -> Bool) -> Eq (InClass a)
forall a. Eq a => InClass a -> InClass a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InClass a -> InClass a -> Bool
$c/= :: forall a. Eq a => InClass a -> InClass a -> Bool
== :: InClass a -> InClass a -> Bool
$c== :: forall a. Eq a => InClass a -> InClass a -> Bool
Eq, Eq (InClass a)
Eq (InClass a)
-> (InClass a -> InClass a -> Ordering)
-> (InClass a -> InClass a -> Bool)
-> (InClass a -> InClass a -> Bool)
-> (InClass a -> InClass a -> Bool)
-> (InClass a -> InClass a -> Bool)
-> (InClass a -> InClass a -> InClass a)
-> (InClass a -> InClass a -> InClass a)
-> Ord (InClass a)
InClass a -> InClass a -> Bool
InClass a -> InClass a -> Ordering
InClass a -> InClass a -> InClass a
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
forall a. Ord a => Eq (InClass a)
forall a. Ord a => InClass a -> InClass a -> Bool
forall a. Ord a => InClass a -> InClass a -> Ordering
forall a. Ord a => InClass a -> InClass a -> InClass a
min :: InClass a -> InClass a -> InClass a
$cmin :: forall a. Ord a => InClass a -> InClass a -> InClass a
max :: InClass a -> InClass a -> InClass a
$cmax :: forall a. Ord a => InClass a -> InClass a -> InClass a
>= :: InClass a -> InClass a -> Bool
$c>= :: forall a. Ord a => InClass a -> InClass a -> Bool
> :: InClass a -> InClass a -> Bool
$c> :: forall a. Ord a => InClass a -> InClass a -> Bool
<= :: InClass a -> InClass a -> Bool
$c<= :: forall a. Ord a => InClass a -> InClass a -> Bool
< :: InClass a -> InClass a -> Bool
$c< :: forall a. Ord a => InClass a -> InClass a -> Bool
compare :: InClass a -> InClass a -> Ordering
$ccompare :: forall a. Ord a => InClass a -> InClass a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (InClass a)
Ord, (forall x. InClass a -> Rep (InClass a) x)
-> (forall x. Rep (InClass a) x -> InClass a)
-> Generic (InClass a)
forall x. Rep (InClass a) x -> InClass a
forall x. InClass a -> Rep (InClass a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (InClass a) x -> InClass a
forall a x. InClass a -> Rep (InClass a) x
$cto :: forall a x. Rep (InClass a) x -> InClass a
$cfrom :: forall a x. InClass a -> Rep (InClass a) x
Generic, InClass a -> ()
(InClass a -> ()) -> NFData (InClass a)
forall a. NFData a => InClass a -> ()
forall a. (a -> ()) -> NFData a
rnf :: InClass a -> ()
$crnf :: forall a. NFData a => InClass a -> ()
NFData)

parseInClass :: Parser a -> Parser (InClass a)
parseInClass :: Parser a -> Parser (InClass a)
parseInClass Parser a
parseClassId =
  ClassName -> a -> InClass a
forall a. ClassName -> a -> InClass a
InClass (ClassName -> a -> InClass a)
-> Parser ClassName -> Parser Text (a -> InClass a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClassName
parseClassName Parser Text (a -> InClass a) -> Parser a -> Parser (InClass a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
'.' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
parseClassId)

serializeInClass :: (a -> Builder) -> InClass a -> Builder
serializeInClass :: (a -> Builder) -> InClass a -> Builder
serializeInClass a -> Builder
serializeClassId (InClass ClassName
n a
cid) =
  ClassName -> Builder
serializeClassName ClassName
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
serializeClassId a
cid

-- | A method or Field in a Class
data InRefType a = InRefType
  { InRefType a -> JRefType
inRefType   :: !JRefType
  , InRefType a -> a
inRefTypeId :: !a
  } deriving (InRefType a -> InRefType a -> Bool
(InRefType a -> InRefType a -> Bool)
-> (InRefType a -> InRefType a -> Bool) -> Eq (InRefType a)
forall a. Eq a => InRefType a -> InRefType a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InRefType a -> InRefType a -> Bool
$c/= :: forall a. Eq a => InRefType a -> InRefType a -> Bool
== :: InRefType a -> InRefType a -> Bool
$c== :: forall a. Eq a => InRefType a -> InRefType a -> Bool
Eq, Eq (InRefType a)
Eq (InRefType a)
-> (InRefType a -> InRefType a -> Ordering)
-> (InRefType a -> InRefType a -> Bool)
-> (InRefType a -> InRefType a -> Bool)
-> (InRefType a -> InRefType a -> Bool)
-> (InRefType a -> InRefType a -> Bool)
-> (InRefType a -> InRefType a -> InRefType a)
-> (InRefType a -> InRefType a -> InRefType a)
-> Ord (InRefType a)
InRefType a -> InRefType a -> Bool
InRefType a -> InRefType a -> Ordering
InRefType a -> InRefType a -> InRefType a
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
forall a. Ord a => Eq (InRefType a)
forall a. Ord a => InRefType a -> InRefType a -> Bool
forall a. Ord a => InRefType a -> InRefType a -> Ordering
forall a. Ord a => InRefType a -> InRefType a -> InRefType a
min :: InRefType a -> InRefType a -> InRefType a
$cmin :: forall a. Ord a => InRefType a -> InRefType a -> InRefType a
max :: InRefType a -> InRefType a -> InRefType a
$cmax :: forall a. Ord a => InRefType a -> InRefType a -> InRefType a
>= :: InRefType a -> InRefType a -> Bool
$c>= :: forall a. Ord a => InRefType a -> InRefType a -> Bool
> :: InRefType a -> InRefType a -> Bool
$c> :: forall a. Ord a => InRefType a -> InRefType a -> Bool
<= :: InRefType a -> InRefType a -> Bool
$c<= :: forall a. Ord a => InRefType a -> InRefType a -> Bool
< :: InRefType a -> InRefType a -> Bool
$c< :: forall a. Ord a => InRefType a -> InRefType a -> Bool
compare :: InRefType a -> InRefType a -> Ordering
$ccompare :: forall a. Ord a => InRefType a -> InRefType a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (InRefType a)
Ord, (forall x. InRefType a -> Rep (InRefType a) x)
-> (forall x. Rep (InRefType a) x -> InRefType a)
-> Generic (InRefType a)
forall x. Rep (InRefType a) x -> InRefType a
forall x. InRefType a -> Rep (InRefType a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (InRefType a) x -> InRefType a
forall a x. InRefType a -> Rep (InRefType a) x
$cto :: forall a x. Rep (InRefType a) x -> InRefType a
$cfrom :: forall a x. InRefType a -> Rep (InRefType a) x
Generic, InRefType a -> ()
(InRefType a -> ()) -> NFData (InRefType a)
forall a. NFData a => InRefType a -> ()
forall a. (a -> ()) -> NFData a
rnf :: InRefType a -> ()
$crnf :: forall a. NFData a => InRefType a -> ()
NFData)

parseInRefType :: Parser a -> Parser (InRefType a)
parseInRefType :: Parser a -> Parser (InRefType a)
parseInRefType Parser a
parseRefTypeId =
  JRefType -> a -> InRefType a
forall a. JRefType -> a -> InRefType a
InRefType (JRefType -> a -> InRefType a)
-> Parser JRefType -> Parser Text (a -> InRefType a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JRefType
parseJRefType Parser Text (a -> InRefType a) -> Parser a -> Parser (InRefType a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Parser Char
char Char
'.' Parser Char -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
parseRefTypeId)

serializeInRefType :: (a -> Builder) -> InRefType a -> Builder
serializeInRefType :: (a -> Builder) -> InRefType a -> Builder
serializeInRefType a -> Builder
serializeRefTypeId (InRefType JRefType
n a
cid) =
  JRefType -> Builder
serializeJRefType JRefType
n Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
serializeRefTypeId a
cid

-- | Convert a InRefType to a InClass by casting
-- all arrays to classes.
inRefTypeAsInClass :: InRefType a -> InClass a
inRefTypeAsInClass :: InRefType a -> InClass a
inRefTypeAsInClass (InRefType JRefType
rt a
rtid) = ClassName -> a -> InClass a
forall a. ClassName -> a -> InClass a
InClass
  (case JRefType
rt of
    JTArray JType
_ -> ClassName
"java/lang/Object"
    JTClass ClassName
a -> ClassName
a
  )
  a
rtid

-- | A FieldId
newtype AbsFieldId =
  AbsFieldId { AbsFieldId -> InClass FieldId
absFieldAsInClass :: InClass FieldId }
  deriving (Eq AbsFieldId
Eq AbsFieldId
-> (AbsFieldId -> AbsFieldId -> Ordering)
-> (AbsFieldId -> AbsFieldId -> Bool)
-> (AbsFieldId -> AbsFieldId -> Bool)
-> (AbsFieldId -> AbsFieldId -> Bool)
-> (AbsFieldId -> AbsFieldId -> Bool)
-> (AbsFieldId -> AbsFieldId -> AbsFieldId)
-> (AbsFieldId -> AbsFieldId -> AbsFieldId)
-> Ord AbsFieldId
AbsFieldId -> AbsFieldId -> Bool
AbsFieldId -> AbsFieldId -> Ordering
AbsFieldId -> AbsFieldId -> AbsFieldId
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 :: AbsFieldId -> AbsFieldId -> AbsFieldId
$cmin :: AbsFieldId -> AbsFieldId -> AbsFieldId
max :: AbsFieldId -> AbsFieldId -> AbsFieldId
$cmax :: AbsFieldId -> AbsFieldId -> AbsFieldId
>= :: AbsFieldId -> AbsFieldId -> Bool
$c>= :: AbsFieldId -> AbsFieldId -> Bool
> :: AbsFieldId -> AbsFieldId -> Bool
$c> :: AbsFieldId -> AbsFieldId -> Bool
<= :: AbsFieldId -> AbsFieldId -> Bool
$c<= :: AbsFieldId -> AbsFieldId -> Bool
< :: AbsFieldId -> AbsFieldId -> Bool
$c< :: AbsFieldId -> AbsFieldId -> Bool
compare :: AbsFieldId -> AbsFieldId -> Ordering
$ccompare :: AbsFieldId -> AbsFieldId -> Ordering
$cp1Ord :: Eq AbsFieldId
Ord, AbsFieldId -> AbsFieldId -> Bool
(AbsFieldId -> AbsFieldId -> Bool)
-> (AbsFieldId -> AbsFieldId -> Bool) -> Eq AbsFieldId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsFieldId -> AbsFieldId -> Bool
$c/= :: AbsFieldId -> AbsFieldId -> Bool
== :: AbsFieldId -> AbsFieldId -> Bool
$c== :: AbsFieldId -> AbsFieldId -> Bool
Eq, (forall x. AbsFieldId -> Rep AbsFieldId x)
-> (forall x. Rep AbsFieldId x -> AbsFieldId) -> Generic AbsFieldId
forall x. Rep AbsFieldId x -> AbsFieldId
forall x. AbsFieldId -> Rep AbsFieldId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsFieldId x -> AbsFieldId
$cfrom :: forall x. AbsFieldId -> Rep AbsFieldId x
Generic, AbsFieldId -> ()
(AbsFieldId -> ()) -> NFData AbsFieldId
forall a. (a -> ()) -> NFData a
rnf :: AbsFieldId -> ()
$crnf :: AbsFieldId -> ()
NFData)

parseAbsFieldId :: Parser AbsFieldId
parseAbsFieldId :: Parser AbsFieldId
parseAbsFieldId = InClass FieldId -> AbsFieldId
AbsFieldId (InClass FieldId -> AbsFieldId)
-> Parser Text (InClass FieldId) -> Parser AbsFieldId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FieldId -> Parser Text (InClass FieldId)
forall a. Parser a -> Parser (InClass a)
parseInClass Parser FieldId
parseFieldId

serializeAbsFieldId :: AbsFieldId -> Builder
serializeAbsFieldId :: AbsFieldId -> Builder
serializeAbsFieldId = (FieldId -> Builder) -> InClass FieldId -> Builder
forall a. (a -> Builder) -> InClass a -> Builder
serializeInClass FieldId -> Builder
serializeFieldId (InClass FieldId -> Builder)
-> (AbsFieldId -> InClass FieldId) -> AbsFieldId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsFieldId -> InClass FieldId
absFieldAsInClass

instance TextSerializable AbsFieldId where
  parseText :: Parser AbsFieldId
parseText = Parser AbsFieldId
parseAbsFieldId
  toBuilder :: AbsFieldId -> Builder
toBuilder = AbsFieldId -> Builder
serializeAbsFieldId

-- | A MethodId
newtype AbsMethodId =
  AbsMethodId { AbsMethodId -> InClass MethodId
absMethodAsInClass :: InClass MethodId }
  deriving (Eq AbsMethodId
Eq AbsMethodId
-> (AbsMethodId -> AbsMethodId -> Ordering)
-> (AbsMethodId -> AbsMethodId -> Bool)
-> (AbsMethodId -> AbsMethodId -> Bool)
-> (AbsMethodId -> AbsMethodId -> Bool)
-> (AbsMethodId -> AbsMethodId -> Bool)
-> (AbsMethodId -> AbsMethodId -> AbsMethodId)
-> (AbsMethodId -> AbsMethodId -> AbsMethodId)
-> Ord AbsMethodId
AbsMethodId -> AbsMethodId -> Bool
AbsMethodId -> AbsMethodId -> Ordering
AbsMethodId -> AbsMethodId -> AbsMethodId
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 :: AbsMethodId -> AbsMethodId -> AbsMethodId
$cmin :: AbsMethodId -> AbsMethodId -> AbsMethodId
max :: AbsMethodId -> AbsMethodId -> AbsMethodId
$cmax :: AbsMethodId -> AbsMethodId -> AbsMethodId
>= :: AbsMethodId -> AbsMethodId -> Bool
$c>= :: AbsMethodId -> AbsMethodId -> Bool
> :: AbsMethodId -> AbsMethodId -> Bool
$c> :: AbsMethodId -> AbsMethodId -> Bool
<= :: AbsMethodId -> AbsMethodId -> Bool
$c<= :: AbsMethodId -> AbsMethodId -> Bool
< :: AbsMethodId -> AbsMethodId -> Bool
$c< :: AbsMethodId -> AbsMethodId -> Bool
compare :: AbsMethodId -> AbsMethodId -> Ordering
$ccompare :: AbsMethodId -> AbsMethodId -> Ordering
$cp1Ord :: Eq AbsMethodId
Ord, AbsMethodId -> AbsMethodId -> Bool
(AbsMethodId -> AbsMethodId -> Bool)
-> (AbsMethodId -> AbsMethodId -> Bool) -> Eq AbsMethodId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbsMethodId -> AbsMethodId -> Bool
$c/= :: AbsMethodId -> AbsMethodId -> Bool
== :: AbsMethodId -> AbsMethodId -> Bool
$c== :: AbsMethodId -> AbsMethodId -> Bool
Eq, (forall x. AbsMethodId -> Rep AbsMethodId x)
-> (forall x. Rep AbsMethodId x -> AbsMethodId)
-> Generic AbsMethodId
forall x. Rep AbsMethodId x -> AbsMethodId
forall x. AbsMethodId -> Rep AbsMethodId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AbsMethodId x -> AbsMethodId
$cfrom :: forall x. AbsMethodId -> Rep AbsMethodId x
Generic, AbsMethodId -> ()
(AbsMethodId -> ()) -> NFData AbsMethodId
forall a. (a -> ()) -> NFData a
rnf :: AbsMethodId -> ()
$crnf :: AbsMethodId -> ()
NFData)

parseAbsMethodId :: Parser AbsMethodId
parseAbsMethodId :: Parser AbsMethodId
parseAbsMethodId = InClass MethodId -> AbsMethodId
AbsMethodId (InClass MethodId -> AbsMethodId)
-> Parser Text (InClass MethodId) -> Parser AbsMethodId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser MethodId -> Parser Text (InClass MethodId)
forall a. Parser a -> Parser (InClass a)
parseInClass Parser MethodId
parseMethodId

serializeAbsMethodId :: AbsMethodId -> Builder
serializeAbsMethodId :: AbsMethodId -> Builder
serializeAbsMethodId = (MethodId -> Builder) -> InClass MethodId -> Builder
forall a. (a -> Builder) -> InClass a -> Builder
serializeInClass MethodId -> Builder
serializeMethodId (InClass MethodId -> Builder)
-> (AbsMethodId -> InClass MethodId) -> AbsMethodId -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsMethodId -> InClass MethodId
absMethodAsInClass

instance TextSerializable AbsMethodId where
  parseText :: Parser AbsMethodId
parseText = Parser AbsMethodId
parseAbsMethodId
  toBuilder :: AbsMethodId -> Builder
toBuilder = AbsMethodId -> Builder
serializeAbsMethodId

deriveFromTextSerializable ''ClassName
deriveFromTextSerializable ''JType
deriveFromTextSerializable ''JRefType
deriveFromTextSerializable ''JBaseType
deriveFromTextSerializable ''FieldDescriptor
deriveFromTextSerializable ''MethodDescriptor
deriveFromTextSerializable ''ReturnDescriptor

deriveFromTextSerializable ''MethodId
deriveFromTextSerializable ''FieldId

deriveFromTextSerializable ''AbsMethodId
deriveFromTextSerializable ''AbsFieldId

deriving instance Show a => Show (InClass a)
deriving instance Show a => Show (InRefType a)