diff --git a/app/Main.hs b/app/Main.hs index a31c5a0..05b302c 100644 --- a/app/Main.hs +++ b/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) diff --git a/java-classfile.cabal b/java-classfile.cabal index 0ee1afa..892c940 100644 --- a/java-classfile.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index d5dc22e..c598af9 100644 --- a/package.yaml +++ b/package.yaml @@ -20,6 +20,7 @@ extra-source-files: description: Please see the README on GitHub at dependencies: +- array - base >= 4.7 && < 5 - bytestring diff --git a/src/Data/Hex.hs b/src/Data/Hex.hs new file mode 100644 index 0000000..187ad3d --- /dev/null +++ b/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 "" + diff --git a/src/Language/Java/Classfile.hs b/src/Language/Java/Classfile.hs index 84a54c5..e5ef169 100644 --- a/src/Language/Java/Classfile.hs +++ b/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 diff --git a/src/Language/Java/Classfile/ConstantPool.hs b/src/Language/Java/Classfile/ConstantPool.hs new file mode 100644 index 0000000..006d492 --- /dev/null +++ b/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 diff --git a/src/Language/Java/Classfile/ConstantPool/Entry.hs b/src/Language/Java/Classfile/ConstantPool/Entry.hs new file mode 100644 index 0000000..0acd213 --- /dev/null +++ b/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 diff --git a/src/Language/Java/Classfile/ConstantPool/References.hs b/src/Language/Java/Classfile/ConstantPool/References.hs new file mode 100644 index 0000000..ad281a7 --- /dev/null +++ b/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 diff --git a/src/Language/Java/Classfile/Extract.hs b/src/Language/Java/Classfile/Extract.hs index 352e951..a75ece7 100644 --- a/src/Language/Java/Classfile/Extract.hs +++ b/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 diff --git a/src/Language/Java/Classfile/Extractable.hs b/src/Language/Java/Classfile/Extractable.hs index 0e8e126..b3c58bc 100644 --- a/src/Language/Java/Classfile/Extractable.hs +++ b/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) diff --git a/src/Language/Java/Classfile/Extractable/WithTag.hs b/src/Language/Java/Classfile/Extractable/WithTag.hs new file mode 100644 index 0000000..58f8ebe --- /dev/null +++ b/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 + diff --git a/src/Language/Java/Classfile/Magic.hs b/src/Language/Java/Classfile/Magic.hs new file mode 100644 index 0000000..d4c1223 --- /dev/null +++ b/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 + diff --git a/stack.yaml b/stack.yaml index d816db2..1bd568c 100644 --- a/stack.yaml +++ b/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.