module Language.JVM.Utils
(
SizedList (..)
, listSize
, SizedByteString (..)
, byteStringSize
, SizedList16
, SizedByteString32
, SizedByteString16
, BitSet (..)
, Enumish(..)
, BitSet16
, trd
) where
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Bits
import Data.List as List
import Data.Set as Set
import Control.Monad
import qualified Data.ByteString as BS
newtype SizedList w a = SizedList
{ unSizedList :: [ a ]
} deriving (Show, Eq, Functor)
listSize :: Num w => SizedList w a -> w
listSize =
fromIntegral . length . unSizedList
instance Foldable (SizedList w) where
foldMap am =
foldMap am . unSizedList
instance Traversable (SizedList w) where
traverse afb ta =
SizedList <$> traverse afb (unSizedList ta)
instance (Binary w, Integral w, Binary a) => Binary (SizedList w a) where
get = do
len <- get :: Get w
SizedList <$> replicateM (fromIntegral len) get
put sl@(SizedList l) = do
put (listSize sl)
forM_ l put
newtype SizedByteString w = SizedByteString
{ unSizedByteString :: BS.ByteString
} deriving (Show, Eq)
byteStringSize :: (Num w) => SizedByteString w -> w
byteStringSize =
fromIntegral . BS.length . unSizedByteString
instance (Binary w, Integral w) => Binary (SizedByteString w) where
get = do
x <- get :: Get w
SizedByteString <$> getByteString (fromIntegral x)
put sbs@(SizedByteString bs) = do
put (byteStringSize sbs)
putByteString bs
class (Eq a, Ord a) => Enumish a where
inOrder :: [(Int, a)]
fromEnumish :: a -> Int
fromEnumish a = let Just (i, _) = List.find ((== a) . snd) $ inOrder in i
toEnumish :: Int -> Maybe a
toEnumish i = snd <$> (List.find ((== i) . fst) $ inOrder)
newtype BitSet w a = BitSet
{ toSet :: Set.Set a
} deriving (Ord, Show, Eq)
instance (Bits w, Binary w, Enumish a) => Binary (BitSet w a) where
get = do
word <- get :: Get w
return . BitSet $ Set.fromList [ x | (i, x) <- inOrder, testBit word i ]
put (BitSet f) = do
let word =
List.foldl' setBit zeroBits
(List.map fromEnumish $ Set.toList f) :: w
put word
type SizedList16 = SizedList Word16
type SizedByteString32 = SizedByteString Word32
type SizedByteString16 = SizedByteString Word16
type BitSet16 = BitSet Word16
trd :: (a, b, c) -> c
trd (_, _, c) = c