{-# LANGUAGE CPP, BangPatterns, PatternGuards, DeriveDataTypeable #-}
module Codec.Archive.Tar.Index.StringTable (
StringTable,
lookup,
index,
construct,
StringTableBuilder,
empty,
insert,
inserts,
finalise,
unfinalise,
serialise,
serialiseSize,
deserialiseV1,
deserialiseV2,
#ifdef TESTS
prop_valid,
prop_sorted,
prop_finalise_unfinalise,
prop_serialise_deserialise,
prop_serialiseSize,
#endif
) where
import Data.Typeable (Typeable)
import Prelude hiding (lookup, id)
import Data.List hiding (lookup, insert)
import Data.Function (on)
import Data.Word (Word32)
import Data.Int (Int32)
import Data.Bits
import Data.Monoid (Monoid(..))
#if (MIN_VERSION_base(4,5,0))
import Data.Monoid ((<>))
#endif
import Control.Exception (assert)
import qualified Data.Array.Unboxed as A
import Data.Array.Unboxed ((!))
#if MIN_VERSION_containers(0,5,0)
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
#else
import qualified Data.Map as Map
import Data.Map (Map)
#endif
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Lazy as LBS
#if MIN_VERSION_bytestring(0,10,2) || defined(MIN_VERSION_bytestring_builder)
import Data.ByteString.Builder as BS
import Data.ByteString.Builder.Extra as BS (byteStringCopy)
#else
import Data.ByteString.Lazy.Builder as BS
import Data.ByteString.Lazy.Builder.Extras as BS (byteStringCopy)
#endif
data StringTable id = StringTable
{-# UNPACK #-} !BS.ByteString
{-# UNPACK #-} !(A.UArray Int32 Word32)
{-# UNPACK #-} !(A.UArray Int32 Int32)
{-# UNPACK #-} !(A.UArray Int32 Int32)
deriving (Int -> StringTable id -> ShowS
forall id. Int -> StringTable id -> ShowS
forall id. [StringTable id] -> ShowS
forall id. StringTable id -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringTable id] -> ShowS
$cshowList :: forall id. [StringTable id] -> ShowS
show :: StringTable id -> String
$cshow :: forall id. StringTable id -> String
showsPrec :: Int -> StringTable id -> ShowS
$cshowsPrec :: forall id. Int -> StringTable id -> ShowS
Show, Typeable)
instance (Eq id, Enum id) => Eq (StringTable id) where
StringTable id
tbl1 == :: StringTable id -> StringTable id -> Bool
== StringTable id
tbl2 = forall id. Enum id => StringTable id -> StringTableBuilder id
unfinalise StringTable id
tbl1 forall a. Eq a => a -> a -> Bool
== forall id. Enum id => StringTable id -> StringTableBuilder id
unfinalise StringTable id
tbl2
lookup :: Enum id => StringTable id -> BS.ByteString -> Maybe id
lookup :: forall id. Enum id => StringTable id -> ByteString -> Maybe id
lookup (StringTable ByteString
bs UArray Int32 Word32
offsets UArray Int32 Int32
ids UArray Int32 Int32
_ixs) ByteString
str =
forall {a}. Enum a => Int32 -> Int32 -> ByteString -> Maybe a
binarySearch Int32
0 (Int32
topBoundforall a. Num a => a -> a -> a
-Int32
1) ByteString
str
where
(Int32
0, Int32
topBound) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds UArray Int32 Word32
offsets
binarySearch :: Int32 -> Int32 -> ByteString -> Maybe a
binarySearch !Int32
a !Int32
b !ByteString
key
| Int32
a forall a. Ord a => a -> a -> Bool
> Int32
b = forall a. Maybe a
Nothing
| Bool
otherwise = case forall a. Ord a => a -> a -> Ordering
compare ByteString
key (ByteString -> UArray Int32 Word32 -> Int32 -> ByteString
index' ByteString
bs UArray Int32 Word32
offsets Int32
mid) of
Ordering
LT -> Int32 -> Int32 -> ByteString -> Maybe a
binarySearch Int32
a (Int32
midforall a. Num a => a -> a -> a
-Int32
1) ByteString
key
Ordering
EQ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral (UArray Int32 Int32
ids forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
mid))
Ordering
GT -> Int32 -> Int32 -> ByteString -> Maybe a
binarySearch (Int32
midforall a. Num a => a -> a -> a
+Int32
1) Int32
b ByteString
key
where mid :: Int32
mid = (Int32
a forall a. Num a => a -> a -> a
+ Int32
b) forall a. Integral a => a -> a -> a
`div` Int32
2
index' :: BS.ByteString -> A.UArray Int32 Word32 -> Int32 -> BS.ByteString
index' :: ByteString -> UArray Int32 Word32 -> Int32 -> ByteString
index' ByteString
bs UArray Int32 Word32
offsets Int32
i = Int -> ByteString -> ByteString
BS.unsafeTake Int
len forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.unsafeDrop Int
start forall a b. (a -> b) -> a -> b
$ ByteString
bs
where
start, end, len :: Int
start :: Int
start = forall a b. (Integral a, Num b) => a -> b
fromIntegral (UArray Int32 Word32
offsets forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
i)
end :: Int
end = forall a b. (Integral a, Num b) => a -> b
fromIntegral (UArray Int32 Word32
offsets forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int32
iforall a. Num a => a -> a -> a
+Int32
1))
len :: Int
len = Int
end forall a. Num a => a -> a -> a
- Int
start
index :: Enum id => StringTable id -> id -> BS.ByteString
index :: forall id. Enum id => StringTable id -> id -> ByteString
index (StringTable ByteString
bs UArray Int32 Word32
offsets UArray Int32 Int32
_ids UArray Int32 Int32
ixs) =
ByteString -> UArray Int32 Word32 -> Int32 -> ByteString
index' ByteString
bs UArray Int32 Word32
offsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UArray Int32 Int32
ixs forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
construct :: Enum id => [BS.ByteString] -> StringTable id
construct :: forall id. Enum id => [ByteString] -> StringTable id
construct = forall id. Enum id => StringTableBuilder id -> StringTable id
finalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\StringTableBuilder id
tbl ByteString
s -> forall a b. (a, b) -> a
fst (forall id.
Enum id =>
ByteString -> StringTableBuilder id -> (StringTableBuilder id, id)
insert ByteString
s StringTableBuilder id
tbl)) forall id. StringTableBuilder id
empty
data StringTableBuilder id = StringTableBuilder
!(Map BS.ByteString id)
{-# UNPACK #-} !Word32
deriving (StringTableBuilder id -> StringTableBuilder id -> Bool
forall id.
Eq id =>
StringTableBuilder id -> StringTableBuilder id -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringTableBuilder id -> StringTableBuilder id -> Bool
$c/= :: forall id.
Eq id =>
StringTableBuilder id -> StringTableBuilder id -> Bool
== :: StringTableBuilder id -> StringTableBuilder id -> Bool
$c== :: forall id.
Eq id =>
StringTableBuilder id -> StringTableBuilder id -> Bool
Eq, Int -> StringTableBuilder id -> ShowS
forall id. Show id => Int -> StringTableBuilder id -> ShowS
forall id. Show id => [StringTableBuilder id] -> ShowS
forall id. Show id => StringTableBuilder id -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringTableBuilder id] -> ShowS
$cshowList :: forall id. Show id => [StringTableBuilder id] -> ShowS
show :: StringTableBuilder id -> String
$cshow :: forall id. Show id => StringTableBuilder id -> String
showsPrec :: Int -> StringTableBuilder id -> ShowS
$cshowsPrec :: forall id. Show id => Int -> StringTableBuilder id -> ShowS
Show, Typeable)
empty :: StringTableBuilder id
empty :: forall id. StringTableBuilder id
empty = forall id. Map ByteString id -> Word32 -> StringTableBuilder id
StringTableBuilder forall k a. Map k a
Map.empty Word32
0
insert :: Enum id => BS.ByteString -> StringTableBuilder id -> (StringTableBuilder id, id)
insert :: forall id.
Enum id =>
ByteString -> StringTableBuilder id -> (StringTableBuilder id, id)
insert ByteString
str builder :: StringTableBuilder id
builder@(StringTableBuilder Map ByteString id
smap Word32
nextid) =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
str Map ByteString id
smap of
Just id
id -> (StringTableBuilder id
builder, id
id)
Maybe id
Nothing -> let !id :: id
id = forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nextid)
!smap' :: Map ByteString id
smap' = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ByteString
str id
id Map ByteString id
smap
in (forall id. Map ByteString id -> Word32 -> StringTableBuilder id
StringTableBuilder Map ByteString id
smap' (Word32
nextidforall a. Num a => a -> a -> a
+Word32
1), id
id)
inserts :: Enum id => [BS.ByteString] -> StringTableBuilder id -> (StringTableBuilder id, [id])
inserts :: forall id.
Enum id =>
[ByteString]
-> StringTableBuilder id -> (StringTableBuilder id, [id])
inserts [ByteString]
bss StringTableBuilder id
builder = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall id.
Enum id =>
ByteString -> StringTableBuilder id -> (StringTableBuilder id, id)
insert) StringTableBuilder id
builder [ByteString]
bss
finalise :: Enum id => StringTableBuilder id -> StringTable id
finalise :: forall id. Enum id => StringTableBuilder id -> StringTable id
finalise (StringTableBuilder Map ByteString id
smap Word32
_) =
(forall id.
ByteString
-> UArray Int32 Word32
-> UArray Int32 Int32
-> UArray Int32 Int32
-> StringTable id
StringTable ByteString
strs UArray Int32 Word32
offsets UArray Int32 Int32
ids UArray Int32 Int32
ixs)
where
strs :: ByteString
strs = [ByteString] -> ByteString
BS.concat (forall k a. Map k a -> [k]
Map.keys Map ByteString id
smap)
offsets :: UArray Int32 Word32
offsets = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (Int32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall k a. Map k a -> Int
Map.size Map ByteString id
smap))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Word32
off ByteString
str -> Word32
off forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
str)) Word32
0
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
Map.keys Map ByteString id
smap
ids :: UArray Int32 Int32
ids = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (Int32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall k a. Map k a -> Int
Map.size Map ByteString id
smap) forall a. Num a => a -> a -> a
- Int32
1)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum)
forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map ByteString id
smap
ixs :: UArray Int32 Int32
ixs = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds UArray Int32 Int32
ids) [ (Int32
id,Int32
ix) | (Int32
ix,Int32
id) <- forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
A.assocs UArray Int32 Int32
ids ]
unfinalise :: Enum id => StringTable id -> StringTableBuilder id
unfinalise :: forall id. Enum id => StringTable id -> StringTableBuilder id
unfinalise (StringTable ByteString
strs UArray Int32 Word32
offsets UArray Int32 Int32
ids UArray Int32 Int32
_) =
forall id. Map ByteString id -> Word32 -> StringTableBuilder id
StringTableBuilder Map ByteString id
smap Word32
nextid
where
smap :: Map ByteString id
smap = forall k a. Eq k => [(k, a)] -> Map k a
Map.fromAscList
[ (ByteString -> UArray Int32 Word32 -> Int32 -> ByteString
index' ByteString
strs UArray Int32 Word32
offsets Int32
ix, forall a. Enum a => Int -> a
toEnum (forall a b. (Integral a, Num b) => a -> b
fromIntegral (UArray Int32 Int32
ids forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int32
ix)))
| Int32
ix <- [Int32
0..Int32
h] ]
(Int32
0,Int32
h) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds UArray Int32 Int32
ids
nextid :: Word32
nextid = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
hforall a. Num a => a -> a -> a
+Int32
1)
serialise :: StringTable id -> BS.Builder
serialise :: forall id. StringTable id -> Builder
serialise (StringTable ByteString
strs UArray Int32 Word32
offs UArray Int32 Int32
ids UArray Int32 Int32
ixs) =
let (Int32
_, !Int32
ixEnd) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds UArray Int32 Word32
offs in
Word32 -> Builder
BS.word32BE (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
strs))
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BS.word32BE (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ixEnd forall a. Num a => a -> a -> a
+ Word32
1)
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BS.byteStringCopy ByteString
strs
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Word32
n Builder
r -> Word32 -> Builder
BS.word32BE Word32
n forall a. Semigroup a => a -> a -> a
<> Builder
r) forall a. Monoid a => a
mempty (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems UArray Int32 Word32
offs)
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int32
n Builder
r -> Int32 -> Builder
BS.int32BE Int32
n forall a. Semigroup a => a -> a -> a
<> Builder
r) forall a. Monoid a => a
mempty (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems UArray Int32 Int32
ids)
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Int32
n Builder
r -> Int32 -> Builder
BS.int32BE Int32
n forall a. Semigroup a => a -> a -> a
<> Builder
r) forall a. Monoid a => a
mempty (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
A.elems UArray Int32 Int32
ixs)
serialiseSize :: StringTable id -> Int
serialiseSize :: forall id. StringTable id -> Int
serialiseSize (StringTable ByteString
strs UArray Int32 Word32
offs UArray Int32 Int32
_ids UArray Int32 Int32
_ixs) =
let (Int32
_, !Int32
ixEnd) = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
A.bounds UArray Int32 Word32
offs
in Int
4 forall a. Num a => a -> a -> a
* Int
2
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
strs
forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ixEnd forall a. Num a => a -> a -> a
+ Int
1)
forall a. Num a => a -> a -> a
+ Int
8 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
ixEnd
deserialiseV1 :: BS.ByteString -> Maybe (StringTable id, BS.ByteString)
deserialiseV1 :: forall id. ByteString -> Maybe (StringTable id, ByteString)
deserialiseV1 ByteString
bs
| ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
>= Int
8
, let lenStrs :: Int
lenStrs = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
0)
lenArr :: Int
lenArr = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
4)
lenTotal :: Int
lenTotal= Int
8 forall a. Num a => a -> a -> a
+ Int
lenStrs forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* Int
lenArr
, ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
>= Int
lenTotal
, let strs :: ByteString
strs = Int -> ByteString -> ByteString
BS.take Int
lenStrs (Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs)
arr :: UArray Int32 Word32
arr = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (Int32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenArr forall a. Num a => a -> a -> a
- Int32
1)
[ (Int32
i, ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
off)
| (Int32
i, Int
off) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int32
0 .. forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenArr forall a. Num a => a -> a -> a
- Int32
1]
[Int
offArrS,Int
offArrSforall a. Num a => a -> a -> a
+Int
4 .. Int
offArrE]
]
ids :: UArray Int32 Int32
ids = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
A.array (Int32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenArr forall a. Num a => a -> a -> a
- Int32
1)
[ (Int32
i,Int32
i) | Int32
i <- [Int32
0 .. forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenArr forall a. Num a => a -> a -> a
- Int32
1] ]
ixs :: UArray Int32 Int32
ixs = UArray Int32 Int32
ids
offArrS :: Int
offArrS = Int
8 forall a. Num a => a -> a -> a
+ Int
lenStrs
offArrE :: Int
offArrE = Int
offArrS forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* Int
lenArr forall a. Num a => a -> a -> a
- Int
1
!stringTable :: StringTable id
stringTable = forall id.
ByteString
-> UArray Int32 Word32
-> UArray Int32 Int32
-> UArray Int32 Int32
-> StringTable id
StringTable ByteString
strs UArray Int32 Word32
arr UArray Int32 Int32
ids UArray Int32 Int32
ixs
!bs' :: ByteString
bs' = Int -> ByteString -> ByteString
BS.drop Int
lenTotal ByteString
bs
= forall a. a -> Maybe a
Just (forall {id}. StringTable id
stringTable, ByteString
bs')
| Bool
otherwise
= forall a. Maybe a
Nothing
deserialiseV2 :: BS.ByteString -> Maybe (StringTable id, BS.ByteString)
deserialiseV2 :: forall id. ByteString -> Maybe (StringTable id, ByteString)
deserialiseV2 ByteString
bs
| ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
>= Int
8
, let lenStrs :: Int
lenStrs = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
0)
lenArr :: Int
lenArr = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
4)
lenTotal :: Int
lenTotal= Int
8
forall a. Num a => a -> a -> a
+ Int
lenStrs
forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* Int
lenArr
forall a. Num a => a -> a -> a
+(Int
4 forall a. Num a => a -> a -> a
* (Int
lenArr forall a. Num a => a -> a -> a
- Int
1)) forall a. Num a => a -> a -> a
* Int
2
, ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
>= Int
lenTotal
, let strs :: ByteString
strs = Int -> ByteString -> ByteString
BS.take Int
lenStrs (Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs)
offs :: UArray Int32 Word32
offs = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (Int32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenArr forall a. Num a => a -> a -> a
- Int32
1)
[ ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
off
| Int
off <- Int -> [Int]
offsets Int
offsOff ]
ids :: UArray Int32 Int32
ids = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (Int32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenArr forall a. Num a => a -> a -> a
- Int32
2)
[ ByteString -> Int -> Int32
readInt32BE ByteString
bs Int
off
| Int
off <- Int -> [Int]
offsets Int
idsOff ]
ixs :: UArray Int32 Int32
ixs = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
A.listArray (Int32
0, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lenArr forall a. Num a => a -> a -> a
- Int32
2)
[ ByteString -> Int -> Int32
readInt32BE ByteString
bs Int
off
| Int
off <- Int -> [Int]
offsets Int
ixsOff ]
offsOff :: Int
offsOff = Int
8 forall a. Num a => a -> a -> a
+ Int
lenStrs
idsOff :: Int
idsOff = Int
offsOff forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* Int
lenArr
ixsOff :: Int
ixsOff = Int
idsOff forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* (Int
lenArrforall a. Num a => a -> a -> a
-Int
1)
offsets :: Int -> [Int]
offsets Int
from = [Int
from,Int
fromforall a. Num a => a -> a -> a
+Int
4 .. Int
from forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
* (Int
lenArr forall a. Num a => a -> a -> a
- Int
1)]
!stringTable :: StringTable id
stringTable = forall id.
ByteString
-> UArray Int32 Word32
-> UArray Int32 Int32
-> UArray Int32 Int32
-> StringTable id
StringTable ByteString
strs UArray Int32 Word32
offs UArray Int32 Int32
ids UArray Int32 Int32
ixs
!bs' :: ByteString
bs' = Int -> ByteString -> ByteString
BS.drop Int
lenTotal ByteString
bs
= forall a. a -> Maybe a
Just (forall {id}. StringTable id
stringTable, ByteString
bs')
| Bool
otherwise
= forall a. Maybe a
Nothing
readInt32BE :: BS.ByteString -> Int -> Int32
readInt32BE :: ByteString -> Int -> Int32
readInt32BE ByteString
bs Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
i)
readWord32BE :: BS.ByteString -> Int -> Word32
readWord32BE :: ByteString -> Int -> Word32
readWord32BE ByteString
bs Int
i =
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
i forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
iforall a. Num a => a -> a -> a
+Int
3 forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
BS.length ByteString
bs forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
0)) forall a. Bits a => a -> Int -> a
`shiftL` Int
24
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
1)) forall a. Bits a => a -> Int -> a
`shiftL` Int
16
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
2)) forall a. Bits a => a -> Int -> a
`shiftL` Int
8
forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.unsafeIndex ByteString
bs (Int
i forall a. Num a => a -> a -> a
+ Int
3))
#ifdef TESTS
prop_valid :: [BS.ByteString] -> Bool
prop_valid strs =
all lookupIndex (enumStrings tbl)
&& all indexLookup (enumIds tbl)
where
tbl :: StringTable Int
tbl = construct strs
lookupIndex str = index tbl ident == str
where Just ident = lookup tbl str
indexLookup ident = lookup tbl str == Just ident
where str = index tbl ident
prop_sorted :: [BS.ByteString] -> Bool
prop_sorted strings =
isSorted [ index' strs offsets ix
| ix <- A.range (A.bounds ids) ]
where
_tbl :: StringTable Int
_tbl@(StringTable strs offsets ids _ixs) = construct strings
isSorted xs = and (zipWith (<) xs (tail xs))
prop_finalise_unfinalise :: [BS.ByteString] -> Bool
prop_finalise_unfinalise strs =
builder == unfinalise (finalise builder)
where
builder :: StringTableBuilder Int
builder = foldl' (\tbl s -> fst (insert s tbl)) empty strs
prop_serialise_deserialise :: [BS.ByteString] -> Bool
prop_serialise_deserialise strs =
Just (strtable, BS.empty) == (deserialiseV2
. toStrict . BS.toLazyByteString
. serialise) strtable
where
strtable :: StringTable Int
strtable = construct strs
prop_serialiseSize :: [BS.ByteString] -> Bool
prop_serialiseSize strs =
(fromIntegral . LBS.length . BS.toLazyByteString . serialise) strtable
== serialiseSize strtable
where
strtable :: StringTable Int
strtable = construct strs
enumStrings :: Enum id => StringTable id -> [BS.ByteString]
enumStrings (StringTable bs offsets _ _) = map (index' bs offsets) [0..h-1]
where (0,h) = A.bounds offsets
enumIds :: Enum id => StringTable id -> [id]
enumIds (StringTable _ offsets _ _) = [toEnum 0 .. toEnum (fromIntegral (h-1))]
where (0,h) = A.bounds offsets
toStrict :: LBS.ByteString -> BS.ByteString
#if MIN_VERSION_bytestring(0,10,0)
toStrict = LBS.toStrict
#else
toStrict = BS.concat . LBS.toChunks
#endif
#endif
#if !(MIN_VERSION_base(4,5,0))
(<>) :: Monoid m => m -> m -> m
(<>) = mappend
#endif