{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RecordWildCards #-}
module Language.JVM.Field
( Field (..)
, fAccessFlags
, fConstantValue
, fSignature
, FieldAttributes (..)
, emptyFieldAttributes
) where
import Data.Monoid
import qualified Data.Set as Set
import qualified Data.Text as Text
import Language.JVM.AccessFlag
import Language.JVM.Attribute
import Language.JVM.Constant
import Language.JVM.Staged
import Language.JVM.Utils
import Language.JVM.Type
data Field r = Field
{ Field r -> BitSet16 FAccessFlag
fAccessFlags' :: !(BitSet16 FAccessFlag)
, Field r -> Ref Text r
fName :: !(Ref Text.Text r)
, Field r -> Ref FieldDescriptor r
fDescriptor :: !(Ref FieldDescriptor r)
, Field r -> Attributes FieldAttributes r
fAttributes :: !(Attributes FieldAttributes r)
}
fAccessFlags :: Field r -> Set.Set FAccessFlag
fAccessFlags :: Field r -> Set FAccessFlag
fAccessFlags = BitSet16 FAccessFlag -> Set FAccessFlag
forall w a. BitSet w a -> Set a
toSet (BitSet16 FAccessFlag -> Set FAccessFlag)
-> (Field r -> BitSet16 FAccessFlag) -> Field r -> Set FAccessFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field r -> BitSet16 FAccessFlag
forall r. Field r -> BitSet16 FAccessFlag
fAccessFlags'
fConstantValue :: Field High -> Maybe (ConstantValue High)
fConstantValue :: Field High -> Maybe (ConstantValue High)
fConstantValue =
[ConstantValue High] -> Maybe (ConstantValue High)
forall a. [a] -> Maybe a
firstOne ([ConstantValue High] -> Maybe (ConstantValue High))
-> (Field High -> [ConstantValue High])
-> Field High
-> Maybe (ConstantValue High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldAttributes High -> [ConstantValue High]
forall r. FieldAttributes r -> [ConstantValue r]
faConstantValues (FieldAttributes High -> [ConstantValue High])
-> (Field High -> FieldAttributes High)
-> Field High
-> [ConstantValue High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field High -> FieldAttributes High
forall r. Field r -> Attributes FieldAttributes r
fAttributes
fSignature :: Field High -> Maybe (Signature High)
fSignature :: Field High -> Maybe (Signature High)
fSignature =
[Signature High] -> Maybe (Signature High)
forall a. [a] -> Maybe a
firstOne ([Signature High] -> Maybe (Signature High))
-> (Field High -> [Signature High])
-> Field High
-> Maybe (Signature High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldAttributes High -> [Signature High]
forall r. FieldAttributes r -> [Signature r]
faSignatures (FieldAttributes High -> [Signature High])
-> (Field High -> FieldAttributes High)
-> Field High
-> [Signature High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field High -> FieldAttributes High
forall r. Field r -> Attributes FieldAttributes r
fAttributes
data FieldAttributes r = FieldAttributes
{ FieldAttributes r -> [ConstantValue r]
faConstantValues :: [ ConstantValue r ]
, FieldAttributes r -> [Signature r]
faSignatures :: [ Signature r ]
, FieldAttributes r -> [RuntimeVisibleAnnotations r]
faVisibleAnnotations :: [ RuntimeVisibleAnnotations r ]
, FieldAttributes r -> [RuntimeInvisibleAnnotations r]
faInvisibleAnnotations :: [ RuntimeInvisibleAnnotations r ]
, FieldAttributes r
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation r]
faVisibleTypeAnnotations ::
[ RuntimeVisibleTypeAnnotations FieldTypeAnnotation r ]
, FieldAttributes r
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation r]
faInvisibleTypeAnnotations ::
[ RuntimeInvisibleTypeAnnotations FieldTypeAnnotation r ]
, FieldAttributes r -> [Attribute r]
faOthers :: [ Attribute r ]
}
emptyFieldAttributes :: FieldAttributes High
emptyFieldAttributes :: FieldAttributes High
emptyFieldAttributes =
[ConstantValue High]
-> [Signature High]
-> [RuntimeVisibleAnnotations High]
-> [RuntimeInvisibleAnnotations High]
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
-> [Attribute High]
-> FieldAttributes High
forall r.
[ConstantValue r]
-> [Signature r]
-> [RuntimeVisibleAnnotations r]
-> [RuntimeInvisibleAnnotations r]
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation r]
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation r]
-> [Attribute r]
-> FieldAttributes r
FieldAttributes [] [] [] [] [] [] []
instance Staged Field where
evolve :: Field Low -> m (Field High)
evolve Field Low
field = String -> m (Field High) -> m (Field High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"Field" (m (Field High) -> m (Field High))
-> m (Field High) -> m (Field High)
forall a b. (a -> b) -> a -> b
$ do
Text
fi <- Index -> m Text
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link (Field Low -> Ref Text Low
forall r. Field r -> Ref Text r
fName Field Low
field)
FieldDescriptor
fd <- Index -> m FieldDescriptor
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link (Field Low -> Ref FieldDescriptor Low
forall r. Field r -> Ref FieldDescriptor r
fDescriptor Field Low
field)
String -> m (Field High) -> m (Field High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label (Text -> String
Text.unpack (Text -> String) -> (FieldId -> Text) -> FieldId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldId -> Text
forall a. TextSerializable a => a -> Text
serialize (FieldId -> String) -> FieldId -> String
forall a b. (a -> b) -> a -> b
$ Text
fi Text -> FieldDescriptor -> WithNameId FieldDescriptor
forall n. WithName n => Text -> n -> WithNameId n
<:> FieldDescriptor
fd) (m (Field High) -> m (Field High))
-> m (Field High) -> m (Field High)
forall a b. (a -> b) -> a -> b
$ do
FieldAttributes High
fattr <- (Endo (FieldAttributes High) -> FieldAttributes High)
-> m (Endo (FieldAttributes High)) -> m (FieldAttributes High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endo (FieldAttributes High)
-> FieldAttributes High -> FieldAttributes High
forall a. Endo a -> a -> a
`appEndo` FieldAttributes High
emptyFieldAttributes) (m (Endo (FieldAttributes High)) -> m (FieldAttributes High))
-> ((Attribute High -> m (Endo (FieldAttributes High)))
-> m (Endo (FieldAttributes High)))
-> (Attribute High -> m (Endo (FieldAttributes High)))
-> m (FieldAttributes High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeLocation
-> SizedList Index (Attribute Low)
-> (Attribute High -> m (Endo (FieldAttributes High)))
-> m (Endo (FieldAttributes High))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, EvolveM m, Monoid a) =>
AttributeLocation
-> f (Attribute Low) -> (Attribute High -> m a) -> m a
fromAttributes AttributeLocation
FieldAttribute (Field Low -> Attributes FieldAttributes Low
forall r. Field r -> Attributes FieldAttributes r
fAttributes Field Low
field)
((Attribute High -> m (Endo (FieldAttributes High)))
-> m (FieldAttributes High))
-> (Attribute High -> m (Endo (FieldAttributes High)))
-> m (FieldAttributes High)
forall a b. (a -> b) -> a -> b
$ [AttributeCollector (FieldAttributes High)]
-> (Attribute High -> FieldAttributes High -> FieldAttributes High)
-> Attribute High
-> m (Endo (FieldAttributes High))
forall c (m :: * -> *).
EvolveM m =>
[AttributeCollector c]
-> (Attribute High -> c -> c) -> Attribute High -> m (Endo c)
collect
[ (ConstantValue High
-> FieldAttributes High -> FieldAttributes High)
-> AttributeCollector (FieldAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr (\ConstantValue High
e FieldAttributes High
a -> FieldAttributes High
a {faConstantValues :: [ConstantValue High]
faConstantValues = ConstantValue High
e ConstantValue High -> [ConstantValue High] -> [ConstantValue High]
forall a. a -> [a] -> [a]
: FieldAttributes High -> [ConstantValue High]
forall r. FieldAttributes r -> [ConstantValue r]
faConstantValues FieldAttributes High
a })
, (Signature High -> FieldAttributes High -> FieldAttributes High)
-> AttributeCollector (FieldAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr (\Signature High
e FieldAttributes High
a -> FieldAttributes High
a {faSignatures :: [Signature High]
faSignatures = Signature High
e Signature High -> [Signature High] -> [Signature High]
forall a. a -> [a] -> [a]
: FieldAttributes High -> [Signature High]
forall r. FieldAttributes r -> [Signature r]
faSignatures FieldAttributes High
a })
, (RuntimeVisibleAnnotations High
-> FieldAttributes High -> FieldAttributes High)
-> AttributeCollector (FieldAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr (\RuntimeVisibleAnnotations High
e FieldAttributes High
a -> FieldAttributes High
a {faVisibleAnnotations :: [RuntimeVisibleAnnotations High]
faVisibleAnnotations = RuntimeVisibleAnnotations High
e RuntimeVisibleAnnotations High
-> [RuntimeVisibleAnnotations High]
-> [RuntimeVisibleAnnotations High]
forall a. a -> [a] -> [a]
: FieldAttributes High -> [RuntimeVisibleAnnotations High]
forall r. FieldAttributes r -> [RuntimeVisibleAnnotations r]
faVisibleAnnotations FieldAttributes High
a })
, (RuntimeInvisibleAnnotations High
-> FieldAttributes High -> FieldAttributes High)
-> AttributeCollector (FieldAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr (\RuntimeInvisibleAnnotations High
e FieldAttributes High
a -> FieldAttributes High
a {faInvisibleAnnotations :: [RuntimeInvisibleAnnotations High]
faInvisibleAnnotations = RuntimeInvisibleAnnotations High
e RuntimeInvisibleAnnotations High
-> [RuntimeInvisibleAnnotations High]
-> [RuntimeInvisibleAnnotations High]
forall a. a -> [a] -> [a]
: FieldAttributes High -> [RuntimeInvisibleAnnotations High]
forall r. FieldAttributes r -> [RuntimeInvisibleAnnotations r]
faInvisibleAnnotations FieldAttributes High
a })
, (RuntimeVisibleTypeAnnotations FieldTypeAnnotation High
-> FieldAttributes High -> FieldAttributes High)
-> AttributeCollector (FieldAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr (\RuntimeVisibleTypeAnnotations FieldTypeAnnotation High
e FieldAttributes High
a -> FieldAttributes High
a {faVisibleTypeAnnotations :: [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
faVisibleTypeAnnotations = RuntimeVisibleTypeAnnotations FieldTypeAnnotation High
e RuntimeVisibleTypeAnnotations FieldTypeAnnotation High
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
forall a. a -> [a] -> [a]
: FieldAttributes High
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
forall r.
FieldAttributes r
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation r]
faVisibleTypeAnnotations FieldAttributes High
a })
, (RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High
-> FieldAttributes High -> FieldAttributes High)
-> AttributeCollector (FieldAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr (\RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High
e FieldAttributes High
a -> FieldAttributes High
a {faInvisibleTypeAnnotations :: [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
faInvisibleTypeAnnotations = RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High
e RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
forall a. a -> [a] -> [a]
: FieldAttributes High
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
forall r.
FieldAttributes r
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation r]
faInvisibleTypeAnnotations FieldAttributes High
a })
] (\Attribute High
e FieldAttributes High
a -> FieldAttributes High
a { faOthers :: [Attribute High]
faOthers = Attribute High
e Attribute High -> [Attribute High] -> [Attribute High]
forall a. a -> [a] -> [a]
: FieldAttributes High -> [Attribute High]
forall r. FieldAttributes r -> [Attribute r]
faOthers FieldAttributes High
a })
Field High -> m (Field High)
forall (m :: * -> *) a. Monad m => a -> m a
return (Field High -> m (Field High)) -> Field High -> m (Field High)
forall a b. (a -> b) -> a -> b
$ BitSet16 FAccessFlag
-> Ref Text High
-> Ref FieldDescriptor High
-> Attributes FieldAttributes High
-> Field High
forall r.
BitSet16 FAccessFlag
-> Ref Text r
-> Ref FieldDescriptor r
-> Attributes FieldAttributes r
-> Field r
Field (Field Low -> BitSet16 FAccessFlag
forall r. Field r -> BitSet16 FAccessFlag
fAccessFlags' Field Low
field) Text
Ref Text High
fi Ref FieldDescriptor High
FieldDescriptor
fd Attributes FieldAttributes High
FieldAttributes High
fattr
devolve :: Field High -> m (Field Low)
devolve Field High
field = do
Index
fi <- Text -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink (Field High -> Ref Text High
forall r. Field r -> Ref Text r
fName Field High
field)
Index
fd <- FieldDescriptor -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink (Field High -> Ref FieldDescriptor High
forall r. Field r -> Ref FieldDescriptor r
fDescriptor Field High
field)
[Attribute Low]
fattr <- FieldAttributes High -> m [Attribute Low]
forall (f :: * -> *).
DevolveM f =>
FieldAttributes High -> f [Attribute Low]
fromFieldAttributes (Field High -> Attributes FieldAttributes High
forall r. Field r -> Attributes FieldAttributes r
fAttributes Field High
field)
Field Low -> m (Field Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (Field Low -> m (Field Low)) -> Field Low -> m (Field Low)
forall a b. (a -> b) -> a -> b
$ BitSet16 FAccessFlag
-> Ref Text Low
-> Ref FieldDescriptor Low
-> Attributes FieldAttributes Low
-> Field Low
forall r.
BitSet16 FAccessFlag
-> Ref Text r
-> Ref FieldDescriptor r
-> Attributes FieldAttributes r
-> Field r
Field (Field High -> BitSet16 FAccessFlag
forall r. Field r -> BitSet16 FAccessFlag
fAccessFlags' Field High
field) Index
Ref Text Low
fi Index
Ref FieldDescriptor Low
fd ([Attribute Low] -> SizedList Index (Attribute Low)
forall w a. [a] -> SizedList w a
SizedList [Attribute Low]
fattr)
where
fromFieldAttributes :: FieldAttributes High -> f [Attribute Low]
fromFieldAttributes (FieldAttributes {[Attribute High]
[Signature High]
[ConstantValue High]
[RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
[RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
[RuntimeInvisibleAnnotations High]
[RuntimeVisibleAnnotations High]
faOthers :: [Attribute High]
faInvisibleTypeAnnotations :: [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
faVisibleTypeAnnotations :: [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
faInvisibleAnnotations :: [RuntimeInvisibleAnnotations High]
faVisibleAnnotations :: [RuntimeVisibleAnnotations High]
faSignatures :: [Signature High]
faConstantValues :: [ConstantValue High]
faOthers :: forall r. FieldAttributes r -> [Attribute r]
faInvisibleTypeAnnotations :: forall r.
FieldAttributes r
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation r]
faVisibleTypeAnnotations :: forall r.
FieldAttributes r
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation r]
faInvisibleAnnotations :: forall r. FieldAttributes r -> [RuntimeInvisibleAnnotations r]
faVisibleAnnotations :: forall r. FieldAttributes r -> [RuntimeVisibleAnnotations r]
faSignatures :: forall r. FieldAttributes r -> [Signature r]
faConstantValues :: forall r. FieldAttributes r -> [ConstantValue r]
..}) =
[[Attribute Low]] -> [Attribute Low]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attribute Low]] -> [Attribute Low])
-> f [[Attribute Low]] -> f [Attribute Low]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f [Attribute Low]] -> f [[Attribute Low]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ (ConstantValue High -> f (Attribute Low))
-> [ConstantValue High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ConstantValue High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [ConstantValue High]
faConstantValues
, (Signature High -> f (Attribute Low))
-> [Signature High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Signature High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [Signature High]
faSignatures
, (RuntimeVisibleAnnotations High -> f (Attribute Low))
-> [RuntimeVisibleAnnotations High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeVisibleAnnotations High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeVisibleAnnotations High]
faVisibleAnnotations
, (RuntimeInvisibleAnnotations High -> f (Attribute Low))
-> [RuntimeInvisibleAnnotations High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeInvisibleAnnotations High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeInvisibleAnnotations High]
faInvisibleAnnotations
, (RuntimeVisibleTypeAnnotations FieldTypeAnnotation High
-> f (Attribute Low))
-> [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
-> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeVisibleTypeAnnotations FieldTypeAnnotation High
-> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeVisibleTypeAnnotations FieldTypeAnnotation High]
faVisibleTypeAnnotations
, (RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High
-> f (Attribute Low))
-> [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
-> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High
-> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeInvisibleTypeAnnotations FieldTypeAnnotation High]
faInvisibleTypeAnnotations
, (Attribute High -> f (Attribute Low))
-> [Attribute High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Attribute High -> f (Attribute Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve [Attribute High]
faOthers
]
$(deriveBase ''FieldAttributes)
$(deriveBaseWithBinary ''Field)