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

Based on the InnerClasses Attribute,
as documented [here](http://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.6).
-}

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

-- | 'InnerClasses' is an Attribute.
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"

-- | The 'InnerClasses' is a reference to the enclosing method of the class
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)