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

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

module Language.JVM.Attribute.EnclosingMethod
  ( EnclosingMethod (..)
  ) where

import           Language.JVM.Attribute.Base
import           Language.JVM.Constant
import           Language.JVM.Staged

-- | 'EnclosingMethod' is an Attribute.
instance IsAttribute (EnclosingMethod Low) where
  attrName :: Const Text (EnclosingMethod Low)
attrName = Text -> Const Text (EnclosingMethod Low)
forall k a (b :: k). a -> Const a b
Const Text
"EnclosingMethod"

-- | The 'EnclosingMethod' is a reference to the enclosing method of the class
data EnclosingMethod r = EnclosingMethod
  { EnclosingMethod r -> Ref ClassName r
enclosingClassName :: !(Ref ClassName r)
  , EnclosingMethod r -> Ref (Maybe MethodId) r
enclosingMethodName :: !(Ref (Maybe MethodId) r)
  }


instance Staged EnclosingMethod where
  evolve :: EnclosingMethod Low -> m (EnclosingMethod High)
evolve (EnclosingMethod Ref ClassName Low
cn Ref (Maybe MethodId) Low
mn) = String -> m (EnclosingMethod High) -> m (EnclosingMethod High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"EnclosingMethod" (m (EnclosingMethod High) -> m (EnclosingMethod High))
-> m (EnclosingMethod High) -> m (EnclosingMethod High)
forall a b. (a -> b) -> a -> b
$ do
    ClassName -> Maybe MethodId -> EnclosingMethod High
forall r.
Ref ClassName r -> Ref (Maybe MethodId) r -> EnclosingMethod r
EnclosingMethod
      (ClassName -> Maybe MethodId -> EnclosingMethod High)
-> m ClassName -> m (Maybe MethodId -> EnclosingMethod 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 MethodId -> EnclosingMethod High)
-> m (Maybe MethodId) -> m (EnclosingMethod High)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> if Index
Ref (Maybe MethodId) Low
mn Index -> Index -> Bool
forall a. Eq a => a -> a -> Bool
== Index
0 then Maybe MethodId -> m (Maybe MethodId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MethodId
forall a. Maybe a
Nothing else MethodId -> Maybe MethodId
forall a. a -> Maybe a
Just (MethodId -> Maybe MethodId) -> m MethodId -> m (Maybe MethodId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m MethodId
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref (Maybe MethodId) Low
mn

  devolve :: EnclosingMethod High -> m (EnclosingMethod Low)
devolve (EnclosingMethod Ref ClassName High
cn Ref (Maybe MethodId) High
mn) = String -> m (EnclosingMethod Low) -> m (EnclosingMethod Low)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"EnclosingMethod" (m (EnclosingMethod Low) -> m (EnclosingMethod Low))
-> m (EnclosingMethod Low) -> m (EnclosingMethod Low)
forall a b. (a -> b) -> a -> b
$ do
    Index -> Index -> EnclosingMethod Low
forall r.
Ref ClassName r -> Ref (Maybe MethodId) r -> EnclosingMethod r
EnclosingMethod
      (Index -> Index -> EnclosingMethod Low)
-> m Index -> m (Index -> EnclosingMethod 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 -> EnclosingMethod Low)
-> m Index -> m (EnclosingMethod Low)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> case Ref (Maybe MethodId) High
mn of
            Ref (Maybe MethodId) High
Nothing -> Index -> m Index
forall (m :: * -> *) a. Monad m => a -> m a
return Index
0
            Just mn' -> MethodId -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink MethodId
mn'

$(deriveBaseWithBinary ''EnclosingMethod)