diff --git a/src/Language/Java/Classfile/Extract.hs b/src/Language/Java/Classfile/Extract.hs index 865ec04..d560afe 100644 --- a/src/Language/Java/Classfile/Extract.hs +++ b/src/Language/Java/Classfile/Extract.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE InstanceSigs #-} -module Language.Java.Classfile.Extract (Extract(), bytes) where +module Language.Java.Classfile.Extract (Extract(), bytes, runExtract) where import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as ByteString @@ -37,7 +37,6 @@ instance Alternative Extract where Fail -> right input t -> t - -- | Get a specified count of bytes. Fail if there are not enough bytes available. bytes :: Word -> Extract ByteString @@ -48,7 +47,6 @@ bytes count = Extract $ \ input -> let then Fail else Done rest bs - {- It seems I cannot define a lawful monad instance instance Monad Extract where (>>=) :: Extract a -> (a -> Extract b) -> Extract b @@ -57,3 +55,8 @@ instance Monad Extract where Fail -> Fail -} +runExtract :: ByteString -> Extract b -> Maybe (ByteString, b) +runExtract string (Extract computation) = case computation string of + Fail -> Nothing + Done rest x -> Just (rest, x) + diff --git a/src/Language/Java/Classfile/Extractable.hs b/src/Language/Java/Classfile/Extractable.hs index d444076..b86b377 100644 --- a/src/Language/Java/Classfile/Extractable.hs +++ b/src/Language/Java/Classfile/Extractable.hs @@ -1,12 +1,15 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE TypeOperators #-} -module Language.Java.Classfile.Extractable () where +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +module Language.Java.Classfile.Extractable (Extractable()) where + import Language.Java.Classfile.Extract (Extract, bytes) import Data.Word (Word8, Word16, Word32) import qualified Data.ByteString.Lazy as ByteString import Data.ByteString.Lazy (ByteString) import Data.Bits (Bits(shiftL, (.|.))) -import GHC.Generics (U1 (U1), (:*:)) +import GHC.Generics (U1 (U1), (:*:) ((:*:)), (:+:) (L1, R1), M1 (M1), K1 (K1), Generic (Rep, to), Generically (Generically)) import Control.Applicative ((<|>)) @@ -34,13 +37,32 @@ shiftOr word appendix = shiftL word 8 .|. fromIntegral appendix class GenericExtractable a where genericExtract :: Extract (a i) +-- sum types +instance (GenericExtractable l, GenericExtractable r) => GenericExtractable (l :+: r) where + genericExtract :: Extract ((:+:) l r i) + genericExtract = (L1 <$> genericExtract) <|> (R1 <$> genericExtract) + -- unit data types instance GenericExtractable U1 where genericExtract :: Extract (U1 i) genericExtract = pure U1 -- product types -instance GenericExtractable (l :*: r) where +instance (GenericExtractable l, GenericExtractable r) => GenericExtractable (l :*: r) where genericExtract :: Extract ((:*:) l r i) - genericExtract = genericExtract <|> genericExtract + genericExtract = liftA2 (:*:) genericExtract genericExtract + +-- meta information constructors +instance GenericExtractable a => GenericExtractable (M1 i c a) where + genericExtract :: Extract (M1 i c a i2) + genericExtract = M1 <$> genericExtract + +-- fields !! yay +instance Extractable a => GenericExtractable (K1 i a) where + genericExtract :: Extract (K1 i1 a i2) + genericExtract = K1 <$> extract + +instance (Generic a, GenericExtractable (Rep a)) => Extractable (Generically a) where + extract :: Extract (Generically a) + extract = Generically . to <$> genericExtract diff --git a/src/Language/Java/Classfile/Version.hs b/src/Language/Java/Classfile/Version.hs index c996876..b160228 100644 --- a/src/Language/Java/Classfile/Version.hs +++ b/src/Language/Java/Classfile/Version.hs @@ -1,8 +1,15 @@ +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} module Language.Java.Classfile.Version (Version(..)) where import Data.Word (Word16) +import GHC.Generics (Generic, Generically(Generically)) +import Language.Java.Classfile.Extractable (Extractable) data Version = Version { minor :: Word16 , major :: Word16 } + deriving stock (Show, Generic) + deriving Extractable via Generically Version