feat: generic deriving for extraction

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)
+

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
 

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