feat: monad instance, some classfile constant-pool parsing

app/Main.hs

@@ -1,4 +1,14 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE TypeApplications #-}
 module Main (main) where
 
+import Data.ByteString.Lazy qualified as ByteString
+
+import Language.Java.Classfile (Classfile)
+import Language.Java.Classfile.Extract (runExtract)
+import Language.Java.Classfile.Extractable (extract)
+
 main :: IO ()
-main = pure ()
+main = do
+  input <- ByteString.getContents
+  print $ runExtract input (extract @Classfile)

java-classfile.cabal

@@ -25,9 +25,14 @@ source-repository head
 
 library
   exposed-modules:
+      Data.Hex
       Language.Java.Classfile
+      Language.Java.Classfile.ConstantPool
+      Language.Java.Classfile.ConstantPool.Entry
+      Language.Java.Classfile.ConstantPool.References
       Language.Java.Classfile.Extract
       Language.Java.Classfile.Extractable
+      Language.Java.Classfile.Extractable.WithTag
       Language.Java.Classfile.FromBigEndian
       Language.Java.Classfile.Magic
       Language.Java.Classfile.Version
@@ -39,7 +44,8 @@ library
       src
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
-      base >=4.7 && <5
+      array
+    , base >=4.7 && <5
     , bytestring
   default-language: Haskell2010
 
@@ -53,7 +59,8 @@ executable java-classfile-exe
       app
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      array
+    , base >=4.7 && <5
     , bytestring
     , java-classfile
   default-language: Haskell2010
@@ -69,7 +76,8 @@ test-suite java-classfile-test
       test
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      array
+    , base >=4.7 && <5
     , bytestring
     , java-classfile
   default-language: Haskell2010

package.yaml

@@ -20,6 +20,7 @@ extra-source-files:
 description:         Please see the README on GitHub at <https://github.com/githubuser/java-classfile#readme>
 
 dependencies:
+- array
 - base >= 4.7 && < 5
 - bytestring
 

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
+

stack.yaml

@@ -18,6 +18,7 @@
 # snapshot: ./custom-snapshot.yaml
 # snapshot: https://example.com/snapshots/2024-01-01.yaml
 snapshot: nightly-2025-07-10
+compiler: ghc-9.12.1
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.