{-|
Module      : Language.JVM.Utils
Copyright   : (c) Christian Gram Kalhauge, 2017
License     : MIT
Maintainer  : kalhuage@cs.ucla.edu

This module contains utilities missing not in other libraries.
-}

{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Language.JVM.Utils
  ( -- * Sized Data Structures
    --
    -- $SizedDataStructures
    SizedList (..)
  , listSize

  , SizedByteString (..)
  , byteStringSize

    -- ** Specific sizes
  , SizedList8
  , SizedList16
  , SizedByteString32
  , SizedByteString16
  , sizedByteStringFromText
  , sizedByteStringToText

  , tryDecode

    -- * Bit Set
    --
    -- $BitSet
  , BitSet (..)
  , Enumish(..)

    -- ** Specific sizes
  , BitSet16

  -- * General Utilities
  -- $utils
  , trd
  ) where

-- binary
import           Data.Binary
import           Data.Binary.Get as Get
import           Data.Binary.Put

-- base
import           Data.Bits
import           Data.List                as List
import           Data.String
import           Control.Monad

-- containers
import           Data.Set                 as Set

-- nfdata
import           Control.DeepSeq          (NFData)

-- text
import qualified Data.Text                as Text
import qualified Data.Text.Encoding       as TE
import qualified Data.Text.Encoding.Error as TE

-- bytestring
import qualified Data.ByteString          as BS

-- import           Debug.Trace


-- $SizedDataStructures
-- These data structures enables binary reading and writing of lists and
-- byte strings that are prepended with the number of elements to read or write.


-- | SizedList is a binary type, that reads a list of elements. It first reads a
-- length N of type 'w' and then N items of type 'a'.
newtype SizedList w a = SizedList
  { SizedList w a -> [a]
unSizedList :: [ a ]
  } deriving (Int -> SizedList w a -> ShowS
[SizedList w a] -> ShowS
SizedList w a -> String
(Int -> SizedList w a -> ShowS)
-> (SizedList w a -> String)
-> ([SizedList w a] -> ShowS)
-> Show (SizedList w a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w a. Show a => Int -> SizedList w a -> ShowS
forall w a. Show a => [SizedList w a] -> ShowS
forall w a. Show a => SizedList w a -> String
showList :: [SizedList w a] -> ShowS
$cshowList :: forall w a. Show a => [SizedList w a] -> ShowS
show :: SizedList w a -> String
$cshow :: forall w a. Show a => SizedList w a -> String
showsPrec :: Int -> SizedList w a -> ShowS
$cshowsPrec :: forall w a. Show a => Int -> SizedList w a -> ShowS
Show, SizedList w a -> SizedList w a -> Bool
(SizedList w a -> SizedList w a -> Bool)
-> (SizedList w a -> SizedList w a -> Bool) -> Eq (SizedList w a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w a. Eq a => SizedList w a -> SizedList w a -> Bool
/= :: SizedList w a -> SizedList w a -> Bool
$c/= :: forall w a. Eq a => SizedList w a -> SizedList w a -> Bool
== :: SizedList w a -> SizedList w a -> Bool
$c== :: forall w a. Eq a => SizedList w a -> SizedList w a -> Bool
Eq, a -> SizedList w b -> SizedList w a
(a -> b) -> SizedList w a -> SizedList w b
(forall a b. (a -> b) -> SizedList w a -> SizedList w b)
-> (forall a b. a -> SizedList w b -> SizedList w a)
-> Functor (SizedList w)
forall a b. a -> SizedList w b -> SizedList w a
forall a b. (a -> b) -> SizedList w a -> SizedList w b
forall w a b. a -> SizedList w b -> SizedList w a
forall w a b. (a -> b) -> SizedList w a -> SizedList w b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SizedList w b -> SizedList w a
$c<$ :: forall w a b. a -> SizedList w b -> SizedList w a
fmap :: (a -> b) -> SizedList w a -> SizedList w b
$cfmap :: forall w a b. (a -> b) -> SizedList w a -> SizedList w b
Functor, SizedList w a -> ()
(SizedList w a -> ()) -> NFData (SizedList w a)
forall a. (a -> ()) -> NFData a
forall w a. NFData a => SizedList w a -> ()
rnf :: SizedList w a -> ()
$crnf :: forall w a. NFData a => SizedList w a -> ()
NFData, Eq (SizedList w a)
Eq (SizedList w a)
-> (SizedList w a -> SizedList w a -> Ordering)
-> (SizedList w a -> SizedList w a -> Bool)
-> (SizedList w a -> SizedList w a -> Bool)
-> (SizedList w a -> SizedList w a -> Bool)
-> (SizedList w a -> SizedList w a -> Bool)
-> (SizedList w a -> SizedList w a -> SizedList w a)
-> (SizedList w a -> SizedList w a -> SizedList w a)
-> Ord (SizedList w a)
SizedList w a -> SizedList w a -> Bool
SizedList w a -> SizedList w a -> Ordering
SizedList w a -> SizedList w a -> SizedList w a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall w a. Ord a => Eq (SizedList w a)
forall w a. Ord a => SizedList w a -> SizedList w a -> Bool
forall w a. Ord a => SizedList w a -> SizedList w a -> Ordering
forall w a.
Ord a =>
SizedList w a -> SizedList w a -> SizedList w a
min :: SizedList w a -> SizedList w a -> SizedList w a
$cmin :: forall w a.
Ord a =>
SizedList w a -> SizedList w a -> SizedList w a
max :: SizedList w a -> SizedList w a -> SizedList w a
$cmax :: forall w a.
Ord a =>
SizedList w a -> SizedList w a -> SizedList w a
>= :: SizedList w a -> SizedList w a -> Bool
$c>= :: forall w a. Ord a => SizedList w a -> SizedList w a -> Bool
> :: SizedList w a -> SizedList w a -> Bool
$c> :: forall w a. Ord a => SizedList w a -> SizedList w a -> Bool
<= :: SizedList w a -> SizedList w a -> Bool
$c<= :: forall w a. Ord a => SizedList w a -> SizedList w a -> Bool
< :: SizedList w a -> SizedList w a -> Bool
$c< :: forall w a. Ord a => SizedList w a -> SizedList w a -> Bool
compare :: SizedList w a -> SizedList w a -> Ordering
$ccompare :: forall w a. Ord a => SizedList w a -> SizedList w a -> Ordering
$cp1Ord :: forall w a. Ord a => Eq (SizedList w a)
Ord)

-- | Get the size of the sized list.
listSize :: Num w => SizedList w a -> w
listSize :: SizedList w a -> w
listSize =
  Int -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> w) -> (SizedList w a -> Int) -> SizedList w a -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (SizedList w a -> [a]) -> SizedList w a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedList w a -> [a]
forall w a. SizedList w a -> [a]
unSizedList

instance Foldable (SizedList w) where
  foldMap :: (a -> m) -> SizedList w a -> m
foldMap a -> m
am =
    (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
am ([a] -> m) -> (SizedList w a -> [a]) -> SizedList w a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedList w a -> [a]
forall w a. SizedList w a -> [a]
unSizedList

instance Traversable (SizedList w) where
  traverse :: (a -> f b) -> SizedList w a -> f (SizedList w b)
traverse a -> f b
afb SizedList w a
ta =
    [b] -> SizedList w b
forall w a. [a] -> SizedList w a
SizedList ([b] -> SizedList w b) -> f [b] -> f (SizedList w b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
afb (SizedList w a -> [a]
forall w a. SizedList w a -> [a]
unSizedList SizedList w a
ta)

instance (Binary w, Integral w, Binary a) => Binary (SizedList w a) where
  get :: Get (SizedList w a)
get = do
    w
len <- Get w
forall t. Binary t => Get t
get :: Get w
    String -> Get (SizedList w a) -> Get (SizedList w a)
forall a. String -> Get a -> Get a
Get.label (String
"SizedList[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (w -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral w
len :: Int) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]") (Get (SizedList w a) -> Get (SizedList w a))
-> Get (SizedList w a) -> Get (SizedList w a)
forall a b. (a -> b) -> a -> b
$
      [a] -> SizedList w a
forall w a. [a] -> SizedList w a
SizedList ([a] -> SizedList w a) -> Get [a] -> Get (SizedList w a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get a -> Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (w -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral w
len) Get a
forall t. Binary t => Get t
get
  {-# INLINE get #-}

  put :: SizedList w a -> Put
put sl :: SizedList w a
sl@(SizedList [a]
l) = do
    w -> Put
forall t. Binary t => t -> Put
put (SizedList w a -> w
forall w a. Num w => SizedList w a -> w
listSize SizedList w a
sl)
    [a] -> (a -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [a]
l a -> Put
forall t. Binary t => t -> Put
put
  {-# INLINE put #-}

-- | A byte string with a size w.
newtype SizedByteString w = SizedByteString
  { SizedByteString w -> ByteString
unSizedByteString :: BS.ByteString
  } deriving (Int -> SizedByteString w -> ShowS
[SizedByteString w] -> ShowS
SizedByteString w -> String
(Int -> SizedByteString w -> ShowS)
-> (SizedByteString w -> String)
-> ([SizedByteString w] -> ShowS)
-> Show (SizedByteString w)
forall w. Int -> SizedByteString w -> ShowS
forall w. [SizedByteString w] -> ShowS
forall w. SizedByteString w -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SizedByteString w] -> ShowS
$cshowList :: forall w. [SizedByteString w] -> ShowS
show :: SizedByteString w -> String
$cshow :: forall w. SizedByteString w -> String
showsPrec :: Int -> SizedByteString w -> ShowS
$cshowsPrec :: forall w. Int -> SizedByteString w -> ShowS
Show, SizedByteString w -> SizedByteString w -> Bool
(SizedByteString w -> SizedByteString w -> Bool)
-> (SizedByteString w -> SizedByteString w -> Bool)
-> Eq (SizedByteString w)
forall w. SizedByteString w -> SizedByteString w -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SizedByteString w -> SizedByteString w -> Bool
$c/= :: forall w. SizedByteString w -> SizedByteString w -> Bool
== :: SizedByteString w -> SizedByteString w -> Bool
$c== :: forall w. SizedByteString w -> SizedByteString w -> Bool
Eq, SizedByteString w -> ()
(SizedByteString w -> ()) -> NFData (SizedByteString w)
forall w. SizedByteString w -> ()
forall a. (a -> ()) -> NFData a
rnf :: SizedByteString w -> ()
$crnf :: forall w. SizedByteString w -> ()
NFData, Eq (SizedByteString w)
Eq (SizedByteString w)
-> (SizedByteString w -> SizedByteString w -> Ordering)
-> (SizedByteString w -> SizedByteString w -> Bool)
-> (SizedByteString w -> SizedByteString w -> Bool)
-> (SizedByteString w -> SizedByteString w -> Bool)
-> (SizedByteString w -> SizedByteString w -> Bool)
-> (SizedByteString w -> SizedByteString w -> SizedByteString w)
-> (SizedByteString w -> SizedByteString w -> SizedByteString w)
-> Ord (SizedByteString w)
SizedByteString w -> SizedByteString w -> Bool
SizedByteString w -> SizedByteString w -> Ordering
SizedByteString w -> SizedByteString w -> SizedByteString w
forall w. Eq (SizedByteString w)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall w. SizedByteString w -> SizedByteString w -> Bool
forall w. SizedByteString w -> SizedByteString w -> Ordering
forall w.
SizedByteString w -> SizedByteString w -> SizedByteString w
min :: SizedByteString w -> SizedByteString w -> SizedByteString w
$cmin :: forall w.
SizedByteString w -> SizedByteString w -> SizedByteString w
max :: SizedByteString w -> SizedByteString w -> SizedByteString w
$cmax :: forall w.
SizedByteString w -> SizedByteString w -> SizedByteString w
>= :: SizedByteString w -> SizedByteString w -> Bool
$c>= :: forall w. SizedByteString w -> SizedByteString w -> Bool
> :: SizedByteString w -> SizedByteString w -> Bool
$c> :: forall w. SizedByteString w -> SizedByteString w -> Bool
<= :: SizedByteString w -> SizedByteString w -> Bool
$c<= :: forall w. SizedByteString w -> SizedByteString w -> Bool
< :: SizedByteString w -> SizedByteString w -> Bool
$c< :: forall w. SizedByteString w -> SizedByteString w -> Bool
compare :: SizedByteString w -> SizedByteString w -> Ordering
$ccompare :: forall w. SizedByteString w -> SizedByteString w -> Ordering
$cp1Ord :: forall w. Eq (SizedByteString w)
Ord, String -> SizedByteString w
(String -> SizedByteString w) -> IsString (SizedByteString w)
forall w. String -> SizedByteString w
forall a. (String -> a) -> IsString a
fromString :: String -> SizedByteString w
$cfromString :: forall w. String -> SizedByteString w
IsString)

-- | Get the size of a SizedByteString
byteStringSize :: (Num w) => SizedByteString w -> w
byteStringSize :: SizedByteString w -> w
byteStringSize =
  Int -> w
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> w) -> (SizedByteString w -> Int) -> SizedByteString w -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length (ByteString -> Int)
-> (SizedByteString w -> ByteString) -> SizedByteString w -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SizedByteString w -> ByteString
forall w. SizedByteString w -> ByteString
unSizedByteString

instance (Binary w, Integral w) => Binary (SizedByteString w) where
  get :: Get (SizedByteString w)
get = do
    w
x <- Get w
forall t. Binary t => Get t
get :: Get w
    ByteString -> SizedByteString w
forall w. ByteString -> SizedByteString w
SizedByteString (ByteString -> SizedByteString w)
-> Get ByteString -> Get (SizedByteString w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (w -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral w
x)
  put :: SizedByteString w -> Put
put sbs :: SizedByteString w
sbs@(SizedByteString ByteString
bs) = do
    w -> Put
forall t. Binary t => t -> Put
put (SizedByteString w -> w
forall w. Num w => SizedByteString w -> w
byteStringSize SizedByteString w
sbs)
    ByteString -> Put
putByteString ByteString
bs

replaceJavaZeroWithNormalZero :: BS.ByteString -> BS.ByteString
replaceJavaZeroWithNormalZero :: ByteString -> ByteString
replaceJavaZeroWithNormalZero = ByteString -> ByteString
go
  where
    go :: ByteString -> ByteString
go ByteString
bs =
      case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\192\128" ByteString
bs of
        (ByteString
h, ByteString
"") -> ByteString
h
        (ByteString
h, ByteString
t) -> ByteString
h ByteString -> ByteString -> ByteString
`BS.append` ByteString
"\0" ByteString -> ByteString -> ByteString
`BS.append` ByteString -> ByteString
go (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
t)

replaceNormalZeroWithJavaZero::BS.ByteString -> BS.ByteString
replaceNormalZeroWithJavaZero :: ByteString -> ByteString
replaceNormalZeroWithJavaZero = ByteString -> ByteString
go
  where
      go :: ByteString -> ByteString
go ByteString
bs =
        case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"\0" ByteString
bs of
          (ByteString
h, ByteString
"") -> ByteString
h
          (ByteString
h, ByteString
t) -> ByteString
h ByteString -> ByteString -> ByteString
`BS.append` ByteString
"\192\128" ByteString -> ByteString -> ByteString
`BS.append` ByteString -> ByteString
go (Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
t)

-- | Convert a Sized bytestring to Utf8 Text.
sizedByteStringToText ::
     SizedByteString w
  -> Either TE.UnicodeException Text.Text
sizedByteStringToText :: SizedByteString w -> Either UnicodeException Text
sizedByteStringToText (SizedByteString ByteString
bs) =
  let rst :: Either UnicodeException Text
rst = ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bs
    in case Either UnicodeException Text
rst of
      Right Text
txt -> Text -> Either UnicodeException Text
forall a b. b -> Either a b
Right Text
txt
      Left UnicodeException
_ -> ByteString -> Either UnicodeException Text
tryDecode ByteString
bs

tryDecode :: BS.ByteString -> Either TE.UnicodeException Text.Text
tryDecode :: ByteString -> Either UnicodeException Text
tryDecode =  ByteString -> Either UnicodeException Text
TE.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
replaceJavaZeroWithNormalZero

-- | Convert a Sized bytestring from Utf8 Text.
sizedByteStringFromText ::
     Text.Text
  -> SizedByteString w
sizedByteStringFromText :: Text -> SizedByteString w
sizedByteStringFromText Text
t
  = ByteString -> SizedByteString w
forall w. ByteString -> SizedByteString w
SizedByteString (ByteString -> SizedByteString w)
-> (Text -> ByteString) -> Text -> SizedByteString w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
replaceNormalZeroWithJavaZero (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> SizedByteString w) -> Text -> SizedByteString w
forall a b. (a -> b) -> a -> b
$ Text
t

-- $BitSet
-- A bit set is a set where each element is represented a bit in a word. This
-- section also defines the 'Enumish' type class. It is different than a 'Enum'
-- in that the integers they represent does not have to be subsequent.

-- | An Enumish value, all maps to a number, but not all integers maps to a
-- enumsish value. There is no guarantee that the integers will be subsequent.
class (Eq a, Ord a) => Enumish a where
  -- | The only needed implementation is a list of integer-enum pairs in
  -- ascending order, corresponding to their integer value.
  inOrder :: [(Int, a)]

  fromEnumish :: a -> Int
  fromEnumish a
a = let Just (Int
i, a
_) = ((Int, a) -> Bool) -> [(Int, a)] -> Maybe (Int, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a) (a -> Bool) -> ((Int, a) -> a) -> (Int, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, a) -> a
forall a b. (a, b) -> b
snd) ([(Int, a)] -> Maybe (Int, a)) -> [(Int, a)] -> Maybe (Int, a)
forall a b. (a -> b) -> a -> b
$ [(Int, a)]
forall a. Enumish a => [(Int, a)]
inOrder in Int
i

  toEnumish :: Int -> Maybe a
  toEnumish Int
i = (Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a) -> Maybe (Int, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((Int, a) -> Bool) -> [(Int, a)] -> Maybe (Int, a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i) (Int -> Bool) -> ((Int, a) -> Int) -> (Int, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, a) -> Int
forall a b. (a, b) -> a
fst) ([(Int, a)] -> Maybe (Int, a)) -> [(Int, a)] -> Maybe (Int, a)
forall a b. (a -> b) -> a -> b
$ [(Int, a)]
forall a. Enumish a => [(Int, a)]
inOrder)

-- | A bit set of size w
newtype BitSet w a = BitSet
  { BitSet w a -> Set a
toSet :: Set.Set a
  } deriving (Eq (BitSet w a)
Eq (BitSet w a)
-> (BitSet w a -> BitSet w a -> Ordering)
-> (BitSet w a -> BitSet w a -> Bool)
-> (BitSet w a -> BitSet w a -> Bool)
-> (BitSet w a -> BitSet w a -> Bool)
-> (BitSet w a -> BitSet w a -> Bool)
-> (BitSet w a -> BitSet w a -> BitSet w a)
-> (BitSet w a -> BitSet w a -> BitSet w a)
-> Ord (BitSet w a)
BitSet w a -> BitSet w a -> Bool
BitSet w a -> BitSet w a -> Ordering
BitSet w a -> BitSet w a -> BitSet w a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall w a. Ord a => Eq (BitSet w a)
forall w a. Ord a => BitSet w a -> BitSet w a -> Bool
forall w a. Ord a => BitSet w a -> BitSet w a -> Ordering
forall w a. Ord a => BitSet w a -> BitSet w a -> BitSet w a
min :: BitSet w a -> BitSet w a -> BitSet w a
$cmin :: forall w a. Ord a => BitSet w a -> BitSet w a -> BitSet w a
max :: BitSet w a -> BitSet w a -> BitSet w a
$cmax :: forall w a. Ord a => BitSet w a -> BitSet w a -> BitSet w a
>= :: BitSet w a -> BitSet w a -> Bool
$c>= :: forall w a. Ord a => BitSet w a -> BitSet w a -> Bool
> :: BitSet w a -> BitSet w a -> Bool
$c> :: forall w a. Ord a => BitSet w a -> BitSet w a -> Bool
<= :: BitSet w a -> BitSet w a -> Bool
$c<= :: forall w a. Ord a => BitSet w a -> BitSet w a -> Bool
< :: BitSet w a -> BitSet w a -> Bool
$c< :: forall w a. Ord a => BitSet w a -> BitSet w a -> Bool
compare :: BitSet w a -> BitSet w a -> Ordering
$ccompare :: forall w a. Ord a => BitSet w a -> BitSet w a -> Ordering
$cp1Ord :: forall w a. Ord a => Eq (BitSet w a)
Ord, Int -> BitSet w a -> ShowS
[BitSet w a] -> ShowS
BitSet w a -> String
(Int -> BitSet w a -> ShowS)
-> (BitSet w a -> String)
-> ([BitSet w a] -> ShowS)
-> Show (BitSet w a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall w a. Show a => Int -> BitSet w a -> ShowS
forall w a. Show a => [BitSet w a] -> ShowS
forall w a. Show a => BitSet w a -> String
showList :: [BitSet w a] -> ShowS
$cshowList :: forall w a. Show a => [BitSet w a] -> ShowS
show :: BitSet w a -> String
$cshow :: forall w a. Show a => BitSet w a -> String
showsPrec :: Int -> BitSet w a -> ShowS
$cshowsPrec :: forall w a. Show a => Int -> BitSet w a -> ShowS
Show, BitSet w a -> BitSet w a -> Bool
(BitSet w a -> BitSet w a -> Bool)
-> (BitSet w a -> BitSet w a -> Bool) -> Eq (BitSet w a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall w a. Eq a => BitSet w a -> BitSet w a -> Bool
/= :: BitSet w a -> BitSet w a -> Bool
$c/= :: forall w a. Eq a => BitSet w a -> BitSet w a -> Bool
== :: BitSet w a -> BitSet w a -> Bool
$c== :: forall w a. Eq a => BitSet w a -> BitSet w a -> Bool
Eq, BitSet w a -> ()
(BitSet w a -> ()) -> NFData (BitSet w a)
forall a. (a -> ()) -> NFData a
forall w a. NFData a => BitSet w a -> ()
rnf :: BitSet w a -> ()
$crnf :: forall w a. NFData a => BitSet w a -> ()
NFData)


bitSetToWord :: (Enumish a, Bits w) => BitSet w a -> w
bitSetToWord :: BitSet w a -> w
bitSetToWord =
  [a] -> w
forall a w. (Enumish a, Bits w) => [a] -> w
toWord ([a] -> w) -> (BitSet w a -> [a]) -> BitSet w a -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> (BitSet w a -> Set a) -> BitSet w a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitSet w a -> Set a
forall w a. BitSet w a -> Set a
toSet

toWord :: (Enumish a, Bits w) => [a] -> w
toWord :: [a] -> w
toWord =
  (w -> a -> w) -> w -> [a] -> w
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\w
a -> w -> Int -> w
forall a. Bits a => a -> Int -> a
setBit w
a (Int -> w) -> (a -> Int) -> a -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enumish a => a -> Int
fromEnumish) w
forall a. Bits a => a
zeroBits

instance (Show w, Bits w, Binary w, Enumish a) => Binary (BitSet w a) where
  get :: Get (BitSet w a)
get = do
    w
word <- Get w
forall t. Binary t => Get t
get :: Get w
    BitSet w a -> Get (BitSet w a)
forall (m :: * -> *) a. Monad m => a -> m a
return (BitSet w a -> Get (BitSet w a))
-> (Set a -> BitSet w a) -> Set a -> Get (BitSet w a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> BitSet w a
forall w a. Set a -> BitSet w a
BitSet (Set a -> Get (BitSet w a)) -> Set a -> Get (BitSet w a)
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [ a
x | (Int
i, a
x) <- [(Int, a)]
forall a. Enumish a => [(Int, a)]
inOrder, w -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit w
word Int
i ]

  put :: BitSet w a -> Put
put = w -> Put
forall t. Binary t => t -> Put
put (w -> Put) -> (BitSet w a -> w) -> BitSet w a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BitSet w a -> w
forall a w. (Enumish a, Bits w) => BitSet w a -> w
bitSetToWord

-- | A sized list using a 8 bit word as length
type SizedList8 = SizedList Word8

-- | A sized list using a 16 bit word as length
type SizedList16 = SizedList Word16

-- | A sized bytestring using a 32 bit word as length
type SizedByteString32 = SizedByteString Word32

-- | A sized bytestring using a 16 bit word as length
type SizedByteString16 = SizedByteString Word16

-- | A BitSet using a 16 bit word
type BitSet16 = BitSet Word16

{- $utils

-}

-- | Takes the third element of a triple.
trd :: (a, b, c) -> c
trd :: (a, b, c) -> c
trd (a
_, b
_, c
c) = c
c