{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}

{-|
Module      : Hyax.Abif.Read
Description : Read and parse AB1 files
Copyright   : (c) HyraxBio, 2018
License     : BSD3
Maintainer  : andre@hyraxbio.co.za, andre@andrevdm.com
Stability   : beta

Functionality for reading and parsing AB1 files

e.g.

@
abif' <- readAbif "example.ab1"

case abif' of
  Left e -> putStrLn $ "error reading ABIF: " <> e
  Right abif -> print $ clearAbif abif
@
-}
module Hyrax.Abif.Read
    ( readAbif
    , getAbif
    , clear
    , clearAbif
    , getDebug
    , getPString
    , getCString
    , getHeader
    , getRoot
    , getDirectories
    , getDirectory
    ) where

import           Verset
import qualified Data.Text as Txt
import qualified Data.Text.Encoding as TxtE
import qualified Data.Binary as B
import qualified Data.Binary.Get as B
import qualified Data.ByteString.Lazy as BSL
import           Control.Monad.Fail (fail)

import           Hyrax.Abif


-- | Read and parse an AB1 file
readAbif :: FilePath -> IO (Either Text Abif)
readAbif :: String -> IO (Either Text Abif)
readAbif String
path = ByteString -> Either Text Abif
getAbif (ByteString -> Either Text Abif)
-> IO ByteString -> IO (Either Text Abif)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BSL.readFile String
path


-- | Parse an AB1 from a 'ByteString'
getAbif :: BSL.ByteString -> Either Text Abif
getAbif :: ByteString -> Either Text Abif
getAbif ByteString
bs = do
  (Header
header, Directory
rootDir) <- case Get (Header, Directory)
-> ByteString
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (Header, Directory))
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
B.runGetOrFail (ByteString -> Get (Header, Directory)
getRoot ByteString
bs) ByteString
bs of
                         Right (ByteString
_, Int64
_, (Header, Directory)
x) -> (Header, Directory) -> Either Text (Header, Directory)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header, Directory)
x
                         Left (ByteString
_, Int64
_, String
e) -> Text -> Either Text (Header, Directory)
forall a b. a -> Either a b
Left (Text
"Error reading root: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Txt.pack String
e)

  let dirBytes :: ByteString
dirBytes = Int64 -> ByteString -> ByteString
BSL.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dDataOffset Directory
rootDir) ByteString
bs
  
  [Directory]
ds <- case Get [Directory]
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, [Directory])
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
B.runGetOrFail (ByteString -> [Directory] -> Int -> Get [Directory]
getDirectories ByteString
bs [] (Int -> Get [Directory]) -> Int -> Get [Directory]
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dElemNum Directory
rootDir) ByteString
dirBytes of
          Right (ByteString
_, Int64
_, [Directory]
x) -> [Directory] -> Either Text [Directory]
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Directory]
x
          Left (ByteString
_, Int64
_, String
e) -> Text -> Either Text [Directory]
forall a b. a -> Either a b
Left (Text
"Error reading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Directory -> Int
dElemNum Directory
rootDir) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" directories (at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Directory -> Int
dDataOffset Directory
rootDir) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Txt.pack String
e)
  
  Abif -> Either Text Abif
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Abif -> Either Text Abif) -> Abif -> Either Text Abif
forall a b. (a -> b) -> a -> b
$ Header -> Directory -> [Directory] -> Abif
Abif Header
header Directory
rootDir [Directory]
ds


-- | Removes all data from the ABIF's directories
clearAbif :: Abif -> Abif
clearAbif :: Abif -> Abif
clearAbif Abif
a = Abif
a { aRootDir = clear $ aRootDir a
               , aDirs = clear <$> aDirs a
               }


-- | Removes all data from a directory entry. This will probably only be useful when trying to show an ABIF value
clear :: Directory -> Directory
clear :: Directory -> Directory
clear Directory
d = Directory
d { dData = "" }


-- | Populate the directory entry with debug data (into 'dDataDebug').
-- This is done for selected types only, e.g. for strings so that printing the structure will display
-- readable/meaningfull info
getDebug :: Directory -> Directory
getDebug :: Directory -> Directory
getDebug Directory
d =
  let bsAtOffset :: ByteString
bsAtOffset = Directory -> ByteString
dData Directory
d in
  
  case Directory -> ElemType
dElemType Directory
d of
    -- Strings have a count = number of chars, not number of "strings"
    ElemType
ElemPString ->
      if Directory -> Int
dDataSize Directory
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4
      then Directory
d { dDataDebug = [TxtE.decodeUtf8 . BSL.toStrict . BSL.drop 1 . BSL.take (fromIntegral $ dDataSize d) $ dData d] }
      else Directory
d { dDataDebug = [B.runGet (lbl getPString) bsAtOffset] }

    -- Strings have a count = number of chars, not number of "strings"
    ElemType
ElemCString ->
      if Directory -> Int
dDataSize Directory
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4
      then Directory
d { dDataDebug = [TxtE.decodeUtf8 . BSL.toStrict . BSL.take (fromIntegral $ dDataSize d - 1) $ dData d] }
      else Directory
d { dDataDebug = [B.runGet (lbl . getCString $ dDataSize d) bsAtOffset] }

    ElemType
y ->
      -- For non-array entries
      if Directory -> Int
dElemNum Directory
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
      then 
        case ElemType
y of
          ElemType
ElemDate -> 
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              Int16
yy <- Get Int16
B.getInt16be
              Int8
mt <- Get Int8
B.getInt8
              Int8
dt <- Get Int8
B.getInt8
              Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Directory
d { dDataDebug = [show yy <> "/" <> show mt <> "/" <> show dt]}
             
          ElemType
ElemTime ->
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              Int8
hr <- Get Int8
B.getInt8
              Int8
mn <- Get Int8
B.getInt8
              Int8
sc <- Get Int8
B.getInt8
              Int8
ss <- Get Int8
B.getInt8
              Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug = [show hr <> ":" <> show mn <> ":" <> show sc <> "." <> show ss] }
             
          ElemType
ElemLong ->
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              Int32
x <- Get Int32
B.getInt32be
              Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug =  [show x] }
             
          ElemType
ElemShort ->
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              Int16
x <- Get Int16
B.getInt16be
              Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug = [show x] }
             
          ElemType
ElemFloat ->
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              Float
x <- Get Float
B.getFloatbe
              Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug = [show x] }
             
          ElemType
ElemWord ->
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              Int8
x <- Get Int8
B.getInt8
              Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug = [show x] }
             
          ElemType
ElemChar ->
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              Word8
x <- Get Word8
B.getWord8
              let c :: ByteString
c = [Word8] -> ByteString
BSL.pack [Word8
x]
              Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug = [TxtE.decodeUtf8 . BSL.toStrict $ c] }
              
          ElemType
_ -> Directory
d
      else
        case ElemType
y of
          ElemType
ElemChar -> -- Array of chars can be treated as a string
            (Get Directory -> ByteString -> Directory)
-> ByteString -> Get Directory -> Directory
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get Directory -> ByteString -> Directory
forall a. Get a -> ByteString -> a
B.runGet (Directory -> ByteString
dData Directory
d) (Get Directory -> Directory) -> Get Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Get Directory -> Get Directory
forall {a}. Get a -> Get a
lbl (Get Directory -> Get Directory) -> Get Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ do
              [Word8]
cs <- Get Word8 -> Get [Word8]
forall n. Get n -> Get [n]
readArray Get Word8
B.getWord8
              case Directory -> Text
dTagName Directory
d of
                Text
"PCON" -> Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Directory
d { dDataDebug = [show cs] }
                Text
_ -> do
                  let c :: ByteString
c = [Word8] -> ByteString
BSL.pack [Word8]
cs
                  Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug = [TxtE.decodeUtf8 . BSL.toStrict $ c] }

          --ElemShort ->
          --  flip B.runGet (dData d) $ lbl $ do
          --    xs <- readArray B.getInt16be
          --    pure $ d { dDataDebug = [show xs] }

          ElemType
_ -> Directory
d -- Do nothing

  where
    lbl :: Get a -> Get a
lbl = String -> Get a -> Get a
forall a. String -> Get a -> Get a
B.label (String -> Get a -> Get a) -> String -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ String
"Reading " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. (Show a, StringConv String b) => a -> b
show (Directory -> Text
dElemTypeDesc Directory
d) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" data size=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, StringConv String b) => a -> b
show (Directory -> Int
dDataSize Directory
d) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" dir entry=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Txt.unpack (Directory -> Text
dTagName Directory
d) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" cached data size=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Int64 -> String
forall a b. (Show a, StringConv String b) => a -> b
show (Int64 -> String) -> (ByteString -> Int64) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Int64
BSL.length (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Directory -> ByteString
dData Directory
d) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". "

    readArray :: B.Get n -> B.Get [n]
    readArray :: forall n. Get n -> Get [n]
readArray Get n
getFn = do
      Bool
e <- Get Bool
B.isEmpty
      if Bool
e then [n] -> Get [n]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      else do
        n
c <- Get n
getFn
        [n]
cs <- Get n -> Get [n]
forall n. Get n -> Get [n]
readArray Get n
getFn
        [n] -> Get [n]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (n
cn -> [n] -> [n]
forall a. a -> [a] -> [a]
:[n]
cs)


-- | Parse a 'ElemPString'
getPString :: B.Get Text
getPString :: Get Text
getPString = do
  Int
sz <- Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
B.getInt8
  ByteString -> Text
TxtE.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Get ByteString -> Get ByteString
forall a. String -> Get a -> Get a
B.label (String
"PString length=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, StringConv String b) => a -> b
show Int
sz String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".") (Int -> Get ByteString
B.getByteString Int
sz)


-- | Parse a 'ElemCString'
getCString :: Int -> B.Get Text
getCString :: Int -> Get Text
getCString Int
sz = 
  ByteString -> Text
TxtE.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
B.getByteString (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)


-- | Parse the ABIF 'Header'
getHeader :: B.Get Header
getHeader :: Get Header
getHeader = 
  Text -> Int -> Header
Header (Text -> Int -> Header) -> Get Text -> Get (Int -> Header)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Text
TxtE.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
B.getByteString Int
4)
         Get (Int -> Header) -> Get Int -> Get Header
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
B.getInt16be)


-- | Parse the root ('Header' and 'Directory')
getRoot :: BSL.ByteString -> B.Get (Header, Directory)
getRoot :: ByteString -> Get (Header, Directory)
getRoot ByteString
bs = do
  Header
h <- Get Header
getHeader
  Directory
rd <- ByteString -> Get Directory
getDirectory ByteString
bs
  (Header, Directory) -> Get (Header, Directory)
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header
h, Directory
rd)


-- | Parse a single 'Directory' entry and read its data
getDirectory :: BSL.ByteString -> B.Get Directory
getDirectory :: ByteString -> Get Directory
getDirectory ByteString
bs = do
  Text
tagName <- ByteString -> Text
TxtE.decodeUtf8 (ByteString -> Text) -> Get ByteString -> Get Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
B.getByteString Int
4
  Int
tagNum <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
B.getInt32be
  Int
typeCode <- Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
B.getInt16be
  Int
elemSize <- Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
B.getInt16be
  Int
elemNum <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
B.getInt32be
  Int
dataSize <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
B.getInt32be
  ByteString
offsetDataBytes <- Get ByteString -> Get ByteString
forall {a}. Get a -> Get a
B.lookAhead (Get ByteString -> Get ByteString)
-> Get ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> Get ByteString
B.getLazyByteString Int64
4
  Int
dataOffset <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
B.getInt32be

  -- Read the data
  --  Data that is 4 bytes or less is stored in the offset field
  ByteString
dataBytes <- if Int
dataSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4
                    then ByteString -> Get ByteString
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Get ByteString) -> ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.take (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) ByteString
offsetDataBytes
                    else case Get ByteString
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ByteString)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
B.runGetOrFail (Int64 -> Get ByteString
B.getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) (ByteString
 -> Either
      (ByteString, Int64, String) (ByteString, Int64, ByteString))
-> ByteString
-> Either
     (ByteString, Int64, String) (ByteString, Int64, ByteString)
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataOffset) ByteString
bs of
                           Right (ByteString
_, Int64
_, ByteString
x) -> ByteString -> Get ByteString
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x
                           Left (ByteString
_, Int64
_, String
e) -> String -> Get ByteString
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ByteString) -> String -> Get ByteString
forall a b. (a -> b) -> a -> b
$ String
"error reading data (" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, StringConv String b) => a -> b
show Int
dataSize String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" bytes starting at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, StringConv String b) => a -> b
show Int
dataOffset String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") for directory entry '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Txt.unpack Text
tagName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"': " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e

  let (ElemType
elemType, Text
elemCode) = Int -> (ElemType, Text)
describeElemType Int
typeCode
  Directory -> Get Directory
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Directory { dTagName :: Text
dTagName = Text
tagName 
                 , dTagNum :: Int
dTagNum = Int
tagNum 
                 , dElemTypeCode :: Int
dElemTypeCode = Int
typeCode 
                 , dElemTypeDesc :: Text
dElemTypeDesc = Text
elemCode 
                 , dElemType :: ElemType
dElemType = ElemType
elemType 
                 , dElemSize :: Int
dElemSize = Int
elemSize 
                 , dElemNum :: Int
dElemNum = Int
elemNum 
                 , dDataSize :: Int
dDataSize = Int
dataSize 
                 , dDataOffset :: Int
dDataOffset = Int
dataOffset 
                 , dData :: ByteString
dData = ByteString
dataBytes 
                 , dDataDebug :: [Text]
dDataDebug = []
                 } 


-- | Parse all the directoy entries
getDirectories :: BSL.ByteString -> [Directory] -> Int -> B.Get [Directory]
getDirectories :: ByteString -> [Directory] -> Int -> Get [Directory]
getDirectories ByteString
_ [Directory]
acc Int
0 = [Directory] -> Get [Directory]
forall a. a -> Get a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Directory]
acc
getDirectories ByteString
bs [Directory]
acc Int
more = do
  Directory
d <- ByteString -> Get Directory
getDirectory ByteString
bs
  Int -> Get ()
B.skip Int
4 -- Skip the reserved field
  ByteString -> [Directory] -> Int -> Get [Directory]
getDirectories ByteString
bs ([Directory]
acc [Directory] -> [Directory] -> [Directory]
forall a. Semigroup a => a -> a -> a
<> [Directory
d]) (Int
more Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)