{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.JVM.Attribute.InnerClasses
( InnerClasses (..)
, InnerClass (..)
) where
import qualified Data.Text as Text
import Language.JVM.Attribute.Base
import Language.JVM.Constant
import Language.JVM.Utils
import Language.JVM.Staged
import Language.JVM.AccessFlag
instance IsAttribute (InnerClasses Low) where
attrName :: Const Text (InnerClasses Low)
attrName = Text -> Const Text (InnerClasses Low)
forall k a (b :: k). a -> Const a b
Const Text
"InnerClasses"
newtype InnerClasses r = InnerClasses
{ InnerClasses r
-> Choice (SizedList16 (InnerClass Low)) [InnerClass High] r
innerClasses :: Choice (SizedList16 (InnerClass Low)) [InnerClass High] r
}
data InnerClass r = InnerClass
{ InnerClass r -> Ref ClassName r
icClassName :: !(Ref ClassName r)
, InnerClass r -> Ref (Maybe ClassName) r
icOuterClassName :: !(Ref (Maybe ClassName) r)
, InnerClass r -> Ref (Maybe Text) r
icInnerName :: !(Ref (Maybe Text.Text) r)
, InnerClass r -> BitSet16 ICAccessFlag
icInnerAccessFlags :: !(BitSet16 ICAccessFlag)
}
instance Staged InnerClasses where
evolve :: InnerClasses Low -> m (InnerClasses High)
evolve (InnerClasses (SizedList r)) = [InnerClass High] -> InnerClasses High
forall r.
Choice (SizedList16 (InnerClass Low)) [InnerClass High] r
-> InnerClasses r
InnerClasses ([InnerClass High] -> InnerClasses High)
-> m [InnerClass High] -> m (InnerClasses High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InnerClass Low -> m (InnerClass High))
-> [InnerClass Low] -> m [InnerClass High]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InnerClass Low -> m (InnerClass High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve [InnerClass Low]
r
devolve :: InnerClasses High -> m (InnerClasses Low)
devolve (InnerClasses Choice (SizedList16 (InnerClass Low)) [InnerClass High] High
r) = SizedList16 (InnerClass Low) -> InnerClasses Low
forall r.
Choice (SizedList16 (InnerClass Low)) [InnerClass High] r
-> InnerClasses r
InnerClasses (SizedList16 (InnerClass Low) -> InnerClasses Low)
-> ([InnerClass Low] -> SizedList16 (InnerClass Low))
-> [InnerClass Low]
-> InnerClasses Low
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InnerClass Low] -> SizedList16 (InnerClass Low)
forall w a. [a] -> SizedList w a
SizedList ([InnerClass Low] -> InnerClasses Low)
-> m [InnerClass Low] -> m (InnerClasses Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (InnerClass High -> m (InnerClass Low))
-> [InnerClass High] -> m [InnerClass Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InnerClass High -> m (InnerClass Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve [InnerClass High]
Choice (SizedList16 (InnerClass Low)) [InnerClass High] High
r
instance Staged InnerClass where
evolve :: InnerClass Low -> m (InnerClass High)
evolve (InnerClass Ref ClassName Low
cn Ref (Maybe ClassName) Low
ocn Ref (Maybe Text) Low
inn BitSet16 ICAccessFlag
iac) = String -> m (InnerClass High) -> m (InnerClass High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InnerClass" (m (InnerClass High) -> m (InnerClass High))
-> m (InnerClass High) -> m (InnerClass High)
forall a b. (a -> b) -> a -> b
$ do
ClassName
-> Maybe ClassName
-> Maybe Text
-> BitSet16 ICAccessFlag
-> InnerClass High
forall r.
Ref ClassName r
-> Ref (Maybe ClassName) r
-> Ref (Maybe Text) r
-> BitSet16 ICAccessFlag
-> InnerClass r
InnerClass
(ClassName
-> Maybe ClassName
-> Maybe Text
-> BitSet16 ICAccessFlag
-> InnerClass High)
-> m ClassName
-> m (Maybe ClassName
-> Maybe Text -> BitSet16 ICAccessFlag -> InnerClass High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref ClassName Low
cn
m (Maybe ClassName
-> Maybe Text -> BitSet16 ICAccessFlag -> InnerClass High)
-> m (Maybe ClassName)
-> m (Maybe Text -> BitSet16 ICAccessFlag -> InnerClass High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (if Index
Ref (Maybe ClassName) Low
ocn Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== Index
0 then Maybe ClassName -> m (Maybe ClassName)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ClassName
forall a. Maybe a
Nothing else ClassName -> Maybe ClassName
forall a. a -> Maybe a
Just (ClassName -> Maybe ClassName)
-> m ClassName -> m (Maybe ClassName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref (Maybe ClassName) Low
ocn)
m (Maybe Text -> BitSet16 ICAccessFlag -> InnerClass High)
-> m (Maybe Text) -> m (BitSet16 ICAccessFlag -> InnerClass High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (if Index
Ref (Maybe Text) Low
inn Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== Index
0 then Maybe Text -> m (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> m Text -> m (Maybe Text)
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 (Maybe Text) Low
inn)
m (BitSet16 ICAccessFlag -> InnerClass High)
-> m (BitSet16 ICAccessFlag) -> m (InnerClass High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitSet16 ICAccessFlag -> m (BitSet16 ICAccessFlag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BitSet16 ICAccessFlag
iac
devolve :: InnerClass High -> m (InnerClass Low)
devolve (InnerClass Ref ClassName High
cn Ref (Maybe ClassName) High
mn Ref (Maybe Text) High
inn BitSet16 ICAccessFlag
iac) = String -> m (InnerClass Low) -> m (InnerClass Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"InnerClass" (m (InnerClass Low) -> m (InnerClass Low))
-> m (InnerClass Low) -> m (InnerClass Low)
forall a b. (a -> b) -> a -> b
$ do
Index -> Index -> Index -> BitSet16 ICAccessFlag -> InnerClass Low
forall r.
Ref ClassName r
-> Ref (Maybe ClassName) r
-> Ref (Maybe Text) r
-> BitSet16 ICAccessFlag
-> InnerClass r
InnerClass
(Index
-> Index -> Index -> BitSet16 ICAccessFlag -> InnerClass Low)
-> m Index
-> m (Index -> Index -> BitSet16 ICAccessFlag -> InnerClass Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClassName -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref ClassName High
ClassName
cn
m (Index -> Index -> BitSet16 ICAccessFlag -> InnerClass Low)
-> m Index -> m (Index -> BitSet16 ICAccessFlag -> InnerClass Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case Ref (Maybe ClassName) High
mn of
Ref (Maybe ClassName) High
Nothing -> Index -> m Index
forall (m :: * -> *) a. Monad m => a -> m a
return Index
0
Just mn' -> ClassName -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink ClassName
mn'
m (Index -> BitSet16 ICAccessFlag -> InnerClass Low)
-> m Index -> m (BitSet16 ICAccessFlag -> InnerClass Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case Ref (Maybe Text) High
inn of
Ref (Maybe Text) High
Nothing -> Index -> m Index
forall (m :: * -> *) a. Monad m => a -> m a
return Index
0
Just inn' -> Text -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Text
inn'
m (BitSet16 ICAccessFlag -> InnerClass Low)
-> m (BitSet16 ICAccessFlag) -> m (InnerClass Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BitSet16 ICAccessFlag -> m (BitSet16 ICAccessFlag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BitSet16 ICAccessFlag
iac
$(deriveBaseWithBinary ''InnerClasses)
$(deriveBaseWithBinary ''InnerClass)