{-# LANGUAGE ExplicitNamespaces, OverloadedStrings, Rank2Types,
             TypeOperators #-}
module HMGit.Internal.Parser.Index (
    IndexEntry (..)
  , indexParser
  , putIndex
) where

import           HMGit.Internal.Parser.Core.ByteString
import           HMGit.Internal.Utils                  (foldMapM)

import qualified Codec.Binary.UTF8.String              as BUS
import           Control.Monad.Extra                   (ifM, orM, replicateM_)
import           Control.Monad.Loops                   (unfoldM)
import           Control.Natural                       (type (~>))
import           Crypto.Hash.SHA1                      (hashlazy)
import qualified Data.Binary.Get                       as BG
import qualified Data.Binary.Put                       as BP
import qualified Data.ByteString.Char8                 as BC
import qualified Data.ByteString.Lazy                  as BL
import           Data.Char                             (ord)
import           Data.Functor                          ((<&>))
import           Data.Tuple.Extra                      (thd3)
import           Data.Word                             (Word16, Word32)
import qualified Path                                  as P
import           Prelude                               hiding (null)
import qualified Text.Megaparsec                       as M
import           Text.Printf                           (printf)

-- ^ Index format, ref. https://github.com/git/git/blob/v2.17.1/Documentation/technical/index-format.txt#L9-L17
data IndexHeader = IndexHeader {
    IndexHeader -> ByteString
ihSignature  :: BL.ByteString   -- ^ The signature is { 'D', 'I', 'R', 'C' } (stands for "dircache")
  , IndexHeader -> Word32
ihVersion    :: Word32          -- ^ The current supported versions are 2, 3 and 4.
  , IndexHeader -> Word32
ihNumEntries :: Word32          -- ^ Number of index entries.
  }
  deriving Int -> IndexHeader -> ShowS
[IndexHeader] -> ShowS
IndexHeader -> String
(Int -> IndexHeader -> ShowS)
-> (IndexHeader -> String)
-> ([IndexHeader] -> ShowS)
-> Show IndexHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexHeader] -> ShowS
$cshowList :: [IndexHeader] -> ShowS
show :: IndexHeader -> String
$cshow :: IndexHeader -> String
showsPrec :: Int -> IndexHeader -> ShowS
$cshowsPrec :: Int -> IndexHeader -> ShowS
Show

putIndexHeader :: Word32 -> BP.Put
putIndexHeader :: Word32 -> Put
putIndexHeader Word32
len = ByteString -> Put
BP.putByteString ByteString
"DIRC"
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be Word32
2
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be Word32
len

-- ^ Index entry, ref. https://github.com/git/git/blob/v2.17.1/Documentation/technical/index-format.txt#L38
data IndexEntry = IndexEntry {
    IndexEntry -> Word32
ieCtimeS :: Word32          -- ^ the last time a file's metadata changed,  this is stat(2) data
  , IndexEntry -> Word32
ieCtimeN :: Word32          -- ^ nanosecond fractions, this is stat(2) data
  , IndexEntry -> Word32
ieMTimeS :: Word32          -- ^ mtime seconds, the last time a file's data changed, this is stat(2) data
  , IndexEntry -> Word32
ieMTimeN :: Word32          -- ^ mtime nanosecond fractions, this is stat(2) data
  , IndexEntry -> Word32
ieDev    :: Word32          -- ^ this is stat(2) data
  , IndexEntry -> Word32
ieIno    :: Word32          -- ^ this is stat(2) data
  , IndexEntry -> Word32
ieMode   :: Word32          -- ^ mode, split into (high to low bits)
  , IndexEntry -> Word32
ieUid    :: Word32          -- ^ this is stat(2) data
  , IndexEntry -> Word32
ieGid    :: Word32          -- ^ this is stat(2) data
  , IndexEntry -> Word32
ieSize   :: Word32          -- ^ This is the on-disk size from stat(2), truncated to 32-bit.
  , IndexEntry -> ByteString
ieSha1   :: BL.ByteString   -- ^ 160-bit SHA-1 for the represented object
  , IndexEntry -> Word16
ieFlags  :: Word16          -- ^ A 16-bit 'flags' field split into (high to low bits)
  , IndexEntry -> Path Rel File
iePath   :: P.Path P.Rel P.File
  }
  deriving Int -> IndexEntry -> ShowS
[IndexEntry] -> ShowS
IndexEntry -> String
(Int -> IndexEntry -> ShowS)
-> (IndexEntry -> String)
-> ([IndexEntry] -> ShowS)
-> Show IndexEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexEntry] -> ShowS
$cshowList :: [IndexEntry] -> ShowS
show :: IndexEntry -> String
$cshow :: IndexEntry -> String
showsPrec :: Int -> IndexEntry -> ShowS
$cshowsPrec :: Int -> IndexEntry -> ShowS
Show

putIndexEntry :: IndexEntry -> BP.Put
putIndexEntry :: IndexEntry -> Put
putIndexEntry IndexEntry
ie = Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieCtimeS IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieCtimeN IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieMTimeS IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieMTimeN IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieDev IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieIno IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieMode IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieUid IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieGid IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word32 -> Put
BP.putWord32be (IndexEntry -> Word32
ieSize IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> Put
BP.putLazyByteString (IndexEntry -> ByteString
ieSha1 IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Word16 -> Put
BP.putWord16be (IndexEntry -> Word16
ieFlags IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> Put
BP.putByteString (String -> ByteString
BC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Path Rel File -> String
forall b t. Path b t -> String
P.toFilePath (Path Rel File -> String) -> Path Rel File -> String
forall a b. (a -> b) -> a -> b
$ IndexEntry -> Path Rel File
iePath IndexEntry
ie)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
packedLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
62 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pLen) (Word8 -> Put
BP.putWord8 Word8
0)
    where
        pLen :: Int
pLen = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Path Rel File -> String
forall b t. Path b t -> String
P.toFilePath (Path Rel File -> String) -> Path Rel File -> String
forall a b. (a -> b) -> a -> b
$ IndexEntry -> Path Rel File
iePath IndexEntry
ie
        packedLen :: Int
packedLen = ((Int
62 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8

putIndex :: Foldable t => t IndexEntry -> BP.Put
putIndex :: t IndexEntry -> Put
putIndex t IndexEntry
ies = Word32 -> Put
putIndexHeader (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ t IndexEntry -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t IndexEntry
ies)
    Put -> Put -> Put
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (IndexEntry -> Put) -> t IndexEntry -> Put
forall (m :: * -> *) w (t :: * -> *) a.
(Monad m, Monoid w, Foldable t) =>
(a -> m w) -> t a -> m w
foldMapM IndexEntry -> Put
putIndexEntry t IndexEntry
ies

fromBinaryGetter' :: BG.Get ~> ByteStringParser
fromBinaryGetter' :: Get x -> ByteStringParser x
fromBinaryGetter' = (String -> ParseException) -> Get ~> ByteStringParser
fromBinaryGetter String -> ParseException
IndexParser

indexHeader :: ByteStringParser IndexHeader
indexHeader :: ByteStringParser IndexHeader
indexHeader = ParsecT ParseException ByteString Identity ()
setBody
    ParsecT ParseException ByteString Identity ()
-> ParsecT ParseException ByteString Identity [Word8]
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int
-> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count Int
12 ParsecT ParseException ByteString Identity Word8
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle
    ParsecT ParseException ByteString Identity [Word8]
-> ([Word8] -> ByteStringParser IndexHeader)
-> ByteStringParser IndexHeader
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((ByteString, ByteOffset, String) -> ByteStringParser IndexHeader)
-> ((ByteString, ByteOffset, IndexHeader)
    -> ByteStringParser IndexHeader)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, IndexHeader)
-> ByteStringParser IndexHeader
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseException -> ByteStringParser IndexHeader
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseException -> ByteStringParser IndexHeader)
-> ((ByteString, ByteOffset, String) -> ParseException)
-> (ByteString, ByteOffset, String)
-> ByteStringParser IndexHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseException
IndexParser (String -> ParseException)
-> ((ByteString, ByteOffset, String) -> String)
-> (ByteString, ByteOffset, String)
-> ParseException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteOffset, String) -> String
forall a b c. (a, b, c) -> c
thd3) (ByteString, ByteOffset, IndexHeader)
-> ByteStringParser IndexHeader
idxHeader
     (Either
   (ByteString, ByteOffset, String)
   (ByteString, ByteOffset, IndexHeader)
 -> ByteStringParser IndexHeader)
-> ([Word8]
    -> Either
         (ByteString, ByteOffset, String)
         (ByteString, ByteOffset, IndexHeader))
-> [Word8]
-> ByteStringParser IndexHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Get IndexHeader
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, IndexHeader)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
BG.runGetOrFail (ByteString -> Word32 -> Word32 -> IndexHeader
IndexHeader (ByteString -> Word32 -> Word32 -> IndexHeader)
-> Get ByteString -> Get (Word32 -> Word32 -> IndexHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteOffset -> Get ByteString
BG.getLazyByteString ByteOffset
4 Get (Word32 -> Word32 -> IndexHeader)
-> Get Word32 -> Get (Word32 -> IndexHeader)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be Get (Word32 -> IndexHeader) -> Get Word32 -> Get IndexHeader
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be)
     (ByteString
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, IndexHeader))
-> ([Word8] -> ByteString)
-> [Word8]
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, IndexHeader)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  [Word8] -> ByteString
BL.pack
    where
        setBody :: ParsecT ParseException ByteString Identity ()
setBody = do
            ByteString
indexData <- ParsecT ParseException ByteString Identity ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
M.getInput
            let (ByteString
body, ByteString
sha1) = ByteOffset -> ByteString -> (ByteString, ByteString)
BL.splitAt (ByteString -> ByteOffset
BL.length ByteString
indexData ByteOffset -> ByteOffset -> ByteOffset
forall a. Num a => a -> a -> a
- ByteOffset
20) ByteString
indexData
            if ByteString -> ByteString
hashlazy ByteString
body ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> ByteString
BL.toStrict ByteString
sha1 then
                ParseException -> ParsecT ParseException ByteString Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseException -> ParsecT ParseException ByteString Identity ())
-> ParseException -> ParsecT ParseException ByteString Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParseException
IndexParser String
"invalid index checksum"
            else
                ByteString -> ParsecT ParseException ByteString Identity ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
M.setInput ByteString
body

        idxHeader :: (BL.ByteString, BG.ByteOffset, IndexHeader) -> ByteStringParser IndexHeader
        idxHeader :: (ByteString, ByteOffset, IndexHeader)
-> ByteStringParser IndexHeader
idxHeader (ByteString
unconsumed, ByteOffset
nConsumed, IndexHeader
val)
            | ByteString -> Bool
BL.null ByteString
unconsumed Bool -> Bool -> Bool
&& ByteOffset
nConsumed ByteOffset -> ByteOffset -> Bool
forall a. Eq a => a -> a -> Bool
== ByteOffset
12 = IndexHeader -> ByteStringParser IndexHeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexHeader
val
            | Bool
otherwise = ParseException -> ByteStringParser IndexHeader
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseException -> ByteStringParser IndexHeader)
-> ParseException -> ByteStringParser IndexHeader
forall a b. (a -> b) -> a -> b
$ String -> ParseException
IndexParser String
"expected consumed size number is 12"

lookSignature :: IndexHeader -> ByteStringParser IndexHeader
lookSignature :: IndexHeader -> ByteStringParser IndexHeader
lookSignature IndexHeader
ih
    | IndexHeader -> ByteString
ihSignature IndexHeader
ih ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"DIRC" = IndexHeader -> ByteStringParser IndexHeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexHeader
ih
    | Bool
otherwise = ParseException -> ByteStringParser IndexHeader
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseException -> ByteStringParser IndexHeader)
-> ParseException -> ByteStringParser IndexHeader
forall a b. (a -> b) -> a -> b
$ String -> ParseException
IndexParser String
"invalid index signature"

lookVersion :: IndexHeader -> ByteStringParser IndexHeader
lookVersion :: IndexHeader -> ByteStringParser IndexHeader
lookVersion IndexHeader
ih
    | IndexHeader -> Word32
ihVersion IndexHeader
ih Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
2 = IndexHeader -> ByteStringParser IndexHeader
forall (f :: * -> *) a. Applicative f => a -> f a
pure IndexHeader
ih
    | Bool
otherwise = ParseException -> ByteStringParser IndexHeader
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseException -> ByteStringParser IndexHeader)
-> ParseException -> ByteStringParser IndexHeader
forall a b. (a -> b) -> a -> b
$ String -> ParseException
IndexParser String
"unknown index version"

indexBody :: Word32 -> ByteStringParser [IndexEntry]
indexBody :: Word32 -> ByteStringParser [IndexEntry]
indexBody Word32
expectedEntriesNum = ParsecT ParseException ByteString Identity (Maybe IndexEntry)
-> ByteStringParser [IndexEntry]
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
unfoldM (ParsecT ParseException ByteString Identity Bool
-> ParsecT ParseException ByteString Identity (Maybe IndexEntry)
-> ParsecT ParseException ByteString Identity (Maybe IndexEntry)
-> ParsecT ParseException ByteString Identity (Maybe IndexEntry)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ParsecT ParseException ByteString Identity Bool
stopConditions (Maybe IndexEntry
-> ParsecT ParseException ByteString Identity (Maybe IndexEntry)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe IndexEntry
forall a. Maybe a
Nothing) ParsecT ParseException ByteString Identity (Maybe IndexEntry)
idxField)
    ByteStringParser [IndexEntry]
-> ([IndexEntry] -> ByteStringParser [IndexEntry])
-> ByteStringParser [IndexEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [IndexEntry] -> ByteStringParser [IndexEntry]
lookNumEntries
    where
        stopConditions :: ParsecT ParseException ByteString Identity Bool
stopConditions = [ParsecT ParseException ByteString Identity Bool]
-> ParsecT ParseException ByteString Identity Bool
forall (m :: * -> *). Monad m => [m Bool] -> m Bool
orM [
            ParsecT ParseException ByteString Identity Bool
forall e s (m :: * -> *). MonadParsec e s m => m Bool
M.atEnd
          , (ByteOffset
62ByteOffset -> ByteOffset -> Bool
forall a. Ord a => a -> a -> Bool
>) (ByteOffset -> Bool)
-> (ByteString -> ByteOffset) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteOffset
BL.length (ByteString -> Bool)
-> ParsecT ParseException ByteString Identity ByteString
-> ParsecT ParseException ByteString Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseException ByteString Identity ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
M.getInput
            -- > If the first byte is 'A'..'Z' the extension is optional and can be ignored.
            -- ref. https://github.com/git/git/blob/v2.17.1/Documentation/technical/index-format.txt#L28-L29
          , Bool
-> ParsecT ParseException ByteString Identity Bool
-> ParsecT ParseException ByteString Identity Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
M.option Bool
False (Bool
True Bool
-> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity Word8
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
M.lookAhead ((Token ByteString -> Bool)
-> ParsecT ParseException ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
M.satisfy ((Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
ord [Char
'A'..Char
'Z']) (Int -> Bool) -> (Word8 -> Int) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)))
          ]

        fileModeRegular :: Get Word32
fileModeRegular = Get Word32
BG.getWord32be
            Get Word32 -> (Word32 -> Word32) -> Get Word32
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Word32
x -> if Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0o100664 then Word32
0o100644 else Word32
x

        idxField :: ParsecT ParseException ByteString Identity (Maybe IndexEntry)
idxField = do
            Path Rel File -> IndexEntry
entry <- Get (Path Rel File -> IndexEntry)
-> ByteStringParser (Path Rel File -> IndexEntry)
Get ~> ByteStringParser
fromBinaryGetter' (Get (Path Rel File -> IndexEntry)
 -> ByteStringParser (Path Rel File -> IndexEntry))
-> Get (Path Rel File -> IndexEntry)
-> ByteStringParser (Path Rel File -> IndexEntry)
forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> Word32
-> ByteString
-> Word16
-> Path Rel File
-> IndexEntry
IndexEntry
                (Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> Word32
 -> ByteString
 -> Word16
 -> Path Rel File
 -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> ByteString
      -> Word16
      -> Path Rel File
      -> IndexEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
BG.getWord32be
                Get
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> ByteString
   -> Word16
   -> Path Rel File
   -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> ByteString
      -> Word16
      -> Path Rel File
      -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> ByteString
   -> Word16
   -> Path Rel File
   -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> ByteString
      -> Word16
      -> Path Rel File
      -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> ByteString
   -> Word16
   -> Path Rel File
   -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> ByteString
      -> Word16
      -> Path Rel File
      -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> ByteString
   -> Word16
   -> Path Rel File
   -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> Word32
      -> ByteString
      -> Word16
      -> Path Rel File
      -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> Word32
   -> ByteString
   -> Word16
   -> Path Rel File
   -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Word32
      -> Word32
      -> ByteString
      -> Word16
      -> Path Rel File
      -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get
  (Word32
   -> Word32
   -> Word32
   -> Word32
   -> ByteString
   -> Word16
   -> Path Rel File
   -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32
      -> Word32
      -> ByteString
      -> Word16
      -> Path Rel File
      -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
fileModeRegular
                Get
  (Word32
   -> Word32
   -> Word32
   -> ByteString
   -> Word16
   -> Path Rel File
   -> IndexEntry)
-> Get Word32
-> Get
     (Word32
      -> Word32 -> ByteString -> Word16 -> Path Rel File -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get
  (Word32
   -> Word32 -> ByteString -> Word16 -> Path Rel File -> IndexEntry)
-> Get Word32
-> Get
     (Word32 -> ByteString -> Word16 -> Path Rel File -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get (Word32 -> ByteString -> Word16 -> Path Rel File -> IndexEntry)
-> Get Word32
-> Get (ByteString -> Word16 -> Path Rel File -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
BG.getWord32be
                Get (ByteString -> Word16 -> Path Rel File -> IndexEntry)
-> Get ByteString -> Get (Word16 -> Path Rel File -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteOffset -> Get ByteString
BG.getLazyByteString ByteOffset
20
                Get (Word16 -> Path Rel File -> IndexEntry)
-> Get Word16 -> Get (Path Rel File -> IndexEntry)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
BG.getWord16be
            (Path Rel File -> IndexEntry)
-> Maybe (Path Rel File) -> Maybe IndexEntry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Rel File -> IndexEntry
entry (Maybe (Path Rel File) -> Maybe IndexEntry)
-> ([Word8] -> Maybe (Path Rel File))
-> [Word8]
-> Maybe IndexEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
P.parseRelFile (String -> Maybe (Path Rel File))
-> ([Word8] -> String) -> [Word8] -> Maybe (Path Rel File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> String
BUS.decode
                ([Word8] -> Maybe IndexEntry)
-> ParsecT ParseException ByteString Identity [Word8]
-> ParsecT ParseException ByteString Identity (Maybe IndexEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill (Token ByteString
-> ParsecT ParseException ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.anySingleBut Token ByteString
0) ParsecT ParseException ByteString Identity Word8
null
                ParsecT ParseException ByteString Identity (Maybe IndexEntry)
-> ParsecT ParseException ByteString Identity [Word8]
-> ParsecT ParseException ByteString Identity (Maybe IndexEntry)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Int
-> Int
-> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a. MonadPlus m => Int -> Int -> m a -> m [a]
M.count' Int
0 Int
7 ParsecT ParseException ByteString Identity Word8
null

        lookNumEntries :: [IndexEntry] -> ByteStringParser [IndexEntry]
        lookNumEntries :: [IndexEntry] -> ByteStringParser [IndexEntry]
lookNumEntries [IndexEntry]
entries
            | [IndexEntry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IndexEntry]
entries Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
expectedEntriesNum = ParseException -> ByteStringParser [IndexEntry]
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure
                (ParseException -> ByteStringParser [IndexEntry])
-> ParseException -> ByteStringParser [IndexEntry]
forall a b. (a -> b) -> a -> b
$ String -> ParseException
IndexParser
                (String -> ParseException) -> String -> ParseException
forall a b. (a -> b) -> a -> b
$ String -> Word32 -> Int -> String
forall r. PrintfType r => String -> r
printf String
"expected number of entries is %d, but got %d entries" Word32
expectedEntriesNum
                (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ [IndexEntry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IndexEntry]
entries
            | Bool
otherwise = [IndexEntry] -> ByteStringParser [IndexEntry]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [IndexEntry]
entries

indexParser :: ByteStringParser [IndexEntry]
indexParser :: ByteStringParser [IndexEntry]
indexParser = ByteStringParser IndexHeader
indexHeader
    ByteStringParser IndexHeader
-> (IndexHeader -> ByteStringParser IndexHeader)
-> ByteStringParser IndexHeader
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IndexHeader -> ByteStringParser IndexHeader
lookSignature
    ByteStringParser IndexHeader
-> (IndexHeader -> ByteStringParser IndexHeader)
-> ByteStringParser IndexHeader
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IndexHeader -> ByteStringParser IndexHeader
lookVersion
    ByteStringParser IndexHeader
-> (IndexHeader -> ByteStringParser [IndexEntry])
-> ByteStringParser [IndexEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> ByteStringParser [IndexEntry]
indexBody (Word32 -> ByteStringParser [IndexEntry])
-> (IndexHeader -> Word32)
-> IndexHeader
-> ByteStringParser [IndexEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexHeader -> Word32
ihNumEntries