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

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

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

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

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

-- | A constant value is just a index into the constant pool.
newtype ConstantValue r = ConstantValue
  { ConstantValue r -> Ref JValue r
constantValue :: Ref JValue r
  }

instance Staged ConstantValue where
  evolve :: ConstantValue Low -> m (ConstantValue High)
evolve (ConstantValue Ref JValue Low
r) = JValue -> ConstantValue High
forall r. Ref JValue r -> ConstantValue r
ConstantValue (JValue -> ConstantValue High)
-> m JValue -> m (ConstantValue High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index -> m JValue
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Index -> m r
link Index
Ref JValue Low
r
  devolve :: ConstantValue High -> m (ConstantValue Low)
devolve (ConstantValue Ref JValue High
r) = Index -> ConstantValue Low
forall r. Ref JValue r -> ConstantValue r
ConstantValue (Index -> ConstantValue Low) -> m Index -> m (ConstantValue Low)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JValue -> m Index
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Index
unlink Ref JValue High
JValue
r

$(deriveBaseWithBinary ''ConstantValue)