feat: monad instance, some classfile constant-pool parsing

src/Data/Hex.hs

@@ -0,0 +1,10 @@
+{-# LANGUAGE InstanceSigs #-}
+module Data.Hex (Hex(..)) where
+import Numeric (showHex)
+
+newtype Hex a = Hex a
+
+instance Integral a => Show (Hex a) where
+  show :: Hex a -> String
+  show (Hex x) = "Hex 0x" ++ showHex x ""
+

src/Language/Java/Classfile.hs

@@ -1,6 +1,16 @@
-module Language.Java.Classfile () where
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DeriveGeneric #-}
+module Language.Java.Classfile (Classfile(..)) where
 import Language.Java.Classfile.Version (Version)
+import Language.Java.Classfile.Magic (Magic)
+import GHC.Generics (Generic, Generically(Generically))
+import Language.Java.Classfile.Extractable (Extractable)
+import Language.Java.Classfile.ConstantPool (ConstantPool)
 
 data Classfile = Classfile
-  { version :: Version
+  { magic :: Magic
+  , version :: Version
+  , constantPool :: ConstantPool
   }
+  deriving stock (Show, Generic)
+  deriving Extractable via Generically Classfile

src/Language/Java/Classfile/ConstantPool.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Language.Java.Classfile.ConstantPool (ConstantPool(..)) where
+import Data.Word (Word16)
+import Data.Array.IArray (Array)
+import Language.Java.Classfile.ConstantPool.Entry (Entry)
+import Language.Java.Classfile.Extractable (Extractable)
+
+newtype ConstantPool = ConstantPool (Array Word16 Entry)
+  deriving stock (Show)
+  deriving newtype Extractable

src/Language/Java/Classfile/ConstantPool/Entry.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Language.Java.Classfile.ConstantPool.Entry (Entry(..)) where
+import GHC.Generics (Generic, Generically(..))
+import Language.Java.Classfile.Extractable (Extractable)
+import Language.Java.Classfile.Extractable.WithTag (Word8Tag)
+import Language.Java.Classfile.ConstantPool.References (Utf8Reference, ClassReference, NameAndTypeReference)
+
+data Entry 
+  = Class (Word8Tag 7 Utf8Reference) -- name
+  | FieldRef (Word8Tag 9 (ClassReference, NameAndTypeReference))
+  deriving stock (Show, Generic)
+  deriving Extractable via Generically Entry

src/Language/Java/Classfile/ConstantPool/References.hs

@@ -0,0 +1,17 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Language.Java.Classfile.ConstantPool.References (Utf8Reference(..), ClassReference(..), NameAndTypeReference(..)) where
+import Data.Word (Word16)
+import Language.Java.Classfile.Extractable (Extractable)
+
+newtype Utf8Reference = Utf8Reference Word16
+  deriving stock (Show)
+  deriving newtype Extractable
+
+newtype ClassReference = ClassReference Word16
+  deriving stock (Show)
+  deriving newtype Extractable
+
+newtype NameAndTypeReference = NameAndTypeReference Word16
+  deriving stock (Show)
+  deriving newtype Extractable

src/Language/Java/Classfile/Extract.hs

@@ -29,6 +29,14 @@ instance Applicative Extract where
       Fail -> Fail
     Fail -> Fail
 
+instance Monad Extract where
+  (>>=) :: Extract a -> (a -> Extract b) -> Extract b
+  (>>=) (Extract computeA) f = Extract $ \ input -> case computeA input of
+    Done rest a -> let
+      (Extract computeB) = f a
+      in computeB rest
+    Fail -> Fail
+
 instance Alternative Extract where
   empty :: Extract a
   empty = Extract $ const Fail

src/Language/Java/Classfile/Extractable.hs

@@ -11,6 +11,8 @@ import Data.ByteString.Lazy (ByteString)
 import Data.Bits (Bits(shiftL, (.|.)))
 import GHC.Generics (U1 (U1), (:*:) ((:*:)), (:+:) (L1, R1), M1 (M1), K1 (K1), Generic (Rep, to), Generically (Generically))
 import Control.Applicative ((<|>), empty)
+import Data.Array.IArray (Array, listArray, Ix)
+import Control.Monad (replicateM)
 
 class Extractable a where
   extract :: Extract a
@@ -27,6 +29,17 @@ instance Extractable Word32 where
   extract :: Extract Word32
   extract = build <$> bytes 4
 
+instance (Extractable index, Extractable element, Ix index, Integral index) => Extractable (Array index element) where
+  extract :: Extract (Array index element)
+  extract = do
+    count <- extract
+    elements <- replicateM (fromIntegral count) extract
+    pure $ listArray (1, count) elements
+
+instance (Extractable a, Extractable b) => Extractable (a, b) where
+  extract :: Extract (a, b)
+  extract = (,) <$> extract <*> extract
+
 expectConstant :: (Extractable a, Eq a) => a -> Extract a
 expectConstant = expectEqual extract
 
@@ -36,6 +49,7 @@ build = ByteString.foldl' shiftOr 0
 shiftOr :: (Bits a1, Num a1) => a1 -> Word8 -> a1
 shiftOr word appendix = shiftL word 8 .|. fromIntegral appendix
 
+
 class GenericExtractable a where
   genericExtract :: Extract (a i)
 

src/Language/Java/Classfile/Extractable/WithTag.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+module Language.Java.Classfile.Extractable.WithTag where
+import Language.Java.Classfile.Extractable (Extractable (extract), expectConstant)
+import Language.Java.Classfile.Extract (Extract)
+import GHC.TypeLits (Natural, natVal, KnownNat)
+import Data.Kind (Type)
+import Control.Monad (void)
+import Data.Proxy (Proxy(Proxy))
+import Data.Word (Word8)
+
+type Word8Tag value a = WithNumericTag value Word8 a
+
+type WithNumericTag :: Natural -> Type -> Type -> Type
+newtype WithNumericTag value tagType a = Tagged a
+  deriving newtype Show
+
+instance (KnownNat value, Extractable a, Extractable tagType, Eq tagType, Num tagType) => Extractable (WithNumericTag value tagType a) where
+  extract :: Extract (WithNumericTag value tagType a)
+  extract = do
+    void $ expectConstant @tagType (fromIntegral . natVal $ Proxy @value)
+    Tagged <$> extract
+

src/Language/Java/Classfile/Magic.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE InstanceSigs #-}
+module Language.Java.Classfile.Magic (Magic(..)) where
+import Data.Word (Word32)
+import Language.Java.Classfile.Extractable (Extractable, extract, expectConstant)
+import Language.Java.Classfile.Extract (Extract)
+import Data.Hex (Hex (Hex))
+
+data Magic = Magic (Hex Word32)
+  deriving Show
+
+instance Extractable Magic where
+  extract :: Extract Magic
+  extract = Magic . Hex <$> expectConstant 0xCAFEBABE
+