{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
module Language.JVM.Field
( Field (..)
, fAccessFlags
, fConstantValue
, fSignature
, FieldAttributes (..)
) 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
data Field r = Field
{ fAccessFlags' :: !(BitSet16 FAccessFlag)
, fName :: !(Ref Text.Text r)
, fDescriptor :: !(Ref FieldDescriptor r)
, fAttributes :: !(Attributes FieldAttributes r)
}
fAccessFlags :: Field r -> Set.Set FAccessFlag
fAccessFlags = toSet . fAccessFlags'
fConstantValue :: Field High -> Maybe (ConstantValue High)
fConstantValue =
firstOne . faConstantValues . fAttributes
fSignature :: Field High -> Maybe (Signature High)
fSignature =
firstOne . faSignatures . fAttributes
data FieldAttributes r = FieldAttributes
{ faConstantValues :: [ ConstantValue r ]
, faSignatures :: [ Signature r ]
, faOthers :: [ Attribute r ]
}
instance Staged Field where
evolve field = label "Field" $ do
fi <- link (fName field)
fd <- link (fDescriptor field)
fattr <- fromCollector <$> fromAttributes collect' (fAttributes field)
return $ Field (fAccessFlags' field) fi fd fattr
where
fromCollector (cv, sig, others) =
FieldAttributes (appEndo cv []) (appEndo sig []) (appEndo others [])
collect' attr =
collect (mempty, mempty, Endo(attr:)) attr
[ toC $ \x -> (Endo (x:), mempty, mempty)
, toC $ \x -> (mempty, Endo (x:), mempty) ]
devolve field = do
fi <- unlink (fName field)
fd <- unlink (fDescriptor field)
fattr <- fromFieldAttributes (fAttributes field)
return $ Field (fAccessFlags' field) fi fd (SizedList fattr)
where
fromFieldAttributes (FieldAttributes cvs fsg attr) =
(\a b c -> a ++ b ++ c)
<$> mapM toAttribute cvs
<*> mapM toAttribute fsg
<*> mapM devolve attr
$(deriveBase ''FieldAttributes)
$(deriveBaseWithBinary ''Field)