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

Based on the Signature Attribute,
as documented [here](http://docs.oracle.com/javase/specs/jvms/se9/html/jvms-4.html#jvms-4.7.9),
and the signature syntax defined [here](https://docs.oracle.com/javase/specs/jvms/se9/html/jvms-4.html#jvms-4.7.9.1).
-}

module Language.JVM.Attribute.Signature
  ( Signature(..)
  , signatureToText
  , signatureFromText

  -- * Top Level Definitions
  , ClassSignature(..)
  , isSimpleClassSignature
  , classSignatureToText
  , classSignatureFromText
  , MethodSignature(..)
  , isSimpleMethodSignature
  , methodSignatureToText
  , methodSignatureFromText
  , FieldSignature(..)
  , isSimpleFieldSignature
  , fieldSignatureToText
  , fieldSignatureFromText

  -- ** Handlers


  -- * Lower Level Definitions
  , ClassType(..)
  , isSimpleClassType
  , classTypeToName
  , classTypeFromName
  , InnerClassType(..)
  , ReferenceType(..)
  , isSimpleReferenceType
  , referenceTypeFromRefType
  , ThrowsSignature(..)
  , isSimpleThrowsSignature
  , throwsSignatureFromName
  , TypeSignature(..)
  , isSimpleTypeSignature
  , typeSignatureFromType
  , TypeArgument(..)
  , TypeParameter(..)
  , TypeVariable(..)
  , Wildcard(..)

  -- * Parsers
  , classSignatureP
  , methodSignatureP
  , fieldSignatureP
  , classTypeP
  , classTypeT
  , referenceTypeP
  , referenceTypeT
  , throwsSignatureP
  , throwsSignatureT
  , typeArgumentsT
  , typeArgumentsP
  , typeArgumentP
  , typeArgumentT
  , typeParameterP
  , typeParameterT
  , typeParametersT
  , typeParametersP
  , typeSignatureP
  , typeSignatureT
  , typeVariableP
  )
where

import           Control.DeepSeq                ( NFData )
import qualified Data.Text                     as Text

import qualified Data.Text.Lazy                as LText
import           Data.Text.Lazy.Builder        as Text

import           Data.Functor
import           GHC.Generics                   ( Generic )

import           Data.Attoparsec.Text
import           Control.Applicative

import qualified Data.List                     as L

import           Language.JVM.Attribute.Base
import           Language.JVM.Staged
import           Language.JVM.Type

instance IsAttribute (Signature Low) where
  attrName :: Const Text (Signature Low)
attrName = Text -> Const Text (Signature Low)
forall k a (b :: k). a -> Const a b
Const Text
"Signature"

newtype Signature a =
  Signature (Ref Text.Text a)

signatureToText :: Signature High -> Text.Text
signatureToText :: Signature High -> Text
signatureToText (Signature Ref Text High
s) = Text
Ref Text High
s

signatureFromText :: Text.Text -> Signature High
signatureFromText :: Text -> Signature High
signatureFromText = Text -> Signature High
forall a. Ref Text a -> Signature a
Signature

data ClassSignature = ClassSignature
  { ClassSignature -> [TypeParameter]
csTypeParameters      :: [TypeParameter]
  , ClassSignature -> ClassType
csSuperclassSignature :: ClassType
  , ClassSignature -> [ClassType]
csInterfaceSignatures :: [ClassType]
  }
  deriving (Int -> ClassSignature -> ShowS
[ClassSignature] -> ShowS
ClassSignature -> String
(Int -> ClassSignature -> ShowS)
-> (ClassSignature -> String)
-> ([ClassSignature] -> ShowS)
-> Show ClassSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassSignature] -> ShowS
$cshowList :: [ClassSignature] -> ShowS
show :: ClassSignature -> String
$cshow :: ClassSignature -> String
showsPrec :: Int -> ClassSignature -> ShowS
$cshowsPrec :: Int -> ClassSignature -> ShowS
Show, ClassSignature -> ClassSignature -> Bool
(ClassSignature -> ClassSignature -> Bool)
-> (ClassSignature -> ClassSignature -> Bool) -> Eq ClassSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassSignature -> ClassSignature -> Bool
$c/= :: ClassSignature -> ClassSignature -> Bool
== :: ClassSignature -> ClassSignature -> Bool
$c== :: ClassSignature -> ClassSignature -> Bool
Eq, Eq ClassSignature
Eq ClassSignature
-> (ClassSignature -> ClassSignature -> Ordering)
-> (ClassSignature -> ClassSignature -> Bool)
-> (ClassSignature -> ClassSignature -> Bool)
-> (ClassSignature -> ClassSignature -> Bool)
-> (ClassSignature -> ClassSignature -> Bool)
-> (ClassSignature -> ClassSignature -> ClassSignature)
-> (ClassSignature -> ClassSignature -> ClassSignature)
-> Ord ClassSignature
ClassSignature -> ClassSignature -> Bool
ClassSignature -> ClassSignature -> Ordering
ClassSignature -> ClassSignature -> ClassSignature
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 :: ClassSignature -> ClassSignature -> ClassSignature
$cmin :: ClassSignature -> ClassSignature -> ClassSignature
max :: ClassSignature -> ClassSignature -> ClassSignature
$cmax :: ClassSignature -> ClassSignature -> ClassSignature
>= :: ClassSignature -> ClassSignature -> Bool
$c>= :: ClassSignature -> ClassSignature -> Bool
> :: ClassSignature -> ClassSignature -> Bool
$c> :: ClassSignature -> ClassSignature -> Bool
<= :: ClassSignature -> ClassSignature -> Bool
$c<= :: ClassSignature -> ClassSignature -> Bool
< :: ClassSignature -> ClassSignature -> Bool
$c< :: ClassSignature -> ClassSignature -> Bool
compare :: ClassSignature -> ClassSignature -> Ordering
$ccompare :: ClassSignature -> ClassSignature -> Ordering
$cp1Ord :: Eq ClassSignature
Ord, (forall x. ClassSignature -> Rep ClassSignature x)
-> (forall x. Rep ClassSignature x -> ClassSignature)
-> Generic ClassSignature
forall x. Rep ClassSignature x -> ClassSignature
forall x. ClassSignature -> Rep ClassSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClassSignature x -> ClassSignature
$cfrom :: forall x. ClassSignature -> Rep ClassSignature x
Generic, ClassSignature -> ()
(ClassSignature -> ()) -> NFData ClassSignature
forall a. (a -> ()) -> NFData a
rnf :: ClassSignature -> ()
$crnf :: ClassSignature -> ()
NFData)

data MethodSignature = MethodSignature
  { MethodSignature -> [TypeParameter]
msTypeParameters :: [TypeParameter]
  , MethodSignature -> [TypeSignature]
msArguments      :: [TypeSignature]
  , MethodSignature -> Maybe TypeSignature
msResults        :: Maybe TypeSignature
  , MethodSignature -> [ThrowsSignature]
msThrows         :: [ ThrowsSignature ]
  }
  deriving (Int -> MethodSignature -> ShowS
[MethodSignature] -> ShowS
MethodSignature -> String
(Int -> MethodSignature -> ShowS)
-> (MethodSignature -> String)
-> ([MethodSignature] -> ShowS)
-> Show MethodSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MethodSignature] -> ShowS
$cshowList :: [MethodSignature] -> ShowS
show :: MethodSignature -> String
$cshow :: MethodSignature -> String
showsPrec :: Int -> MethodSignature -> ShowS
$cshowsPrec :: Int -> MethodSignature -> ShowS
Show, MethodSignature -> MethodSignature -> Bool
(MethodSignature -> MethodSignature -> Bool)
-> (MethodSignature -> MethodSignature -> Bool)
-> Eq MethodSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MethodSignature -> MethodSignature -> Bool
$c/= :: MethodSignature -> MethodSignature -> Bool
== :: MethodSignature -> MethodSignature -> Bool
$c== :: MethodSignature -> MethodSignature -> Bool
Eq, Eq MethodSignature
Eq MethodSignature
-> (MethodSignature -> MethodSignature -> Ordering)
-> (MethodSignature -> MethodSignature -> Bool)
-> (MethodSignature -> MethodSignature -> Bool)
-> (MethodSignature -> MethodSignature -> Bool)
-> (MethodSignature -> MethodSignature -> Bool)
-> (MethodSignature -> MethodSignature -> MethodSignature)
-> (MethodSignature -> MethodSignature -> MethodSignature)
-> Ord MethodSignature
MethodSignature -> MethodSignature -> Bool
MethodSignature -> MethodSignature -> Ordering
MethodSignature -> MethodSignature -> MethodSignature
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 :: MethodSignature -> MethodSignature -> MethodSignature
$cmin :: MethodSignature -> MethodSignature -> MethodSignature
max :: MethodSignature -> MethodSignature -> MethodSignature
$cmax :: MethodSignature -> MethodSignature -> MethodSignature
>= :: MethodSignature -> MethodSignature -> Bool
$c>= :: MethodSignature -> MethodSignature -> Bool
> :: MethodSignature -> MethodSignature -> Bool
$c> :: MethodSignature -> MethodSignature -> Bool
<= :: MethodSignature -> MethodSignature -> Bool
$c<= :: MethodSignature -> MethodSignature -> Bool
< :: MethodSignature -> MethodSignature -> Bool
$c< :: MethodSignature -> MethodSignature -> Bool
compare :: MethodSignature -> MethodSignature -> Ordering
$ccompare :: MethodSignature -> MethodSignature -> Ordering
$cp1Ord :: Eq MethodSignature
Ord, (forall x. MethodSignature -> Rep MethodSignature x)
-> (forall x. Rep MethodSignature x -> MethodSignature)
-> Generic MethodSignature
forall x. Rep MethodSignature x -> MethodSignature
forall x. MethodSignature -> Rep MethodSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MethodSignature x -> MethodSignature
$cfrom :: forall x. MethodSignature -> Rep MethodSignature x
Generic, MethodSignature -> ()
(MethodSignature -> ()) -> NFData MethodSignature
forall a. (a -> ()) -> NFData a
rnf :: MethodSignature -> ()
$crnf :: MethodSignature -> ()
NFData)

newtype FieldSignature =
  FieldSignature {FieldSignature -> ReferenceType
fsRefType :: ReferenceType}
  deriving (Int -> FieldSignature -> ShowS
[FieldSignature] -> ShowS
FieldSignature -> String
(Int -> FieldSignature -> ShowS)
-> (FieldSignature -> String)
-> ([FieldSignature] -> ShowS)
-> Show FieldSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldSignature] -> ShowS
$cshowList :: [FieldSignature] -> ShowS
show :: FieldSignature -> String
$cshow :: FieldSignature -> String
showsPrec :: Int -> FieldSignature -> ShowS
$cshowsPrec :: Int -> FieldSignature -> ShowS
Show, FieldSignature -> FieldSignature -> Bool
(FieldSignature -> FieldSignature -> Bool)
-> (FieldSignature -> FieldSignature -> Bool) -> Eq FieldSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldSignature -> FieldSignature -> Bool
$c/= :: FieldSignature -> FieldSignature -> Bool
== :: FieldSignature -> FieldSignature -> Bool
$c== :: FieldSignature -> FieldSignature -> Bool
Eq, Eq FieldSignature
Eq FieldSignature
-> (FieldSignature -> FieldSignature -> Ordering)
-> (FieldSignature -> FieldSignature -> Bool)
-> (FieldSignature -> FieldSignature -> Bool)
-> (FieldSignature -> FieldSignature -> Bool)
-> (FieldSignature -> FieldSignature -> Bool)
-> (FieldSignature -> FieldSignature -> FieldSignature)
-> (FieldSignature -> FieldSignature -> FieldSignature)
-> Ord FieldSignature
FieldSignature -> FieldSignature -> Bool
FieldSignature -> FieldSignature -> Ordering
FieldSignature -> FieldSignature -> FieldSignature
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 :: FieldSignature -> FieldSignature -> FieldSignature
$cmin :: FieldSignature -> FieldSignature -> FieldSignature
max :: FieldSignature -> FieldSignature -> FieldSignature
$cmax :: FieldSignature -> FieldSignature -> FieldSignature
>= :: FieldSignature -> FieldSignature -> Bool
$c>= :: FieldSignature -> FieldSignature -> Bool
> :: FieldSignature -> FieldSignature -> Bool
$c> :: FieldSignature -> FieldSignature -> Bool
<= :: FieldSignature -> FieldSignature -> Bool
$c<= :: FieldSignature -> FieldSignature -> Bool
< :: FieldSignature -> FieldSignature -> Bool
$c< :: FieldSignature -> FieldSignature -> Bool
compare :: FieldSignature -> FieldSignature -> Ordering
$ccompare :: FieldSignature -> FieldSignature -> Ordering
$cp1Ord :: Eq FieldSignature
Ord, (forall x. FieldSignature -> Rep FieldSignature x)
-> (forall x. Rep FieldSignature x -> FieldSignature)
-> Generic FieldSignature
forall x. Rep FieldSignature x -> FieldSignature
forall x. FieldSignature -> Rep FieldSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldSignature x -> FieldSignature
$cfrom :: forall x. FieldSignature -> Rep FieldSignature x
Generic, FieldSignature -> ()
(FieldSignature -> ()) -> NFData FieldSignature
forall a. (a -> ()) -> NFData a
rnf :: FieldSignature -> ()
$crnf :: FieldSignature -> ()
NFData)

data TypeSignature
  = ReferenceType ReferenceType
  | BaseType JBaseType
  deriving (Int -> TypeSignature -> ShowS
[TypeSignature] -> ShowS
TypeSignature -> String
(Int -> TypeSignature -> ShowS)
-> (TypeSignature -> String)
-> ([TypeSignature] -> ShowS)
-> Show TypeSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeSignature] -> ShowS
$cshowList :: [TypeSignature] -> ShowS
show :: TypeSignature -> String
$cshow :: TypeSignature -> String
showsPrec :: Int -> TypeSignature -> ShowS
$cshowsPrec :: Int -> TypeSignature -> ShowS
Show, TypeSignature -> TypeSignature -> Bool
(TypeSignature -> TypeSignature -> Bool)
-> (TypeSignature -> TypeSignature -> Bool) -> Eq TypeSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSignature -> TypeSignature -> Bool
$c/= :: TypeSignature -> TypeSignature -> Bool
== :: TypeSignature -> TypeSignature -> Bool
$c== :: TypeSignature -> TypeSignature -> Bool
Eq, Eq TypeSignature
Eq TypeSignature
-> (TypeSignature -> TypeSignature -> Ordering)
-> (TypeSignature -> TypeSignature -> Bool)
-> (TypeSignature -> TypeSignature -> Bool)
-> (TypeSignature -> TypeSignature -> Bool)
-> (TypeSignature -> TypeSignature -> Bool)
-> (TypeSignature -> TypeSignature -> TypeSignature)
-> (TypeSignature -> TypeSignature -> TypeSignature)
-> Ord TypeSignature
TypeSignature -> TypeSignature -> Bool
TypeSignature -> TypeSignature -> Ordering
TypeSignature -> TypeSignature -> TypeSignature
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 :: TypeSignature -> TypeSignature -> TypeSignature
$cmin :: TypeSignature -> TypeSignature -> TypeSignature
max :: TypeSignature -> TypeSignature -> TypeSignature
$cmax :: TypeSignature -> TypeSignature -> TypeSignature
>= :: TypeSignature -> TypeSignature -> Bool
$c>= :: TypeSignature -> TypeSignature -> Bool
> :: TypeSignature -> TypeSignature -> Bool
$c> :: TypeSignature -> TypeSignature -> Bool
<= :: TypeSignature -> TypeSignature -> Bool
$c<= :: TypeSignature -> TypeSignature -> Bool
< :: TypeSignature -> TypeSignature -> Bool
$c< :: TypeSignature -> TypeSignature -> Bool
compare :: TypeSignature -> TypeSignature -> Ordering
$ccompare :: TypeSignature -> TypeSignature -> Ordering
$cp1Ord :: Eq TypeSignature
Ord, (forall x. TypeSignature -> Rep TypeSignature x)
-> (forall x. Rep TypeSignature x -> TypeSignature)
-> Generic TypeSignature
forall x. Rep TypeSignature x -> TypeSignature
forall x. TypeSignature -> Rep TypeSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeSignature x -> TypeSignature
$cfrom :: forall x. TypeSignature -> Rep TypeSignature x
Generic, TypeSignature -> ()
(TypeSignature -> ()) -> NFData TypeSignature
forall a. (a -> ()) -> NFData a
rnf :: TypeSignature -> ()
$crnf :: TypeSignature -> ()
NFData)

data ReferenceType
  = RefClassType ClassType
  | RefTypeVariable TypeVariable
  | RefArrayType TypeSignature
  deriving (Int -> ReferenceType -> ShowS
[ReferenceType] -> ShowS
ReferenceType -> String
(Int -> ReferenceType -> ShowS)
-> (ReferenceType -> String)
-> ([ReferenceType] -> ShowS)
-> Show ReferenceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceType] -> ShowS
$cshowList :: [ReferenceType] -> ShowS
show :: ReferenceType -> String
$cshow :: ReferenceType -> String
showsPrec :: Int -> ReferenceType -> ShowS
$cshowsPrec :: Int -> ReferenceType -> ShowS
Show, ReferenceType -> ReferenceType -> Bool
(ReferenceType -> ReferenceType -> Bool)
-> (ReferenceType -> ReferenceType -> Bool) -> Eq ReferenceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceType -> ReferenceType -> Bool
$c/= :: ReferenceType -> ReferenceType -> Bool
== :: ReferenceType -> ReferenceType -> Bool
$c== :: ReferenceType -> ReferenceType -> Bool
Eq, Eq ReferenceType
Eq ReferenceType
-> (ReferenceType -> ReferenceType -> Ordering)
-> (ReferenceType -> ReferenceType -> Bool)
-> (ReferenceType -> ReferenceType -> Bool)
-> (ReferenceType -> ReferenceType -> Bool)
-> (ReferenceType -> ReferenceType -> Bool)
-> (ReferenceType -> ReferenceType -> ReferenceType)
-> (ReferenceType -> ReferenceType -> ReferenceType)
-> Ord ReferenceType
ReferenceType -> ReferenceType -> Bool
ReferenceType -> ReferenceType -> Ordering
ReferenceType -> ReferenceType -> ReferenceType
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 :: ReferenceType -> ReferenceType -> ReferenceType
$cmin :: ReferenceType -> ReferenceType -> ReferenceType
max :: ReferenceType -> ReferenceType -> ReferenceType
$cmax :: ReferenceType -> ReferenceType -> ReferenceType
>= :: ReferenceType -> ReferenceType -> Bool
$c>= :: ReferenceType -> ReferenceType -> Bool
> :: ReferenceType -> ReferenceType -> Bool
$c> :: ReferenceType -> ReferenceType -> Bool
<= :: ReferenceType -> ReferenceType -> Bool
$c<= :: ReferenceType -> ReferenceType -> Bool
< :: ReferenceType -> ReferenceType -> Bool
$c< :: ReferenceType -> ReferenceType -> Bool
compare :: ReferenceType -> ReferenceType -> Ordering
$ccompare :: ReferenceType -> ReferenceType -> Ordering
$cp1Ord :: Eq ReferenceType
Ord, (forall x. ReferenceType -> Rep ReferenceType x)
-> (forall x. Rep ReferenceType x -> ReferenceType)
-> Generic ReferenceType
forall x. Rep ReferenceType x -> ReferenceType
forall x. ReferenceType -> Rep ReferenceType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReferenceType x -> ReferenceType
$cfrom :: forall x. ReferenceType -> Rep ReferenceType x
Generic, ReferenceType -> ()
(ReferenceType -> ()) -> NFData ReferenceType
forall a. (a -> ()) -> NFData a
rnf :: ReferenceType -> ()
$crnf :: ReferenceType -> ()
NFData)

data ClassType
  = ClassType
    { ClassType -> ClassName
ctsName          :: !ClassName
    , ClassType -> Maybe InnerClassType
ctsInnerClass    :: !(Maybe InnerClassType)
    , ClassType -> [Maybe TypeArgument]
ctsTypeArguments :: [Maybe TypeArgument]
    }
  deriving (Int -> ClassType -> ShowS
[ClassType] -> ShowS
ClassType -> String
(Int -> ClassType -> ShowS)
-> (ClassType -> String)
-> ([ClassType] -> ShowS)
-> Show ClassType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClassType] -> ShowS
$cshowList :: [ClassType] -> ShowS
show :: ClassType -> String
$cshow :: ClassType -> String
showsPrec :: Int -> ClassType -> ShowS
$cshowsPrec :: Int -> ClassType -> ShowS
Show, ClassType -> ClassType -> Bool
(ClassType -> ClassType -> Bool)
-> (ClassType -> ClassType -> Bool) -> Eq ClassType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClassType -> ClassType -> Bool
$c/= :: ClassType -> ClassType -> Bool
== :: ClassType -> ClassType -> Bool
$c== :: ClassType -> ClassType -> Bool
Eq, Eq ClassType
Eq ClassType
-> (ClassType -> ClassType -> Ordering)
-> (ClassType -> ClassType -> Bool)
-> (ClassType -> ClassType -> Bool)
-> (ClassType -> ClassType -> Bool)
-> (ClassType -> ClassType -> Bool)
-> (ClassType -> ClassType -> ClassType)
-> (ClassType -> ClassType -> ClassType)
-> Ord ClassType
ClassType -> ClassType -> Bool
ClassType -> ClassType -> Ordering
ClassType -> ClassType -> ClassType
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 :: ClassType -> ClassType -> ClassType
$cmin :: ClassType -> ClassType -> ClassType
max :: ClassType -> ClassType -> ClassType
$cmax :: ClassType -> ClassType -> ClassType
>= :: ClassType -> ClassType -> Bool
$c>= :: ClassType -> ClassType -> Bool
> :: ClassType -> ClassType -> Bool
$c> :: ClassType -> ClassType -> Bool
<= :: ClassType -> ClassType -> Bool
$c<= :: ClassType -> ClassType -> Bool
< :: ClassType -> ClassType -> Bool
$c< :: ClassType -> ClassType -> Bool
compare :: ClassType -> ClassType -> Ordering
$ccompare :: ClassType -> ClassType -> Ordering
$cp1Ord :: Eq ClassType
Ord, (forall x. ClassType -> Rep ClassType x)
-> (forall x. Rep ClassType x -> ClassType) -> Generic ClassType
forall x. Rep ClassType x -> ClassType
forall x. ClassType -> Rep ClassType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClassType x -> ClassType
$cfrom :: forall x. ClassType -> Rep ClassType x
Generic, ClassType -> ()
(ClassType -> ()) -> NFData ClassType
forall a. (a -> ()) -> NFData a
rnf :: ClassType -> ()
$crnf :: ClassType -> ()
NFData)

data InnerClassType
  = InnerClassType
    { InnerClassType -> Text
ictsName          :: !Text.Text
    , InnerClassType -> Maybe InnerClassType
ictsInnerClass    :: !(Maybe InnerClassType)
    , InnerClassType -> [Maybe TypeArgument]
ictsTypeArguments :: [Maybe TypeArgument]
    }
  deriving (Int -> InnerClassType -> ShowS
[InnerClassType] -> ShowS
InnerClassType -> String
(Int -> InnerClassType -> ShowS)
-> (InnerClassType -> String)
-> ([InnerClassType] -> ShowS)
-> Show InnerClassType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InnerClassType] -> ShowS
$cshowList :: [InnerClassType] -> ShowS
show :: InnerClassType -> String
$cshow :: InnerClassType -> String
showsPrec :: Int -> InnerClassType -> ShowS
$cshowsPrec :: Int -> InnerClassType -> ShowS
Show, InnerClassType -> InnerClassType -> Bool
(InnerClassType -> InnerClassType -> Bool)
-> (InnerClassType -> InnerClassType -> Bool) -> Eq InnerClassType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InnerClassType -> InnerClassType -> Bool
$c/= :: InnerClassType -> InnerClassType -> Bool
== :: InnerClassType -> InnerClassType -> Bool
$c== :: InnerClassType -> InnerClassType -> Bool
Eq, Eq InnerClassType
Eq InnerClassType
-> (InnerClassType -> InnerClassType -> Ordering)
-> (InnerClassType -> InnerClassType -> Bool)
-> (InnerClassType -> InnerClassType -> Bool)
-> (InnerClassType -> InnerClassType -> Bool)
-> (InnerClassType -> InnerClassType -> Bool)
-> (InnerClassType -> InnerClassType -> InnerClassType)
-> (InnerClassType -> InnerClassType -> InnerClassType)
-> Ord InnerClassType
InnerClassType -> InnerClassType -> Bool
InnerClassType -> InnerClassType -> Ordering
InnerClassType -> InnerClassType -> InnerClassType
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 :: InnerClassType -> InnerClassType -> InnerClassType
$cmin :: InnerClassType -> InnerClassType -> InnerClassType
max :: InnerClassType -> InnerClassType -> InnerClassType
$cmax :: InnerClassType -> InnerClassType -> InnerClassType
>= :: InnerClassType -> InnerClassType -> Bool
$c>= :: InnerClassType -> InnerClassType -> Bool
> :: InnerClassType -> InnerClassType -> Bool
$c> :: InnerClassType -> InnerClassType -> Bool
<= :: InnerClassType -> InnerClassType -> Bool
$c<= :: InnerClassType -> InnerClassType -> Bool
< :: InnerClassType -> InnerClassType -> Bool
$c< :: InnerClassType -> InnerClassType -> Bool
compare :: InnerClassType -> InnerClassType -> Ordering
$ccompare :: InnerClassType -> InnerClassType -> Ordering
$cp1Ord :: Eq InnerClassType
Ord, (forall x. InnerClassType -> Rep InnerClassType x)
-> (forall x. Rep InnerClassType x -> InnerClassType)
-> Generic InnerClassType
forall x. Rep InnerClassType x -> InnerClassType
forall x. InnerClassType -> Rep InnerClassType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InnerClassType x -> InnerClassType
$cfrom :: forall x. InnerClassType -> Rep InnerClassType x
Generic, InnerClassType -> ()
(InnerClassType -> ()) -> NFData InnerClassType
forall a. (a -> ()) -> NFData a
rnf :: InnerClassType -> ()
$crnf :: InnerClassType -> ()
NFData)

data TypeArgument = TypeArgument
  { TypeArgument -> Maybe Wildcard
taWildcard :: Maybe Wildcard
  , TypeArgument -> ReferenceType
taType     :: ReferenceType
  } deriving (Int -> TypeArgument -> ShowS
[TypeArgument] -> ShowS
TypeArgument -> String
(Int -> TypeArgument -> ShowS)
-> (TypeArgument -> String)
-> ([TypeArgument] -> ShowS)
-> Show TypeArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeArgument] -> ShowS
$cshowList :: [TypeArgument] -> ShowS
show :: TypeArgument -> String
$cshow :: TypeArgument -> String
showsPrec :: Int -> TypeArgument -> ShowS
$cshowsPrec :: Int -> TypeArgument -> ShowS
Show, TypeArgument -> TypeArgument -> Bool
(TypeArgument -> TypeArgument -> Bool)
-> (TypeArgument -> TypeArgument -> Bool) -> Eq TypeArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeArgument -> TypeArgument -> Bool
$c/= :: TypeArgument -> TypeArgument -> Bool
== :: TypeArgument -> TypeArgument -> Bool
$c== :: TypeArgument -> TypeArgument -> Bool
Eq, Eq TypeArgument
Eq TypeArgument
-> (TypeArgument -> TypeArgument -> Ordering)
-> (TypeArgument -> TypeArgument -> Bool)
-> (TypeArgument -> TypeArgument -> Bool)
-> (TypeArgument -> TypeArgument -> Bool)
-> (TypeArgument -> TypeArgument -> Bool)
-> (TypeArgument -> TypeArgument -> TypeArgument)
-> (TypeArgument -> TypeArgument -> TypeArgument)
-> Ord TypeArgument
TypeArgument -> TypeArgument -> Bool
TypeArgument -> TypeArgument -> Ordering
TypeArgument -> TypeArgument -> TypeArgument
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 :: TypeArgument -> TypeArgument -> TypeArgument
$cmin :: TypeArgument -> TypeArgument -> TypeArgument
max :: TypeArgument -> TypeArgument -> TypeArgument
$cmax :: TypeArgument -> TypeArgument -> TypeArgument
>= :: TypeArgument -> TypeArgument -> Bool
$c>= :: TypeArgument -> TypeArgument -> Bool
> :: TypeArgument -> TypeArgument -> Bool
$c> :: TypeArgument -> TypeArgument -> Bool
<= :: TypeArgument -> TypeArgument -> Bool
$c<= :: TypeArgument -> TypeArgument -> Bool
< :: TypeArgument -> TypeArgument -> Bool
$c< :: TypeArgument -> TypeArgument -> Bool
compare :: TypeArgument -> TypeArgument -> Ordering
$ccompare :: TypeArgument -> TypeArgument -> Ordering
$cp1Ord :: Eq TypeArgument
Ord, (forall x. TypeArgument -> Rep TypeArgument x)
-> (forall x. Rep TypeArgument x -> TypeArgument)
-> Generic TypeArgument
forall x. Rep TypeArgument x -> TypeArgument
forall x. TypeArgument -> Rep TypeArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeArgument x -> TypeArgument
$cfrom :: forall x. TypeArgument -> Rep TypeArgument x
Generic, TypeArgument -> ()
(TypeArgument -> ()) -> NFData TypeArgument
forall a. (a -> ()) -> NFData a
rnf :: TypeArgument -> ()
$crnf :: TypeArgument -> ()
NFData)

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

newtype TypeVariable =
  TypeVariable { TypeVariable -> Text
tvAsText :: Text.Text }
  deriving (Int -> TypeVariable -> ShowS
[TypeVariable] -> ShowS
TypeVariable -> String
(Int -> TypeVariable -> ShowS)
-> (TypeVariable -> String)
-> ([TypeVariable] -> ShowS)
-> Show TypeVariable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeVariable] -> ShowS
$cshowList :: [TypeVariable] -> ShowS
show :: TypeVariable -> String
$cshow :: TypeVariable -> String
showsPrec :: Int -> TypeVariable -> ShowS
$cshowsPrec :: Int -> TypeVariable -> ShowS
Show, TypeVariable -> TypeVariable -> Bool
(TypeVariable -> TypeVariable -> Bool)
-> (TypeVariable -> TypeVariable -> Bool) -> Eq TypeVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeVariable -> TypeVariable -> Bool
$c/= :: TypeVariable -> TypeVariable -> Bool
== :: TypeVariable -> TypeVariable -> Bool
$c== :: TypeVariable -> TypeVariable -> Bool
Eq, Eq TypeVariable
Eq TypeVariable
-> (TypeVariable -> TypeVariable -> Ordering)
-> (TypeVariable -> TypeVariable -> Bool)
-> (TypeVariable -> TypeVariable -> Bool)
-> (TypeVariable -> TypeVariable -> Bool)
-> (TypeVariable -> TypeVariable -> Bool)
-> (TypeVariable -> TypeVariable -> TypeVariable)
-> (TypeVariable -> TypeVariable -> TypeVariable)
-> Ord TypeVariable
TypeVariable -> TypeVariable -> Bool
TypeVariable -> TypeVariable -> Ordering
TypeVariable -> TypeVariable -> TypeVariable
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 :: TypeVariable -> TypeVariable -> TypeVariable
$cmin :: TypeVariable -> TypeVariable -> TypeVariable
max :: TypeVariable -> TypeVariable -> TypeVariable
$cmax :: TypeVariable -> TypeVariable -> TypeVariable
>= :: TypeVariable -> TypeVariable -> Bool
$c>= :: TypeVariable -> TypeVariable -> Bool
> :: TypeVariable -> TypeVariable -> Bool
$c> :: TypeVariable -> TypeVariable -> Bool
<= :: TypeVariable -> TypeVariable -> Bool
$c<= :: TypeVariable -> TypeVariable -> Bool
< :: TypeVariable -> TypeVariable -> Bool
$c< :: TypeVariable -> TypeVariable -> Bool
compare :: TypeVariable -> TypeVariable -> Ordering
$ccompare :: TypeVariable -> TypeVariable -> Ordering
$cp1Ord :: Eq TypeVariable
Ord, (forall x. TypeVariable -> Rep TypeVariable x)
-> (forall x. Rep TypeVariable x -> TypeVariable)
-> Generic TypeVariable
forall x. Rep TypeVariable x -> TypeVariable
forall x. TypeVariable -> Rep TypeVariable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeVariable x -> TypeVariable
$cfrom :: forall x. TypeVariable -> Rep TypeVariable x
Generic, TypeVariable -> ()
(TypeVariable -> ()) -> NFData TypeVariable
forall a. (a -> ()) -> NFData a
rnf :: TypeVariable -> ()
$crnf :: TypeVariable -> ()
NFData)

data TypeParameter =
  TypeParameter
  { TypeParameter -> Text
tpIdentifier    :: Text.Text
  , TypeParameter -> Maybe ReferenceType
tpClassBound     :: Maybe ReferenceType
  , TypeParameter -> [ReferenceType]
tpInterfaceBound :: [ReferenceType]
  }
  deriving (Int -> TypeParameter -> ShowS
[TypeParameter] -> ShowS
TypeParameter -> String
(Int -> TypeParameter -> ShowS)
-> (TypeParameter -> String)
-> ([TypeParameter] -> ShowS)
-> Show TypeParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeParameter] -> ShowS
$cshowList :: [TypeParameter] -> ShowS
show :: TypeParameter -> String
$cshow :: TypeParameter -> String
showsPrec :: Int -> TypeParameter -> ShowS
$cshowsPrec :: Int -> TypeParameter -> ShowS
Show, TypeParameter -> TypeParameter -> Bool
(TypeParameter -> TypeParameter -> Bool)
-> (TypeParameter -> TypeParameter -> Bool) -> Eq TypeParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeParameter -> TypeParameter -> Bool
$c/= :: TypeParameter -> TypeParameter -> Bool
== :: TypeParameter -> TypeParameter -> Bool
$c== :: TypeParameter -> TypeParameter -> Bool
Eq, Eq TypeParameter
Eq TypeParameter
-> (TypeParameter -> TypeParameter -> Ordering)
-> (TypeParameter -> TypeParameter -> Bool)
-> (TypeParameter -> TypeParameter -> Bool)
-> (TypeParameter -> TypeParameter -> Bool)
-> (TypeParameter -> TypeParameter -> Bool)
-> (TypeParameter -> TypeParameter -> TypeParameter)
-> (TypeParameter -> TypeParameter -> TypeParameter)
-> Ord TypeParameter
TypeParameter -> TypeParameter -> Bool
TypeParameter -> TypeParameter -> Ordering
TypeParameter -> TypeParameter -> TypeParameter
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 :: TypeParameter -> TypeParameter -> TypeParameter
$cmin :: TypeParameter -> TypeParameter -> TypeParameter
max :: TypeParameter -> TypeParameter -> TypeParameter
$cmax :: TypeParameter -> TypeParameter -> TypeParameter
>= :: TypeParameter -> TypeParameter -> Bool
$c>= :: TypeParameter -> TypeParameter -> Bool
> :: TypeParameter -> TypeParameter -> Bool
$c> :: TypeParameter -> TypeParameter -> Bool
<= :: TypeParameter -> TypeParameter -> Bool
$c<= :: TypeParameter -> TypeParameter -> Bool
< :: TypeParameter -> TypeParameter -> Bool
$c< :: TypeParameter -> TypeParameter -> Bool
compare :: TypeParameter -> TypeParameter -> Ordering
$ccompare :: TypeParameter -> TypeParameter -> Ordering
$cp1Ord :: Eq TypeParameter
Ord, (forall x. TypeParameter -> Rep TypeParameter x)
-> (forall x. Rep TypeParameter x -> TypeParameter)
-> Generic TypeParameter
forall x. Rep TypeParameter x -> TypeParameter
forall x. TypeParameter -> Rep TypeParameter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeParameter x -> TypeParameter
$cfrom :: forall x. TypeParameter -> Rep TypeParameter x
Generic, TypeParameter -> ()
(TypeParameter -> ()) -> NFData TypeParameter
forall a. (a -> ()) -> NFData a
rnf :: TypeParameter -> ()
$crnf :: TypeParameter -> ()
NFData)

data ThrowsSignature
  = ThrowsClass ClassType
  | ThrowsTypeVariable TypeVariable
  deriving (Int -> ThrowsSignature -> ShowS
[ThrowsSignature] -> ShowS
ThrowsSignature -> String
(Int -> ThrowsSignature -> ShowS)
-> (ThrowsSignature -> String)
-> ([ThrowsSignature] -> ShowS)
-> Show ThrowsSignature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThrowsSignature] -> ShowS
$cshowList :: [ThrowsSignature] -> ShowS
show :: ThrowsSignature -> String
$cshow :: ThrowsSignature -> String
showsPrec :: Int -> ThrowsSignature -> ShowS
$cshowsPrec :: Int -> ThrowsSignature -> ShowS
Show, ThrowsSignature -> ThrowsSignature -> Bool
(ThrowsSignature -> ThrowsSignature -> Bool)
-> (ThrowsSignature -> ThrowsSignature -> Bool)
-> Eq ThrowsSignature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThrowsSignature -> ThrowsSignature -> Bool
$c/= :: ThrowsSignature -> ThrowsSignature -> Bool
== :: ThrowsSignature -> ThrowsSignature -> Bool
$c== :: ThrowsSignature -> ThrowsSignature -> Bool
Eq, Eq ThrowsSignature
Eq ThrowsSignature
-> (ThrowsSignature -> ThrowsSignature -> Ordering)
-> (ThrowsSignature -> ThrowsSignature -> Bool)
-> (ThrowsSignature -> ThrowsSignature -> Bool)
-> (ThrowsSignature -> ThrowsSignature -> Bool)
-> (ThrowsSignature -> ThrowsSignature -> Bool)
-> (ThrowsSignature -> ThrowsSignature -> ThrowsSignature)
-> (ThrowsSignature -> ThrowsSignature -> ThrowsSignature)
-> Ord ThrowsSignature
ThrowsSignature -> ThrowsSignature -> Bool
ThrowsSignature -> ThrowsSignature -> Ordering
ThrowsSignature -> ThrowsSignature -> ThrowsSignature
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 :: ThrowsSignature -> ThrowsSignature -> ThrowsSignature
$cmin :: ThrowsSignature -> ThrowsSignature -> ThrowsSignature
max :: ThrowsSignature -> ThrowsSignature -> ThrowsSignature
$cmax :: ThrowsSignature -> ThrowsSignature -> ThrowsSignature
>= :: ThrowsSignature -> ThrowsSignature -> Bool
$c>= :: ThrowsSignature -> ThrowsSignature -> Bool
> :: ThrowsSignature -> ThrowsSignature -> Bool
$c> :: ThrowsSignature -> ThrowsSignature -> Bool
<= :: ThrowsSignature -> ThrowsSignature -> Bool
$c<= :: ThrowsSignature -> ThrowsSignature -> Bool
< :: ThrowsSignature -> ThrowsSignature -> Bool
$c< :: ThrowsSignature -> ThrowsSignature -> Bool
compare :: ThrowsSignature -> ThrowsSignature -> Ordering
$ccompare :: ThrowsSignature -> ThrowsSignature -> Ordering
$cp1Ord :: Eq ThrowsSignature
Ord, (forall x. ThrowsSignature -> Rep ThrowsSignature x)
-> (forall x. Rep ThrowsSignature x -> ThrowsSignature)
-> Generic ThrowsSignature
forall x. Rep ThrowsSignature x -> ThrowsSignature
forall x. ThrowsSignature -> Rep ThrowsSignature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ThrowsSignature x -> ThrowsSignature
$cfrom :: forall x. ThrowsSignature -> Rep ThrowsSignature x
Generic, ThrowsSignature -> ()
(ThrowsSignature -> ()) -> NFData ThrowsSignature
forall a. (a -> ()) -> NFData a
rnf :: ThrowsSignature -> ()
$crnf :: ThrowsSignature -> ()
NFData)

-- Conversion

classTypeToName :: ClassType -> ClassName
classTypeToName :: ClassType -> ClassName
classTypeToName =
  ((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)
-> (ClassType -> Either String ClassName) -> ClassType -> ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String ClassName
textCls (Text -> Either String ClassName)
-> (ClassType -> Text) -> ClassType -> Either String ClassName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
Text.intercalate Text
"$" ([Text] -> Text) -> (ClassType -> [Text]) -> ClassType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassType -> [Text]
getClassName)
 where
  getClassName :: ClassType -> [Text]
getClassName (ClassType {[Maybe TypeArgument]
Maybe InnerClassType
ClassName
ctsTypeArguments :: [Maybe TypeArgument]
ctsInnerClass :: Maybe InnerClassType
ctsName :: ClassName
ctsTypeArguments :: ClassType -> [Maybe TypeArgument]
ctsInnerClass :: ClassType -> Maybe InnerClassType
ctsName :: ClassType -> ClassName
..}) =
    ClassName -> Text
classNameAsText ClassName
ctsName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe InnerClassType -> [Text]
getInnerClassName Maybe InnerClassType
ctsInnerClass

  getInnerClassName :: Maybe InnerClassType -> [Text]
getInnerClassName = \case
    Just (InnerClassType {[Maybe TypeArgument]
Maybe InnerClassType
Text
ictsTypeArguments :: [Maybe TypeArgument]
ictsInnerClass :: Maybe InnerClassType
ictsName :: Text
ictsTypeArguments :: InnerClassType -> [Maybe TypeArgument]
ictsInnerClass :: InnerClassType -> Maybe InnerClassType
ictsName :: InnerClassType -> Text
..}) -> Text
ictsName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe InnerClassType -> [Text]
getInnerClassName Maybe InnerClassType
ictsInnerClass
    Maybe InnerClassType
Nothing                    -> []

-- | Create a classType from a Name
-- Note the language is wierd here! Main.A is not Main$A, but Main<T>.A is!
classTypeFromName :: ClassName -> ClassType
classTypeFromName :: ClassName -> ClassType
classTypeFromName ClassName
cn = ClassName
-> Maybe InnerClassType -> [Maybe TypeArgument] -> ClassType
ClassType ClassName
cn Maybe InnerClassType
forall a. Maybe a
Nothing []

throwsSignatureFromName :: ClassName -> ThrowsSignature
throwsSignatureFromName :: ClassName -> ThrowsSignature
throwsSignatureFromName ClassName
cn = ClassType -> ThrowsSignature
ThrowsClass (ClassName -> ClassType
classTypeFromName ClassName
cn)

referenceTypeFromRefType :: JRefType -> ReferenceType
referenceTypeFromRefType :: JRefType -> ReferenceType
referenceTypeFromRefType = \case
  JTArray JType
a -> TypeSignature -> ReferenceType
RefArrayType (JType -> TypeSignature
typeSignatureFromType JType
a)
  JTClass ClassName
a -> ClassType -> ReferenceType
RefClassType (ClassName -> ClassType
classTypeFromName ClassName
a)

typeSignatureFromType :: JType -> TypeSignature
typeSignatureFromType :: JType -> TypeSignature
typeSignatureFromType = \case
  JTBase JBaseType
a -> JBaseType -> TypeSignature
BaseType JBaseType
a
  JTRef  JRefType
a -> ReferenceType -> TypeSignature
ReferenceType (JRefType -> ReferenceType
referenceTypeFromRefType JRefType
a)

isSimpleMethodSignature :: MethodSignature -> Bool
isSimpleMethodSignature :: MethodSignature -> Bool
isSimpleMethodSignature MethodSignature {[ThrowsSignature]
[TypeParameter]
[TypeSignature]
Maybe TypeSignature
msThrows :: [ThrowsSignature]
msResults :: Maybe TypeSignature
msArguments :: [TypeSignature]
msTypeParameters :: [TypeParameter]
msThrows :: MethodSignature -> [ThrowsSignature]
msResults :: MethodSignature -> Maybe TypeSignature
msArguments :: MethodSignature -> [TypeSignature]
msTypeParameters :: MethodSignature -> [TypeParameter]
..} = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [ [TypeParameter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeParameter]
msTypeParameters
  , (TypeSignature -> Bool) -> [TypeSignature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TypeSignature -> Bool
isSimpleTypeSignature   [TypeSignature]
msArguments
  , (TypeSignature -> Bool) -> Maybe TypeSignature -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TypeSignature -> Bool
isSimpleTypeSignature   Maybe TypeSignature
msResults
  , (ThrowsSignature -> Bool) -> [ThrowsSignature] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ThrowsSignature -> Bool
isSimpleThrowsSignature [ThrowsSignature]
msThrows
  ]

isSimpleClassSignature :: ClassSignature -> Bool
isSimpleClassSignature :: ClassSignature -> Bool
isSimpleClassSignature ClassSignature {[TypeParameter]
[ClassType]
ClassType
csInterfaceSignatures :: [ClassType]
csSuperclassSignature :: ClassType
csTypeParameters :: [TypeParameter]
csInterfaceSignatures :: ClassSignature -> [ClassType]
csSuperclassSignature :: ClassSignature -> ClassType
csTypeParameters :: ClassSignature -> [TypeParameter]
..} = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [ [TypeParameter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TypeParameter]
csTypeParameters
  , ClassType -> Bool
isSimpleClassType ClassType
csSuperclassSignature
  , (ClassType -> Bool) -> [ClassType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ClassType -> Bool
isSimpleClassType [ClassType]
csInterfaceSignatures
  ]

isSimpleFieldSignature :: FieldSignature -> Bool
isSimpleFieldSignature :: FieldSignature -> Bool
isSimpleFieldSignature FieldSignature {ReferenceType
fsRefType :: ReferenceType
fsRefType :: FieldSignature -> ReferenceType
..} = ReferenceType -> Bool
isSimpleReferenceType ReferenceType
fsRefType

isSimpleTypeSignature :: TypeSignature -> Bool
isSimpleTypeSignature :: TypeSignature -> Bool
isSimpleTypeSignature = \case
  BaseType      JBaseType
_ -> Bool
True
  ReferenceType ReferenceType
a -> ReferenceType -> Bool
isSimpleReferenceType ReferenceType
a

isSimpleReferenceType :: ReferenceType -> Bool
isSimpleReferenceType :: ReferenceType -> Bool
isSimpleReferenceType = \case
  RefArrayType    TypeSignature
a -> TypeSignature -> Bool
isSimpleTypeSignature TypeSignature
a
  RefClassType    ClassType
a -> ClassType -> Bool
isSimpleClassType ClassType
a
  RefTypeVariable TypeVariable
_ -> Bool
False

isSimpleClassType :: ClassType -> Bool
isSimpleClassType :: ClassType -> Bool
isSimpleClassType = \case
  ClassType ClassName
_ Maybe InnerClassType
Nothing [] -> Bool
True
  ClassType
_                      -> Bool
False

isSimpleThrowsSignature :: ThrowsSignature -> Bool
isSimpleThrowsSignature :: ThrowsSignature -> Bool
isSimpleThrowsSignature = \case
  ThrowsClass        ClassType
a -> ClassType -> Bool
isSimpleClassType ClassType
a
  ThrowsTypeVariable TypeVariable
_ -> Bool
False


instance TextSerializable ClassSignature where
  parseText :: Parser ClassSignature
parseText = Parser ClassSignature
classSignatureP
  toBuilder :: ClassSignature -> Builder
toBuilder = ClassSignature -> Builder
classSignatureT

instance TextSerializable MethodSignature where
  parseText :: Parser MethodSignature
parseText = Parser MethodSignature
methodSignatureP
  toBuilder :: MethodSignature -> Builder
toBuilder = MethodSignature -> Builder
methodSignatureT

instance TextSerializable FieldSignature where
  parseText :: Parser FieldSignature
parseText = Parser FieldSignature
fieldSignatureP
  toBuilder :: FieldSignature -> Builder
toBuilder = FieldSignature -> Builder
fieldSignatureT

instance TextSerializable TypeSignature where
  parseText :: Parser TypeSignature
parseText = Parser TypeSignature
typeSignatureP
  toBuilder :: TypeSignature -> Builder
toBuilder = TypeSignature -> Builder
typeSignatureT

instance TextSerializable ReferenceType where
  parseText :: Parser ReferenceType
parseText = Parser ReferenceType
referenceTypeP
  toBuilder :: ReferenceType -> Builder
toBuilder = ReferenceType -> Builder
referenceTypeT

instance TextSerializable ClassType where
  parseText :: Parser ClassType
parseText = Parser ClassType
classTypeP
  toBuilder :: ClassType -> Builder
toBuilder = ClassType -> Builder
classTypeT

instance TextSerializable Wildcard where
  parseText :: Parser Wildcard
parseText = Parser Wildcard
wildcardP
  toBuilder :: Wildcard -> Builder
toBuilder = Wildcard -> Builder
wildcardT

instance TextSerializable TypeVariable where
  parseText :: Parser TypeVariable
parseText = Parser TypeVariable
typeVariableP
  toBuilder :: TypeVariable -> Builder
toBuilder = TypeVariable -> Builder
typeVariableT

instance TextSerializable TypeParameter where
  parseText :: Parser TypeParameter
parseText = Parser TypeParameter
typeParameterP
  toBuilder :: TypeParameter -> Builder
toBuilder = TypeParameter -> Builder
typeParameterT

instance TextSerializable ThrowsSignature where
  parseText :: Parser ThrowsSignature
parseText = Parser ThrowsSignature
throwsSignatureP
  toBuilder :: ThrowsSignature -> Builder
toBuilder = ThrowsSignature -> Builder
throwsSignatureT

----------------------
-- Parsing
----------------------

classSignatureP :: Parser ClassSignature
classSignatureP :: Parser ClassSignature
classSignatureP = do
  [TypeParameter]
tp <- [TypeParameter]
-> Parser Text [TypeParameter] -> Parser Text [TypeParameter]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] Parser Text [TypeParameter]
typeParametersP
  ClassType
ss <- Parser ClassType
classTypeP
  [ClassType]
is <- Parser ClassType -> Parser Text [ClassType]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser ClassType
classTypeP
  ClassSignature -> Parser ClassSignature
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassSignature -> Parser ClassSignature)
-> ClassSignature -> Parser ClassSignature
forall a b. (a -> b) -> a -> b
$ [TypeParameter] -> ClassType -> [ClassType] -> ClassSignature
ClassSignature [TypeParameter]
tp ClassType
ss [ClassType]
is

classSignatureToText :: ClassSignature -> Text.Text
classSignatureToText :: ClassSignature -> Text
classSignatureToText = Text -> Text
LText.toStrict (Text -> Text)
-> (ClassSignature -> Text) -> ClassSignature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text)
-> (ClassSignature -> Builder) -> ClassSignature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassSignature -> Builder
classSignatureT

classSignatureFromText :: Text.Text -> Either String ClassSignature
classSignatureFromText :: Text -> Either String ClassSignature
classSignatureFromText = Parser ClassSignature -> Text -> Either String ClassSignature
forall a. Parser a -> Text -> Either String a
parseOnly Parser ClassSignature
classSignatureP

classSignatureT :: ClassSignature -> Builder
classSignatureT :: ClassSignature -> Builder
classSignatureT (ClassSignature [TypeParameter]
tp ClassType
ct [ClassType]
its) = do
  [TypeParameter] -> Builder
typeParametersT [TypeParameter]
tp Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ClassType -> Builder) -> [ClassType] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ClassType -> Builder
classTypeT (ClassType
ct ClassType -> [ClassType] -> [ClassType]
forall a. a -> [a] -> [a]
: [ClassType]
its)


typeSignatureP :: Parser TypeSignature
typeSignatureP :: Parser TypeSignature
typeSignatureP = do
  [Parser TypeSignature] -> Parser TypeSignature
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
    [ (ReferenceType -> TypeSignature
ReferenceType (ReferenceType -> TypeSignature)
-> Parser ReferenceType -> Parser TypeSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ReferenceType
referenceTypeP) Parser TypeSignature -> String -> Parser TypeSignature
forall i a. Parser i a -> String -> Parser i a
<?> String
"JRefereceType"
    , (JBaseType -> TypeSignature
BaseType (JBaseType -> TypeSignature)
-> Parser Text JBaseType -> Parser TypeSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text JBaseType
parseJBaseType) Parser TypeSignature -> String -> Parser TypeSignature
forall i a. Parser i a -> String -> Parser i a
<?> String
"JBaseType"
    ]

typeSignatureT :: TypeSignature -> Builder
typeSignatureT :: TypeSignature -> Builder
typeSignatureT (ReferenceType ReferenceType
t) = ReferenceType -> Builder
referenceTypeT ReferenceType
t
typeSignatureT (BaseType      JBaseType
t) = Char -> Builder
singleton (JBaseType -> Char
jBaseTypeToChar JBaseType
t)

referenceTypeP :: Parser ReferenceType
referenceTypeP :: Parser ReferenceType
referenceTypeP = do
  [Parser ReferenceType] -> Parser ReferenceType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
    [ ClassType -> ReferenceType
RefClassType (ClassType -> ReferenceType)
-> Parser ClassType -> Parser ReferenceType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClassType
classTypeP
    , TypeVariable -> ReferenceType
RefTypeVariable (TypeVariable -> ReferenceType)
-> Parser TypeVariable -> Parser ReferenceType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeVariable
typeVariableP
    , TypeSignature -> ReferenceType
RefArrayType (TypeSignature -> ReferenceType)
-> Parser TypeSignature -> Parser ReferenceType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'[' Parser Char -> Parser TypeSignature -> Parser TypeSignature
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser TypeSignature
typeSignatureP)
    ]

referenceTypeT :: ReferenceType -> Builder
referenceTypeT :: ReferenceType -> Builder
referenceTypeT ReferenceType
t = case ReferenceType
t of
  RefClassType    ClassType
ct -> ClassType -> Builder
classTypeT ClassType
ct
  RefTypeVariable TypeVariable
tv -> TypeVariable -> Builder
typeVariableT TypeVariable
tv
  RefArrayType    TypeSignature
at -> Char -> Builder
singleton Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> TypeSignature -> Builder
typeSignatureT TypeSignature
at


classTypeP :: Parser ClassType
classTypeP :: Parser ClassType
classTypeP = String -> Parser ClassType -> Parser ClassType
forall a. String -> Parser a -> Parser a
nameit String
"ClassType" (Parser ClassType -> Parser ClassType)
-> Parser ClassType -> Parser ClassType
forall a b. (a -> b) -> a -> b
$ do
  Char
_   <- Char -> Parser Char
char Char
'L'
  ClassName
cn  <- Parser ClassName
parseClassName
  [Maybe TypeArgument]
ta  <- [Maybe TypeArgument]
-> Parser Text [Maybe TypeArgument]
-> Parser Text [Maybe TypeArgument]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] Parser Text [Maybe TypeArgument]
typeArgumentsP
  [(Text, [Maybe TypeArgument])]
ict <- Parser Text (Text, [Maybe TypeArgument])
-> Parser Text [(Text, [Maybe TypeArgument])]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser Text (Text, [Maybe TypeArgument])
 -> Parser Text [(Text, [Maybe TypeArgument])])
-> Parser Text (Text, [Maybe TypeArgument])
-> Parser Text [(Text, [Maybe TypeArgument])]
forall a b. (a -> b) -> a -> b
$ do
    Char
_   <- Char -> Parser Char
char Char
'.'
    Text
i   <- Parser Text
identifierP
    [Maybe TypeArgument]
ta' <- [Maybe TypeArgument]
-> Parser Text [Maybe TypeArgument]
-> Parser Text [Maybe TypeArgument]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] Parser Text [Maybe TypeArgument]
typeArgumentsP
    (Text, [Maybe TypeArgument])
-> Parser Text (Text, [Maybe TypeArgument])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
i, [Maybe TypeArgument]
ta')
  Char
_ <- Char -> Parser Char
char Char
';'
  ClassType -> Parser ClassType
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassType -> Parser ClassType) -> ClassType -> Parser ClassType
forall a b. (a -> b) -> a -> b
$ ClassName
-> Maybe InnerClassType -> [Maybe TypeArgument] -> ClassType
ClassType
    ClassName
cn
    (((Text, [Maybe TypeArgument])
 -> Maybe InnerClassType -> Maybe InnerClassType)
-> Maybe InnerClassType
-> [(Text, [Maybe TypeArgument])]
-> Maybe InnerClassType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (\(Text
i, [Maybe TypeArgument]
ta') Maybe InnerClassType
a -> InnerClassType -> Maybe InnerClassType
forall a. a -> Maybe a
Just (InnerClassType -> Maybe InnerClassType)
-> InnerClassType -> Maybe InnerClassType
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe InnerClassType -> [Maybe TypeArgument] -> InnerClassType
InnerClassType Text
i Maybe InnerClassType
a [Maybe TypeArgument]
ta') Maybe InnerClassType
forall a. Maybe a
Nothing [(Text, [Maybe TypeArgument])]
ict)
    [Maybe TypeArgument]
ta

classTypeT :: ClassType -> Builder
classTypeT :: ClassType -> Builder
classTypeT (ClassType ClassName
n Maybe InnerClassType
ic [Maybe TypeArgument]
arg) =
  Char -> Builder
singleton Char
'L'
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.fromText (ClassName -> Text
classNameAsText ClassName
n)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Maybe TypeArgument] -> Builder
typeArgumentsT [Maybe TypeArgument]
arg
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe InnerClassType -> Builder
go Maybe InnerClassType
ic
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
';'
 where
  go :: Maybe InnerClassType -> Builder
go = \case
    Maybe InnerClassType
Nothing -> Builder
forall a. Monoid a => a
mempty
    Just (InnerClassType Text
n' Maybe InnerClassType
ic' [Maybe TypeArgument]
arg') ->
      Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.fromText Text
n' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Maybe TypeArgument] -> Builder
typeArgumentsT [Maybe TypeArgument]
arg' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Maybe InnerClassType -> Builder
go Maybe InnerClassType
ic'


typeArgumentsP :: Parser [Maybe TypeArgument]
typeArgumentsP :: Parser Text [Maybe TypeArgument]
typeArgumentsP = do
  Char
_   <- Char -> Parser Char
char Char
'<'
  [Maybe TypeArgument]
tas <- Parser Text (Maybe TypeArgument)
-> Parser Text [Maybe TypeArgument]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text (Maybe TypeArgument)
typeArgumentP
  Char
_   <- Char -> Parser Char
char Char
'>'
  [Maybe TypeArgument] -> Parser Text [Maybe TypeArgument]
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe TypeArgument]
tas

typeArgumentP :: Parser (Maybe TypeArgument)
typeArgumentP :: Parser Text (Maybe TypeArgument)
typeArgumentP = do
  [Parser Text (Maybe TypeArgument)]
-> Parser Text (Maybe TypeArgument)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ TypeArgument -> Maybe TypeArgument
forall a. a -> Maybe a
Just
        (TypeArgument -> Maybe TypeArgument)
-> Parser Text TypeArgument -> Parser Text (Maybe TypeArgument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (   Maybe Wildcard -> ReferenceType -> TypeArgument
TypeArgument
            (Maybe Wildcard -> ReferenceType -> TypeArgument)
-> Parser Text (Maybe Wildcard)
-> Parser Text (ReferenceType -> TypeArgument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Wildcard
-> Parser Text (Maybe Wildcard) -> Parser Text (Maybe Wildcard)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Maybe Wildcard
forall a. Maybe a
Nothing (Wildcard -> Maybe Wildcard
forall a. a -> Maybe a
Just (Wildcard -> Maybe Wildcard)
-> Parser Wildcard -> Parser Text (Maybe Wildcard)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Wildcard
wildcardP)
            Parser Text (ReferenceType -> TypeArgument)
-> Parser ReferenceType -> Parser Text TypeArgument
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ReferenceType
referenceTypeP
            )
      , Char -> Parser Char
char Char
'*' Parser Char
-> Maybe TypeArgument -> Parser Text (Maybe TypeArgument)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe TypeArgument
forall a. Maybe a
Nothing
      ]
    Parser Text (Maybe TypeArgument)
-> String -> Parser Text (Maybe TypeArgument)
forall i a. Parser i a -> String -> Parser i a
<?> String
"TypeArgument"

typeArgumentsT :: [Maybe TypeArgument] -> Builder
typeArgumentsT :: [Maybe TypeArgument] -> Builder
typeArgumentsT [Maybe TypeArgument]
args = do
  if [Maybe TypeArgument] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Maybe TypeArgument]
args
    then Builder
forall a. Monoid a => a
mempty
    else Char -> Builder
singleton Char
'<' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Maybe TypeArgument -> Builder) -> [Maybe TypeArgument] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Maybe TypeArgument -> Builder
typeArgumentT [Maybe TypeArgument]
args Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'>'

typeArgumentT :: Maybe TypeArgument -> Builder
typeArgumentT :: Maybe TypeArgument -> Builder
typeArgumentT Maybe TypeArgument
a = do
  case Maybe TypeArgument
a of
    Maybe TypeArgument
Nothing -> Char -> Builder
singleton Char
'*'
    Just (TypeArgument Maybe Wildcard
w ReferenceType
rt) ->
      (case Maybe Wildcard
w of
          Just Wildcard
m  -> Wildcard -> Builder
wildcardT Wildcard
m
          Maybe Wildcard
Nothing -> Builder
forall a. Monoid a => a
mempty
        )
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ReferenceType -> Builder
referenceTypeT ReferenceType
rt


wildcardP :: Parser Wildcard
wildcardP :: Parser Wildcard
wildcardP = [Parser Wildcard] -> Parser Wildcard
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Char -> Parser Char
char Char
'+' Parser Char -> Wildcard -> Parser Wildcard
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Wildcard
WildPlus, Char -> Parser Char
char Char
'-' Parser Char -> Wildcard -> Parser Wildcard
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Wildcard
WildMinus]

wildcardT :: Wildcard -> Builder
wildcardT :: Wildcard -> Builder
wildcardT = \case
  Wildcard
WildPlus  -> Char -> Builder
singleton Char
'+'
  Wildcard
WildMinus -> Char -> Builder
singleton Char
'-'


typeVariableP :: Parser TypeVariable
typeVariableP :: Parser TypeVariable
typeVariableP = do
  Char
_ <- Char -> Parser Char
char Char
'T'
  Text
t <- Parser Text
identifierP
  Char
_ <- Char -> Parser Char
char Char
';'
  TypeVariable -> Parser TypeVariable
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeVariable -> Parser TypeVariable)
-> TypeVariable -> Parser TypeVariable
forall a b. (a -> b) -> a -> b
$ Text -> TypeVariable
TypeVariable Text
t

typeVariableT :: TypeVariable -> Builder
typeVariableT :: TypeVariable -> Builder
typeVariableT (TypeVariable Text
t) = do
  Char -> Builder
singleton Char
'T' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.fromText Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
';'


typeParametersP :: Parser [TypeParameter]
typeParametersP :: Parser Text [TypeParameter]
typeParametersP = String
-> Parser Text [TypeParameter] -> Parser Text [TypeParameter]
forall a. String -> Parser a -> Parser a
nameit String
"TypeParameters" (Parser Text [TypeParameter] -> Parser Text [TypeParameter])
-> Parser Text [TypeParameter] -> Parser Text [TypeParameter]
forall a b. (a -> b) -> a -> b
$ do
  Char
_   <- Char -> Parser Char
char Char
'<'
  [TypeParameter]
tps <- Parser TypeParameter -> Parser Text [TypeParameter]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser TypeParameter
typeParameterP
  Char
_   <- Char -> Parser Char
char Char
'>'
  [TypeParameter] -> Parser Text [TypeParameter]
forall (m :: * -> *) a. Monad m => a -> m a
return [TypeParameter]
tps

typeParametersT :: [TypeParameter] -> Builder
typeParametersT :: [TypeParameter] -> Builder
typeParametersT [TypeParameter]
args = do
  if [TypeParameter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [TypeParameter]
args
    then Builder
forall a. Monoid a => a
mempty
    else Char -> Builder
singleton Char
'<' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TypeParameter -> Builder) -> [TypeParameter] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TypeParameter -> Builder
typeParameterT [TypeParameter]
args Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'>'

typeParameterP :: Parser TypeParameter
typeParameterP :: Parser TypeParameter
typeParameterP = String -> Parser TypeParameter -> Parser TypeParameter
forall a. String -> Parser a -> Parser a
nameit String
"TypeParameter" (Parser TypeParameter -> Parser TypeParameter)
-> Parser TypeParameter -> Parser TypeParameter
forall a b. (a -> b) -> a -> b
$ do
  Text
id_ <- Parser Text
identifierP
  Char
_   <- Char -> Parser Char
char Char
':'
  Maybe ReferenceType
cb  <- Parser ReferenceType -> Parser Text (Maybe ReferenceType)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ReferenceType
referenceTypeP
  [ReferenceType]
ib  <- Parser ReferenceType -> Parser Text [ReferenceType]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Char -> Parser Char
char Char
':' Parser Char -> Parser ReferenceType -> Parser ReferenceType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ReferenceType
referenceTypeP)
  TypeParameter -> Parser TypeParameter
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeParameter -> Parser TypeParameter)
-> TypeParameter -> Parser TypeParameter
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ReferenceType -> [ReferenceType] -> TypeParameter
TypeParameter Text
id_ Maybe ReferenceType
cb [ReferenceType]
ib

typeParameterT :: TypeParameter -> Builder
typeParameterT :: TypeParameter -> Builder
typeParameterT (TypeParameter Text
n Maybe ReferenceType
cb [ReferenceType]
ibs) =
  Text -> Builder
Text.fromText Text
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
<> Builder
-> (ReferenceType -> Builder) -> Maybe ReferenceType -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
forall a. Monoid a => a
mempty ReferenceType -> Builder
referenceTypeT Maybe ReferenceType
cb
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ReferenceType -> Builder) -> [ReferenceType] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ReferenceType
i -> Char -> Builder
singleton Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ReferenceType -> Builder
referenceTypeT ReferenceType
i) [ReferenceType]
ibs

nameit :: String -> Parser a -> Parser a
nameit :: String -> Parser a -> Parser a
nameit String
str Parser a
m = Parser a
m Parser a -> String -> Parser a
forall i a. Parser i a -> String -> Parser i a
<?> String
str

identifierP :: Parser Text.Text
identifierP :: Parser Text
identifierP = (Char -> Bool) -> Parser Text
takeWhile1 (String -> Char -> Bool
notInClass String
".;[/<>:") Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Identifier"


methodSignatureP :: Parser MethodSignature
methodSignatureP :: Parser MethodSignature
methodSignatureP = do
  [TypeParameter]
tps   <- [TypeParameter]
-> Parser Text [TypeParameter] -> Parser Text [TypeParameter]
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option [] Parser Text [TypeParameter]
typeParametersP
  Char
_     <- Char -> Parser Char
char Char
'('
  [TypeSignature]
targ  <- Parser TypeSignature -> Parser Text [TypeSignature]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser TypeSignature
typeSignatureP
  Char
_     <- Char -> Parser Char
char Char
')'
  Maybe TypeSignature
res   <- [Parser Text (Maybe TypeSignature)]
-> Parser Text (Maybe TypeSignature)
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [TypeSignature -> Maybe TypeSignature
forall a. a -> Maybe a
Just (TypeSignature -> Maybe TypeSignature)
-> Parser TypeSignature -> Parser Text (Maybe TypeSignature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeSignature
typeSignatureP, Char -> Parser Char
char Char
'V' Parser Char
-> Maybe TypeSignature -> Parser Text (Maybe TypeSignature)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe TypeSignature
forall a. Maybe a
Nothing]
  [ThrowsSignature]
thrws <- Parser ThrowsSignature -> Parser Text [ThrowsSignature]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser ThrowsSignature
throwsSignatureP
  MethodSignature -> Parser MethodSignature
forall (m :: * -> *) a. Monad m => a -> m a
return (MethodSignature -> Parser MethodSignature)
-> MethodSignature -> Parser MethodSignature
forall a b. (a -> b) -> a -> b
$ [TypeParameter]
-> [TypeSignature]
-> Maybe TypeSignature
-> [ThrowsSignature]
-> MethodSignature
MethodSignature [TypeParameter]
tps [TypeSignature]
targ Maybe TypeSignature
res [ThrowsSignature]
thrws

methodSignatureToText :: MethodSignature -> Text.Text
methodSignatureToText :: MethodSignature -> Text
methodSignatureToText = Text -> Text
LText.toStrict (Text -> Text)
-> (MethodSignature -> Text) -> MethodSignature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text)
-> (MethodSignature -> Builder) -> MethodSignature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodSignature -> Builder
methodSignatureT

methodSignatureFromText :: Text.Text -> Either String MethodSignature
methodSignatureFromText :: Text -> Either String MethodSignature
methodSignatureFromText = Parser MethodSignature -> Text -> Either String MethodSignature
forall a. Parser a -> Text -> Either String a
parseOnly Parser MethodSignature
methodSignatureP

fieldSignatureFromText :: Text.Text -> Either String FieldSignature
fieldSignatureFromText :: Text -> Either String FieldSignature
fieldSignatureFromText = Parser FieldSignature -> Text -> Either String FieldSignature
forall a. Parser a -> Text -> Either String a
parseOnly Parser FieldSignature
fieldSignatureP

methodSignatureT :: MethodSignature -> Builder
methodSignatureT :: MethodSignature -> Builder
methodSignatureT (MethodSignature [TypeParameter]
tp [TypeSignature]
args Maybe TypeSignature
res [ThrowsSignature]
thrws) = do
  [TypeParameter] -> Builder
typeParametersT [TypeParameter]
tp
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
singleton Char
'('
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (TypeSignature -> Builder) -> [TypeSignature] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TypeSignature -> Builder
typeSignatureT [TypeSignature]
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
<> (case Maybe TypeSignature
res of
         Maybe TypeSignature
Nothing -> Char -> Builder
singleton Char
'V'
         Just TypeSignature
r  -> TypeSignature -> Builder
typeSignatureT TypeSignature
r
       )
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ThrowsSignature -> Builder) -> [ThrowsSignature] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ThrowsSignature -> Builder
throwsSignatureT [ThrowsSignature]
thrws


throwsSignatureP :: Parser ThrowsSignature
throwsSignatureP :: Parser ThrowsSignature
throwsSignatureP = do
  Char
_ <- Char -> Parser Char
char Char
'^'
  [Parser ThrowsSignature] -> Parser ThrowsSignature
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ClassType -> ThrowsSignature
ThrowsClass (ClassType -> ThrowsSignature)
-> Parser ClassType -> Parser ThrowsSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ClassType
classTypeP, TypeVariable -> ThrowsSignature
ThrowsTypeVariable (TypeVariable -> ThrowsSignature)
-> Parser TypeVariable -> Parser ThrowsSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TypeVariable
typeVariableP]


throwsSignatureT :: ThrowsSignature -> Builder
throwsSignatureT :: ThrowsSignature -> Builder
throwsSignatureT ThrowsSignature
t = Char -> Builder
singleton Char
'^' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case ThrowsSignature
t of
  ThrowsClass        ClassType
ct -> ClassType -> Builder
classTypeT ClassType
ct
  ThrowsTypeVariable TypeVariable
tt -> TypeVariable -> Builder
typeVariableT TypeVariable
tt

fieldSignatureP :: Parser FieldSignature
fieldSignatureP :: Parser FieldSignature
fieldSignatureP = ReferenceType -> FieldSignature
FieldSignature (ReferenceType -> FieldSignature)
-> Parser ReferenceType -> Parser FieldSignature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ReferenceType
referenceTypeP

fieldSignatureToText :: FieldSignature -> Text.Text
fieldSignatureToText :: FieldSignature -> Text
fieldSignatureToText = Text -> Text
LText.toStrict (Text -> Text)
-> (FieldSignature -> Text) -> FieldSignature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text)
-> (FieldSignature -> Builder) -> FieldSignature -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReferenceType -> Builder
referenceTypeT (ReferenceType -> Builder)
-> (FieldSignature -> ReferenceType) -> FieldSignature -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldSignature -> ReferenceType
fsRefType

fieldSignatureT :: FieldSignature -> Builder
fieldSignatureT :: FieldSignature -> Builder
fieldSignatureT = ReferenceType -> Builder
referenceTypeT (ReferenceType -> Builder)
-> (FieldSignature -> ReferenceType) -> FieldSignature -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldSignature -> ReferenceType
fsRefType

instance Staged Signature where
  evolve :: Signature Low -> m (Signature High)
evolve (Signature Ref Text Low
a) = String -> m (Signature High) -> m (Signature High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Signature" (m (Signature High) -> m (Signature High))
-> m (Signature High) -> m (Signature High)
forall a b. (a -> b) -> a -> b
$ Text -> Signature High
forall a. Ref Text a -> Signature a
Signature (Text -> Signature High) -> m Text -> m (Signature High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m Text
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref Text Low
a

  devolve :: Signature High -> m (Signature Low)
devolve (Signature Ref Text High
a) = String -> m (Signature Low) -> m (Signature Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Signature" (m (Signature Low) -> m (Signature Low))
-> m (Signature Low) -> m (Signature Low)
forall a b. (a -> b) -> a -> b
$ Index -> Signature Low
forall a. Ref Text a -> Signature a
Signature (Index -> Signature Low) -> m Index -> m (Signature Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Text
Ref Text High
a

$(deriveBaseWithBinary ''Signature)