{-# 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           Protolude
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 :: FilePath -> IO (Either Text Abif)
readAbif path :: FilePath
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
<$> FilePath -> IO ByteString
BSL.readFile FilePath
path


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

  let dirBytes :: ByteString
dirBytes = ByteOffset -> ByteString -> ByteString
BSL.drop (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dDataOffset Directory
rootDir) ByteString
bs
  
  [Directory]
ds <- case Get [Directory]
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath)
     (ByteString, ByteOffset, [Directory])
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, 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 (_, _, x :: [Directory]
x) -> [Directory] -> Either Text [Directory]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Directory]
x
          Left (_, _, e :: FilePath
e) -> Text -> Either Text [Directory]
forall a b. a -> Either a b
Left ("Error reading " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (Directory -> Int
dElemNum Directory
rootDir) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " directories (at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (Directory -> Int
dDataOffset Directory
rootDir) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "): " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Txt.pack FilePath
e)
  
  Abif -> Either Text Abif
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 a :: Abif
a = Abif
a { aRootDir :: Directory
aRootDir = Directory -> Directory
clear (Directory -> Directory) -> Directory -> Directory
forall a b. (a -> b) -> a -> b
$ Abif -> Directory
aRootDir Abif
a
               , aDirs :: [Directory]
aDirs = Directory -> Directory
clear (Directory -> Directory) -> [Directory] -> [Directory]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Abif -> [Directory]
aDirs Abif
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 d :: Directory
d = Directory
d { dData :: ByteString
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 d :: 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"
    ElemPString ->
      if Directory -> Int
dDataSize Directory
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 4
      then Directory
d { dDataDebug :: [Text]
dDataDebug = [ByteString -> Text
TxtE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOffset -> ByteString -> ByteString
BSL.drop 1 (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteOffset -> ByteString -> ByteString
BSL.take (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ByteOffset) -> Int -> ByteOffset
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dDataSize Directory
d) (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Directory -> ByteString
dData Directory
d] }
      else Directory
d { dDataDebug :: [Text]
dDataDebug = [Get Text -> ByteString -> Text
forall a. Get a -> ByteString -> a
B.runGet (Get Text -> Get Text
forall a. Get a -> Get a
lbl Get Text
getPString) ByteString
bsAtOffset] }

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

    y :: ElemType
y ->
      -- For non-array entries
      if Directory -> Int
dElemNum Directory
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
      then 
        case ElemType
y of
          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 (f :: * -> *) a. Applicative f => a -> f a
pure Directory
d { dDataDebug :: [Text]
dDataDebug = [Int16 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int16
yy Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int8 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int8
mt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int8 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int8
dt]}
             
          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 (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug :: [Text]
dDataDebug = [Int8 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int8
hr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int8 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int8
mn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int8 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int8
sc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int8 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int8
ss] }
             
          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 (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug :: [Text]
dDataDebug =  [Int32 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int32
x] }
             
          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 (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug :: [Text]
dDataDebug = [Int16 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int16
x] }
             
          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 (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug :: [Text]
dDataDebug = [Float -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Float
x] }
             
          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 (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug :: [Text]
dDataDebug = [Int8 -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int8
x] }
             
          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 (f :: * -> *) a. Applicative f => a -> f a
pure (Directory -> Get Directory) -> Directory -> Get Directory
forall a b. (a -> b) -> a -> b
$ Directory
d { dDataDebug :: [Text]
dDataDebug = [ByteString -> Text
TxtE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
c] }
              
          _ -> Directory
d
      else
        case ElemType
y of
          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
                "PCON" -> Directory -> Get Directory
forall (f :: * -> *) a. Applicative f => a -> f a
pure Directory
d { dDataDebug :: [Text]
dDataDebug = [[Word8] -> Text
forall a b. (Show a, ConvertText FilePath b) => a -> b
show [Word8]
cs] }
                _ -> do
                  let c :: ByteString
c = [Word8] -> ByteString
BSL.pack [Word8]
cs
                  Directory -> Get Directory
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 :: [Text]
dDataDebug = [ByteString -> Text
TxtE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
c] }

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

          _ -> Directory
d -- Do nothing

  where
    lbl :: Get a -> Get a
lbl = FilePath -> Get a -> Get a
forall a. FilePath -> Get a -> Get a
B.label (FilePath -> Get a -> Get a) -> FilePath -> Get a -> Get a
forall a b. (a -> b) -> a -> b
$ "Reading " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (Directory -> Text
dElemTypeDesc Directory
d) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " data size=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (Directory -> Int
dDataSize Directory
d) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " dir entry=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Txt.unpack (Directory -> Text
dTagName Directory
d) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " cached data size=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (ByteOffset -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show (ByteOffset -> FilePath)
-> (ByteString -> ByteOffset) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteOffset
BSL.length (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ Directory -> ByteString
dData Directory
d) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ". "

    readArray :: B.Get n -> B.Get [n]
    readArray :: Get n -> Get [n]
readArray getFn :: Get n
getFn = do
      Bool
e <- Get Bool
B.isEmpty
      if Bool
e then [n] -> Get [n]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      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 (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
<$> FilePath -> Get ByteString -> Get ByteString
forall a. FilePath -> Get a -> Get a
B.label ("PString length=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
sz FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ".") (Int -> Get ByteString
B.getByteString Int
sz)


-- | Parse a 'ElemCString'
getCString :: Int -> B.Get Text
getCString :: Int -> Get Text
getCString sz :: 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
- 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 4)
         Get (Int -> Header) -> Get Int -> Get Header
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 bs :: ByteString
bs = do
  Header
h <- Get Header
getHeader
  Directory
rd <- ByteString -> Get Directory
getDirectory ByteString
bs
  (Header, Directory) -> Get (Header, Directory)
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 bs :: 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 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
$ ByteOffset -> Get ByteString
B.getLazyByteString 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
<= 4
                    then ByteString -> Get ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Get ByteString) -> ByteString -> Get ByteString
forall a b. (a -> b) -> a -> b
$ ByteOffset -> ByteString -> ByteString
BSL.take (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) ByteString
offsetDataBytes
                    else case Get ByteString
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath)
     (ByteString, ByteOffset, ByteString)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath) (ByteString, ByteOffset, a)
B.runGetOrFail (ByteOffset -> Get ByteString
B.getLazyByteString (ByteOffset -> Get ByteString) -> ByteOffset -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataSize) (ByteString
 -> Either
      (ByteString, ByteOffset, FilePath)
      (ByteString, ByteOffset, ByteString))
-> ByteString
-> Either
     (ByteString, ByteOffset, FilePath)
     (ByteString, ByteOffset, ByteString)
forall a b. (a -> b) -> a -> b
$ ByteOffset -> ByteString -> ByteString
BSL.drop (Int -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dataOffset) ByteString
bs of
                           Right (_, _, x :: ByteString
x) -> ByteString -> Get ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x
                           Left (_, _, e :: FilePath
e) -> FilePath -> Get ByteString
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Get ByteString) -> FilePath -> Get ByteString
forall a b. (a -> b) -> a -> b
$ "error reading data (" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
dataSize FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " bytes starting at " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a b. (Show a, ConvertText FilePath b) => a -> b
show Int
dataOffset FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ") for directory entry '" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
Txt.unpack Text
tagName FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "': " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
e

  let (elemType :: ElemType
elemType, elemCode :: Text
elemCode) = Int -> (ElemType, Text)
describeElemType Int
typeCode
  Directory -> Get Directory
forall (f :: * -> *) a. Applicative f => a -> f a
pure $WDirectory :: Text
-> Int
-> ElemType
-> Int
-> Text
-> Int
-> Int
-> Int
-> Int
-> ByteString
-> [Text]
-> Directory
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 _ acc :: [Directory]
acc 0 = [Directory] -> Get [Directory]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Directory]
acc
getDirectories bs :: ByteString
bs acc :: [Directory]
acc more :: Int
more = do
  Directory
d <- ByteString -> Get Directory
getDirectory ByteString
bs
  Int -> Get ()
B.skip 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
- 1)