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

The class file is described in this module.
-}
module Language.JVM.ClassFile
  ( ClassFile (..)
  , cAccessFlags
  , cFields
  , cMethods
  , cSignature
  , cEnclosingMethod
  , cInnerClasses

  -- * Attributes
  , ClassAttributes (..)
  , emptyClassAttributes
  , cBootstrapMethods
  ) where

import           Data.Binary
import           Data.Monoid
import           Data.Set

import           Language.JVM.AccessFlag
import           Language.JVM.Attribute
import           Language.JVM.Attribute.BootstrapMethods
import           Language.JVM.Attribute.EnclosingMethod
import           Language.JVM.Attribute.InnerClasses
-- import           Language.JVM.Attribute.Signature
import           Language.JVM.Constant
import           Language.JVM.ConstantPool               as CP
import           Language.JVM.Field                      (Field)
import           Language.JVM.Method                     (Method)
import           Language.JVM.Staged
import           Language.JVM.Utils

-- | A 'ClassFile' as described
-- [here](http://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html).

data ClassFile r = ClassFile
  { ClassFile r -> Word32
cMagicNumber  :: !Word32

  , ClassFile r -> Word16
cMinorVersion :: !Word16
  , ClassFile r -> Word16
cMajorVersion :: !Word16

  , ClassFile r -> Choice (ConstantPool r) () r
cConstantPool :: !(Choice (ConstantPool r) () r)

  , ClassFile r -> BitSet16 CAccessFlag
cAccessFlags' :: !(BitSet16 CAccessFlag)

  , ClassFile r -> Ref ClassName r
cThisClass    :: !(Ref ClassName r)
  , ClassFile r -> Ref ClassName r
cSuperClass   :: !(Ref ClassName r)

  , ClassFile r -> SizedList16 (Ref ClassName r)
cInterfaces   :: !(SizedList16 (Ref ClassName r))
  , ClassFile r -> SizedList16 (Field r)
cFields'      :: !(SizedList16 (Field r))
  , ClassFile r -> SizedList16 (Method r)
cMethods'     :: !(SizedList16 (Method r))
  , ClassFile r -> Attributes ClassAttributes r
cAttributes   :: !(Attributes ClassAttributes r)
  }

-- | Get the set of access flags
cAccessFlags :: ClassFile r -> Set CAccessFlag
cAccessFlags :: ClassFile r -> Set CAccessFlag
cAccessFlags = BitSet16 CAccessFlag -> Set CAccessFlag
forall w a. BitSet w a -> Set a
toSet (BitSet16 CAccessFlag -> Set CAccessFlag)
-> (ClassFile r -> BitSet16 CAccessFlag)
-> ClassFile r
-> Set CAccessFlag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile r -> BitSet16 CAccessFlag
forall r. ClassFile r -> BitSet16 CAccessFlag
cAccessFlags'

-- | Get a list of 'Field's of a ClassFile.
cFields :: ClassFile r -> [Field r]
cFields :: ClassFile r -> [Field r]
cFields = SizedList Word16 (Field r) -> [Field r]
forall w a. SizedList w a -> [a]
unSizedList (SizedList Word16 (Field r) -> [Field r])
-> (ClassFile r -> SizedList Word16 (Field r))
-> ClassFile r
-> [Field r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile r -> SizedList Word16 (Field r)
forall r. ClassFile r -> SizedList16 (Field r)
cFields'

-- | Get a list of 'Method's of a ClassFile.
cMethods :: ClassFile r -> [Method r]
cMethods :: ClassFile r -> [Method r]
cMethods = SizedList Word16 (Method r) -> [Method r]
forall w a. SizedList w a -> [a]
unSizedList (SizedList Word16 (Method r) -> [Method r])
-> (ClassFile r -> SizedList Word16 (Method r))
-> ClassFile r
-> [Method r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile r -> SizedList Word16 (Method r)
forall r. ClassFile r -> SizedList16 (Method r)
cMethods'


-- | Fetch the 'BootstrapMethods' attribute.
-- There can only one bootstrap methods per class, but there might not be
-- one.
cBootstrapMethods' :: ClassFile High -> Maybe (BootstrapMethods High)
cBootstrapMethods' :: ClassFile High -> Maybe (BootstrapMethods High)
cBootstrapMethods' =
  [BootstrapMethods High] -> Maybe (BootstrapMethods High)
forall a. [a] -> Maybe a
firstOne ([BootstrapMethods High] -> Maybe (BootstrapMethods High))
-> (ClassFile High -> [BootstrapMethods High])
-> ClassFile High
-> Maybe (BootstrapMethods High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassAttributes High -> [BootstrapMethods High]
forall r. ClassAttributes r -> [BootstrapMethods r]
caBootstrapMethods (ClassAttributes High -> [BootstrapMethods High])
-> (ClassFile High -> ClassAttributes High)
-> ClassFile High
-> [BootstrapMethods High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile High -> ClassAttributes High
forall r. ClassFile r -> Attributes ClassAttributes r
cAttributes

cBootstrapMethods :: ClassFile High -> [BootstrapMethod High]
cBootstrapMethods :: ClassFile High -> [BootstrapMethod High]
cBootstrapMethods =
  [BootstrapMethod High]
-> (BootstrapMethods High -> [BootstrapMethod High])
-> Maybe (BootstrapMethods High)
-> [BootstrapMethod High]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] BootstrapMethods High -> [BootstrapMethod High]
forall r. BootstrapMethods r -> [BootstrapMethod r]
methods (Maybe (BootstrapMethods High) -> [BootstrapMethod High])
-> (ClassFile High -> Maybe (BootstrapMethods High))
-> ClassFile High
-> [BootstrapMethod High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile High -> Maybe (BootstrapMethods High)
cBootstrapMethods'

cSignature :: ClassFile High -> Maybe (Signature High)
cSignature :: ClassFile High -> Maybe (Signature High)
cSignature =
  [Signature High] -> Maybe (Signature High)
forall a. [a] -> Maybe a
firstOne ([Signature High] -> Maybe (Signature High))
-> (ClassFile High -> [Signature High])
-> ClassFile High
-> Maybe (Signature High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassAttributes High -> [Signature High]
forall r. ClassAttributes r -> [Signature r]
caSignature (ClassAttributes High -> [Signature High])
-> (ClassFile High -> ClassAttributes High)
-> ClassFile High
-> [Signature High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile High -> ClassAttributes High
forall r. ClassFile r -> Attributes ClassAttributes r
cAttributes

cEnclosingMethod :: ClassFile High -> Maybe (EnclosingMethod High)
cEnclosingMethod :: ClassFile High -> Maybe (EnclosingMethod High)
cEnclosingMethod =
  [EnclosingMethod High] -> Maybe (EnclosingMethod High)
forall a. [a] -> Maybe a
firstOne ([EnclosingMethod High] -> Maybe (EnclosingMethod High))
-> (ClassFile High -> [EnclosingMethod High])
-> ClassFile High
-> Maybe (EnclosingMethod High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassAttributes High -> [EnclosingMethod High]
forall r. ClassAttributes r -> [EnclosingMethod r]
caEnclosingMethod (ClassAttributes High -> [EnclosingMethod High])
-> (ClassFile High -> ClassAttributes High)
-> ClassFile High
-> [EnclosingMethod High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile High -> ClassAttributes High
forall r. ClassFile r -> Attributes ClassAttributes r
cAttributes

cInnerClasses' :: ClassFile High -> Maybe (InnerClasses High)
cInnerClasses' :: ClassFile High -> Maybe (InnerClasses High)
cInnerClasses' =
  [InnerClasses High] -> Maybe (InnerClasses High)
forall a. [a] -> Maybe a
firstOne ([InnerClasses High] -> Maybe (InnerClasses High))
-> (ClassFile High -> [InnerClasses High])
-> ClassFile High
-> Maybe (InnerClasses High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassAttributes High -> [InnerClasses High]
forall r. ClassAttributes r -> [InnerClasses r]
caInnerClasses (ClassAttributes High -> [InnerClasses High])
-> (ClassFile High -> ClassAttributes High)
-> ClassFile High
-> [InnerClasses High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile High -> ClassAttributes High
forall r. ClassFile r -> Attributes ClassAttributes r
cAttributes

cInnerClasses :: ClassFile High -> [InnerClass High]
cInnerClasses :: ClassFile High -> [InnerClass High]
cInnerClasses =
  [InnerClass High]
-> (InnerClasses High -> [InnerClass High])
-> Maybe (InnerClasses High)
-> [InnerClass High]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] InnerClasses High -> [InnerClass High]
forall r.
InnerClasses r
-> Choice (SizedList16 (InnerClass Low)) [InnerClass High] r
innerClasses (Maybe (InnerClasses High) -> [InnerClass High])
-> (ClassFile High -> Maybe (InnerClasses High))
-> ClassFile High
-> [InnerClass High]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassFile High -> Maybe (InnerClasses High)
cInnerClasses'

data ClassAttributes r = ClassAttributes
  { ClassAttributes r -> [BootstrapMethods r]
caBootstrapMethods     :: [ BootstrapMethods r]
  , ClassAttributes r -> [Signature r]
caSignature            :: [ Signature r ]
  , ClassAttributes r -> [EnclosingMethod r]
caEnclosingMethod      :: [ EnclosingMethod r ]
  , ClassAttributes r -> [InnerClasses r]
caInnerClasses         :: [ InnerClasses r ]
  , ClassAttributes r -> [RuntimeVisibleAnnotations r]
caVisibleAnnotations   :: [ RuntimeVisibleAnnotations r ]
  , ClassAttributes r -> [RuntimeInvisibleAnnotations r]
caInvisibleAnnotations :: [ RuntimeInvisibleAnnotations r ]
  , ClassAttributes r
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation r]
caVisibleTypeAnnotations   ::
      [ RuntimeVisibleTypeAnnotations ClassTypeAnnotation r ]
  , ClassAttributes r
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation r]
caInvisibleTypeAnnotations ::
      [ RuntimeInvisibleTypeAnnotations ClassTypeAnnotation r ]
  , ClassAttributes r -> [Attribute r]
caOthers               :: [ Attribute r ]
  }

emptyClassAttributes :: ClassAttributes High
emptyClassAttributes :: ClassAttributes High
emptyClassAttributes =
  [BootstrapMethods High]
-> [Signature High]
-> [EnclosingMethod High]
-> [InnerClasses High]
-> [RuntimeVisibleAnnotations High]
-> [RuntimeInvisibleAnnotations High]
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
-> [Attribute High]
-> ClassAttributes High
forall r.
[BootstrapMethods r]
-> [Signature r]
-> [EnclosingMethod r]
-> [InnerClasses r]
-> [RuntimeVisibleAnnotations r]
-> [RuntimeInvisibleAnnotations r]
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation r]
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation r]
-> [Attribute r]
-> ClassAttributes r
ClassAttributes [] [] [] [] [] [] [] [] []

instance Staged ClassFile where
  evolve :: ClassFile Low -> m (ClassFile High)
evolve ClassFile Low
cf = String -> m (ClassFile High) -> m (ClassFile High)
forall (m :: * -> *) a. LabelM m => String -> m a -> m a
label String
"ClassFile" (m (ClassFile High) -> m (ClassFile High))
-> m (ClassFile High) -> m (ClassFile High)
forall a b. (a -> b) -> a -> b
$ do
    ClassName
tci' <- Word16 -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Word16 -> m r
link (ClassFile Low -> Ref ClassName Low
forall r. ClassFile r -> Ref ClassName r
cThisClass ClassFile Low
cf)
    ClassName
sci' <-
      if ClassName
tci' ClassName -> ClassName -> Bool
forall a. Eq a => a -> a -> Bool
/= ClassName
"java/lang/Object"
      then do
        Word16 -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Word16 -> m r
link (ClassFile Low -> Ref ClassName Low
forall r. ClassFile r -> Ref ClassName r
cSuperClass ClassFile Low
cf)
      else do
        ClassName -> m ClassName
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassName -> m ClassName) -> ClassName -> m ClassName
forall a b. (a -> b) -> a -> b
$ ClassName
"java/lang/Object"
    SizedList Word16 ClassName
cii' <- (Word16 -> m ClassName)
-> SizedList Word16 Word16 -> m (SizedList Word16 ClassName)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word16 -> m ClassName
forall (m :: * -> *) r.
(EvolveM m, Referenceable r) =>
Word16 -> m r
link (SizedList Word16 Word16 -> m (SizedList Word16 ClassName))
-> SizedList Word16 Word16 -> m (SizedList Word16 ClassName)
forall a b. (a -> b) -> a -> b
$ ClassFile Low -> SizedList16 (Ref ClassName Low)
forall r. ClassFile r -> SizedList16 (Ref ClassName r)
cInterfaces ClassFile Low
cf
    SizedList Word16 (Field High)
cf' <- (Field Low -> m (Field High))
-> SizedList Word16 (Field Low)
-> m (SizedList Word16 (Field High))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Field Low -> m (Field High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve (SizedList Word16 (Field Low) -> m (SizedList Word16 (Field High)))
-> SizedList Word16 (Field Low)
-> m (SizedList Word16 (Field High))
forall a b. (a -> b) -> a -> b
$ ClassFile Low -> SizedList Word16 (Field Low)
forall r. ClassFile r -> SizedList16 (Field r)
cFields' ClassFile Low
cf
    SizedList Word16 (Method High)
cm' <- (Method Low -> m (Method High))
-> SizedList Word16 (Method Low)
-> m (SizedList Word16 (Method High))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Method Low -> m (Method High)
forall (s :: * -> *) (m :: * -> *).
(Staged s, EvolveM m) =>
s Low -> m (s High)
evolve (SizedList Word16 (Method Low)
 -> m (SizedList Word16 (Method High)))
-> SizedList Word16 (Method Low)
-> m (SizedList Word16 (Method High))
forall a b. (a -> b) -> a -> b
$ ClassFile Low -> SizedList Word16 (Method Low)
forall r. ClassFile r -> SizedList16 (Method r)
cMethods' ClassFile Low
cf
    ClassAttributes High
ca' <- (Endo (ClassAttributes High) -> ClassAttributes High)
-> m (Endo (ClassAttributes High)) -> m (ClassAttributes High)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Endo (ClassAttributes High)
-> ClassAttributes High -> ClassAttributes High
forall a. Endo a -> a -> a
`appEndo` ClassAttributes High
emptyClassAttributes) (m (Endo (ClassAttributes High)) -> m (ClassAttributes High))
-> ((Attribute High -> m (Endo (ClassAttributes High)))
    -> m (Endo (ClassAttributes High)))
-> (Attribute High -> m (Endo (ClassAttributes High)))
-> m (ClassAttributes High)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeLocation
-> SizedList Word16 (Attribute Low)
-> (Attribute High -> m (Endo (ClassAttributes High)))
-> m (Endo (ClassAttributes High))
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, EvolveM m, Monoid a) =>
AttributeLocation
-> f (Attribute Low) -> (Attribute High -> m a) -> m a
fromAttributes AttributeLocation
ClassAttribute (ClassFile Low -> Attributes ClassAttributes Low
forall r. ClassFile r -> Attributes ClassAttributes r
cAttributes ClassFile Low
cf)
      ((Attribute High -> m (Endo (ClassAttributes High)))
 -> m (ClassAttributes High))
-> (Attribute High -> m (Endo (ClassAttributes High)))
-> m (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ [AttributeCollector (ClassAttributes High)]
-> (Attribute High -> ClassAttributes High -> ClassAttributes High)
-> Attribute High
-> m (Endo (ClassAttributes High))
forall c (m :: * -> *).
EvolveM m =>
[AttributeCollector c]
-> (Attribute High -> c -> c) -> Attribute High -> m (Endo c)
collect
      [ (Signature High -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((Signature High -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (Signature High -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \Signature High
e ClassAttributes High
ca -> ClassAttributes High
ca {caSignature :: [Signature High]
caSignature = Signature High
e Signature High -> [Signature High] -> [Signature High]
forall a. a -> [a] -> [a]
: ClassAttributes High -> [Signature High]
forall r. ClassAttributes r -> [Signature r]
caSignature ClassAttributes High
ca}
      , (EnclosingMethod High
 -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((EnclosingMethod High
  -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (EnclosingMethod High
    -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \EnclosingMethod High
e ClassAttributes High
ca -> ClassAttributes High
ca {caEnclosingMethod :: [EnclosingMethod High]
caEnclosingMethod = EnclosingMethod High
e EnclosingMethod High
-> [EnclosingMethod High] -> [EnclosingMethod High]
forall a. a -> [a] -> [a]
: ClassAttributes High -> [EnclosingMethod High]
forall r. ClassAttributes r -> [EnclosingMethod r]
caEnclosingMethod ClassAttributes High
ca}
      , (BootstrapMethods High
 -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((BootstrapMethods High
  -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (BootstrapMethods High
    -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \BootstrapMethods High
e ClassAttributes High
ca -> ClassAttributes High
ca {caBootstrapMethods :: [BootstrapMethods High]
caBootstrapMethods = BootstrapMethods High
e BootstrapMethods High
-> [BootstrapMethods High] -> [BootstrapMethods High]
forall a. a -> [a] -> [a]
: ClassAttributes High -> [BootstrapMethods High]
forall r. ClassAttributes r -> [BootstrapMethods r]
caBootstrapMethods ClassAttributes High
ca}
      , (RuntimeVisibleAnnotations High
 -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((RuntimeVisibleAnnotations High
  -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (RuntimeVisibleAnnotations High
    -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \RuntimeVisibleAnnotations High
e ClassAttributes High
ca -> ClassAttributes High
ca {caVisibleAnnotations :: [RuntimeVisibleAnnotations High]
caVisibleAnnotations = RuntimeVisibleAnnotations High
e RuntimeVisibleAnnotations High
-> [RuntimeVisibleAnnotations High]
-> [RuntimeVisibleAnnotations High]
forall a. a -> [a] -> [a]
: ClassAttributes High -> [RuntimeVisibleAnnotations High]
forall r. ClassAttributes r -> [RuntimeVisibleAnnotations r]
caVisibleAnnotations ClassAttributes High
ca}
      , (RuntimeInvisibleAnnotations High
 -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((RuntimeInvisibleAnnotations High
  -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (RuntimeInvisibleAnnotations High
    -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \RuntimeInvisibleAnnotations High
e ClassAttributes High
ca -> ClassAttributes High
ca {caInvisibleAnnotations :: [RuntimeInvisibleAnnotations High]
caInvisibleAnnotations = RuntimeInvisibleAnnotations High
e RuntimeInvisibleAnnotations High
-> [RuntimeInvisibleAnnotations High]
-> [RuntimeInvisibleAnnotations High]
forall a. a -> [a] -> [a]
: ClassAttributes High -> [RuntimeInvisibleAnnotations High]
forall r. ClassAttributes r -> [RuntimeInvisibleAnnotations r]
caInvisibleAnnotations ClassAttributes High
ca}
      , (RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
 -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
  -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
    -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
e ClassAttributes High
ca -> ClassAttributes High
ca {caVisibleTypeAnnotations :: [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
caVisibleTypeAnnotations = RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
e RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
forall a. a -> [a] -> [a]
: ClassAttributes High
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
forall r.
ClassAttributes r
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation r]
caVisibleTypeAnnotations ClassAttributes High
ca}
      , (RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
 -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
  -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
    -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
e ClassAttributes High
ca -> ClassAttributes High
ca {caInvisibleTypeAnnotations :: [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
caInvisibleTypeAnnotations = RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
e RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
forall a. a -> [a] -> [a]
: ClassAttributes High
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
forall r.
ClassAttributes r
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation r]
caInvisibleTypeAnnotations ClassAttributes High
ca}
      , (InnerClasses High -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall c (a :: * -> *).
(IsAttribute (a Low), Staged a) =>
(a High -> c -> c) -> AttributeCollector c
Attr ((InnerClasses High
  -> ClassAttributes High -> ClassAttributes High)
 -> AttributeCollector (ClassAttributes High))
-> (InnerClasses High
    -> ClassAttributes High -> ClassAttributes High)
-> AttributeCollector (ClassAttributes High)
forall a b. (a -> b) -> a -> b
$ \InnerClasses High
e ClassAttributes High
ca -> ClassAttributes High
ca {caInnerClasses :: [InnerClasses High]
caInnerClasses = InnerClasses High
e InnerClasses High -> [InnerClasses High] -> [InnerClasses High]
forall a. a -> [a] -> [a]
: ClassAttributes High -> [InnerClasses High]
forall r. ClassAttributes r -> [InnerClasses r]
caInnerClasses ClassAttributes High
ca}
      ]
      (\Attribute High
e ClassAttributes High
ca -> ClassAttributes High
ca {caOthers :: [Attribute High]
caOthers = Attribute High
e Attribute High -> [Attribute High] -> [Attribute High]
forall a. a -> [a] -> [a]
: ClassAttributes High -> [Attribute High]
forall r. ClassAttributes r -> [Attribute r]
caOthers ClassAttributes High
ca})
    ClassFile High -> m (ClassFile High)
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassFile High -> m (ClassFile High))
-> ClassFile High -> m (ClassFile High)
forall a b. (a -> b) -> a -> b
$ ClassFile Low
cf
      { cConstantPool :: Choice (ConstantPool High) () High
cConstantPool = ()
      , cThisClass :: Ref ClassName High
cThisClass = Ref ClassName High
ClassName
tci'
      , cSuperClass :: Ref ClassName High
cSuperClass = Ref ClassName High
ClassName
sci'
      , cInterfaces :: SizedList16 (Ref ClassName High)
cInterfaces = SizedList16 (Ref ClassName High)
SizedList Word16 ClassName
cii'
      , cFields' :: SizedList Word16 (Field High)
cFields'            = SizedList Word16 (Field High)
cf'
      , cMethods' :: SizedList Word16 (Method High)
cMethods'           = SizedList Word16 (Method High)
cm'
      , cAttributes :: Attributes ClassAttributes High
cAttributes         = Attributes ClassAttributes High
ClassAttributes High
ca'
      }

  devolve :: ClassFile High -> m (ClassFile Low)
devolve ClassFile High
cf = do
    Word16
tci' <- ClassName -> m Word16
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Word16
unlink (ClassFile High -> Ref ClassName High
forall r. ClassFile r -> Ref ClassName r
cThisClass ClassFile High
cf)
    Word16
sci' <-
      if ClassFile High -> Ref ClassName High
forall r. ClassFile r -> Ref ClassName r
cThisClass ClassFile High
cf ClassName -> ClassName -> Bool
forall a. Eq a => a -> a -> Bool
/= ClassName
"java/lang/Object" then
        ClassName -> m Word16
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Word16
unlink (ClassFile High -> Ref ClassName High
forall r. ClassFile r -> Ref ClassName r
cSuperClass ClassFile High
cf)
      else
        Word16 -> m Word16
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> m Word16) -> Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Word16
0
    SizedList Word16 Word16
cii' <- (ClassName -> m Word16)
-> SizedList Word16 ClassName -> m (SizedList Word16 Word16)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ClassName -> m Word16
forall (m :: * -> *) r.
(DevolveM m, Referenceable r) =>
r -> m Word16
unlink (SizedList Word16 ClassName -> m (SizedList Word16 Word16))
-> SizedList Word16 ClassName -> m (SizedList Word16 Word16)
forall a b. (a -> b) -> a -> b
$ ClassFile High -> SizedList16 (Ref ClassName High)
forall r. ClassFile r -> SizedList16 (Ref ClassName r)
cInterfaces ClassFile High
cf
    SizedList Word16 (Field Low)
cf' <- (Field High -> m (Field Low))
-> SizedList Word16 (Field High)
-> m (SizedList Word16 (Field Low))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Field High -> m (Field Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve (SizedList Word16 (Field High) -> m (SizedList Word16 (Field Low)))
-> SizedList Word16 (Field High)
-> m (SizedList Word16 (Field Low))
forall a b. (a -> b) -> a -> b
$ ClassFile High -> SizedList Word16 (Field High)
forall r. ClassFile r -> SizedList16 (Field r)
cFields' ClassFile High
cf
    SizedList Word16 (Method Low)
cm' <- (Method High -> m (Method Low))
-> SizedList Word16 (Method High)
-> m (SizedList Word16 (Method Low))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Method High -> m (Method Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve (SizedList Word16 (Method High)
 -> m (SizedList Word16 (Method Low)))
-> SizedList Word16 (Method High)
-> m (SizedList Word16 (Method Low))
forall a b. (a -> b) -> a -> b
$ ClassFile High -> SizedList Word16 (Method High)
forall r. ClassFile r -> SizedList16 (Method r)
cMethods' ClassFile High
cf
    [Attribute Low]
ca' <- ClassAttributes High -> m [Attribute Low]
forall (f :: * -> *).
DevolveM f =>
ClassAttributes High -> f [Attribute Low]
fromClassAttributes (ClassAttributes High -> m [Attribute Low])
-> ClassAttributes High -> m [Attribute Low]
forall a b. (a -> b) -> a -> b
$ ClassFile High -> Attributes ClassAttributes High
forall r. ClassFile r -> Attributes ClassAttributes r
cAttributes ClassFile High
cf
    ClassFile Low -> m (ClassFile Low)
forall (m :: * -> *) a. Monad m => a -> m a
return (ClassFile Low -> m (ClassFile Low))
-> ClassFile Low -> m (ClassFile Low)
forall a b. (a -> b) -> a -> b
$ ClassFile High
cf
      { cConstantPool :: Choice (ConstantPool Low) () Low
cConstantPool       = Choice (ConstantPool Low) () Low
forall r. ConstantPool r
CP.empty
      -- We cannot yet set the constant pool
      , cThisClass :: Ref ClassName Low
cThisClass = Word16
Ref ClassName Low
tci'
      , cSuperClass :: Ref ClassName Low
cSuperClass = Word16
Ref ClassName Low
sci'
      , cInterfaces :: SizedList16 (Ref ClassName Low)
cInterfaces  = SizedList Word16 Word16
SizedList16 (Ref ClassName Low)
cii'
      , cFields' :: SizedList Word16 (Field Low)
cFields'            = SizedList Word16 (Field Low)
cf'
      , cMethods' :: SizedList Word16 (Method Low)
cMethods'           = SizedList Word16 (Method Low)
cm'
      , cAttributes :: Attributes ClassAttributes Low
cAttributes         = [Attribute Low] -> SizedList Word16 (Attribute Low)
forall w a. [a] -> SizedList w a
SizedList [Attribute Low]
ca'
      }
    where
      fromClassAttributes :: ClassAttributes High -> f [Attribute Low]
fromClassAttributes (ClassAttributes {[Attribute High]
[Signature High]
[EnclosingMethod High]
[BootstrapMethods High]
[RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
[RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
[RuntimeInvisibleAnnotations High]
[RuntimeVisibleAnnotations High]
[InnerClasses High]
caOthers :: [Attribute High]
caInvisibleTypeAnnotations :: [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
caVisibleTypeAnnotations :: [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
caInvisibleAnnotations :: [RuntimeInvisibleAnnotations High]
caVisibleAnnotations :: [RuntimeVisibleAnnotations High]
caInnerClasses :: [InnerClasses High]
caEnclosingMethod :: [EnclosingMethod High]
caSignature :: [Signature High]
caBootstrapMethods :: [BootstrapMethods High]
caOthers :: forall r. ClassAttributes r -> [Attribute r]
caInvisibleTypeAnnotations :: forall r.
ClassAttributes r
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation r]
caVisibleTypeAnnotations :: forall r.
ClassAttributes r
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation r]
caInvisibleAnnotations :: forall r. ClassAttributes r -> [RuntimeInvisibleAnnotations r]
caVisibleAnnotations :: forall r. ClassAttributes r -> [RuntimeVisibleAnnotations r]
caInnerClasses :: forall r. ClassAttributes r -> [InnerClasses r]
caEnclosingMethod :: forall r. ClassAttributes r -> [EnclosingMethod r]
caSignature :: forall r. ClassAttributes r -> [Signature r]
caBootstrapMethods :: forall r. ClassAttributes r -> [BootstrapMethods r]
..}) = do
        [[Attribute Low]] -> [Attribute Low]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Attribute Low]] -> [Attribute Low])
-> f [[Attribute Low]] -> f [Attribute Low]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f [Attribute Low]] -> f [[Attribute Low]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
          [ (BootstrapMethods High -> f (Attribute Low))
-> [BootstrapMethods High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM BootstrapMethods High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [BootstrapMethods High]
caBootstrapMethods
          , (Signature High -> f (Attribute Low))
-> [Signature High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Signature High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [Signature High]
caSignature
          , (EnclosingMethod High -> f (Attribute Low))
-> [EnclosingMethod High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM EnclosingMethod High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [EnclosingMethod High]
caEnclosingMethod
          , (InnerClasses High -> f (Attribute Low))
-> [InnerClasses High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InnerClasses High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [InnerClasses High]
caInnerClasses
          , (RuntimeVisibleAnnotations High -> f (Attribute Low))
-> [RuntimeVisibleAnnotations High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeVisibleAnnotations High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeVisibleAnnotations High]
caVisibleAnnotations
          , (RuntimeInvisibleAnnotations High -> f (Attribute Low))
-> [RuntimeInvisibleAnnotations High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeInvisibleAnnotations High -> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeInvisibleAnnotations High]
caInvisibleAnnotations
          , (RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
 -> f (Attribute Low))
-> [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
-> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeVisibleTypeAnnotations ClassTypeAnnotation High
-> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeVisibleTypeAnnotations ClassTypeAnnotation High]
caVisibleTypeAnnotations
          , (RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
 -> f (Attribute Low))
-> [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
-> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High
-> f (Attribute Low)
forall (a :: * -> *) (m :: * -> *).
(IsAttribute (a Low), Staged a, DevolveM m) =>
a High -> m (Attribute Low)
toAttribute [RuntimeInvisibleTypeAnnotations ClassTypeAnnotation High]
caInvisibleTypeAnnotations
          , (Attribute High -> f (Attribute Low))
-> [Attribute High] -> f [Attribute Low]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Attribute High -> f (Attribute Low)
forall (s :: * -> *) (m :: * -> *).
(Staged s, DevolveM m) =>
s High -> m (s Low)
devolve [Attribute High]
caOthers
          ]

$(deriveBase ''ClassAttributes)
$(deriveBaseWithBinary ''ClassFile)