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

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

Functionality for writing AB1 files.
See 'Hyrax.Abif.Generate.generateAb1' for an example of how to create an 'Ab1'
-}
module Hyrax.Abif.Write
    ( createAbifBytes
    , writeAbif
    , putAbif
    , putTextStr
    , putHeader
    , putDirectory
    , mkHeader
    , mkRoot
    , mkData
    , mkComment
    , mkSampleName
    , mkBaseOrder
    , mkLane
    , mkCalledBases
    , mkMobilityFileName
    , mkDyeSignalStrength
    , mkPeakLocations
    , addDirectory
    , Base (..)
    ) 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.Put as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL

import           Hyrax.Abif

-- | Used to specify the base order for the FWO directry entry, see 'mkBaseOrder'
data Base = BaseA | BaseC | BaseG | BaseT


-- | Write an 'Abif' to a 'ByteString'
createAbifBytes :: Abif -> BSL.ByteString
createAbifBytes :: Abif -> ByteString
createAbifBytes Abif
ab1 =
  Put -> ByteString
B.runPut (Abif -> Put
putAbif Abif
ab1)

  
-- | Write an 'Abif' to a file
writeAbif :: FilePath -> Abif -> IO ()
writeAbif :: FilePath -> Abif -> IO ()
writeAbif FilePath
destPath Abif
ab1 = do
  let b :: ByteString
b = Abif -> ByteString
createAbifBytes Abif
ab1
  FilePath -> ByteString -> IO ()
BS.writeFile FilePath
destPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
b

  
-- | Create the 'Abif' using "Data.Binary"
putAbif :: Abif -> B.Put
putAbif :: Abif -> Put
putAbif (Abif Header
header Directory
root [Directory]
dirs) = do
  -- Total data size
  let dataSize :: Int
dataSize = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc Int
i -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 then Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i else Int
acc) Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dDataSize (Directory -> Int) -> [Directory] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Directory]
dirs
  
  -- Write the header
  Header -> Put
putHeader Header
header

  -- Data starts at offset 128
  let startDataOffset :: Int
startDataOffset = Int
128
  -- Write the root directory entry
  Int -> Directory -> Put
putDirectory (Int
startDataOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dataSize) (Directory -> Put) -> Directory -> Put
forall a b. (a -> b) -> a -> b
$ Directory
root { dDataSize = 28 * length dirs
                                                   , dElemNum = length dirs
                                                   }

  -- Write 47 zero Int16 values as required by the spec
  (Int16 -> Put) -> [Int16] -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Int16 -> Put
B.putInt16be ([Int16] -> Put) -> [Int16] -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Int16 -> [Int16]
forall a. Int -> a -> [a]
replicate Int
47 Int16
0
  -- Write the data, for all data larger than four bytes. Data four bytes or less is stored
  --  in the offset field
  (Directory -> Put) -> [Directory] -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ByteString -> Put
B.putLazyByteString (ByteString -> Put)
-> (Directory -> ByteString) -> Directory -> Put
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
. Directory -> ByteString
dData) ([Directory] -> Put) -> [Directory] -> Put
forall a b. (a -> b) -> a -> b
$ (Directory -> Bool) -> [Directory] -> [Directory]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Directory
d -> Directory -> Int
dDataSize Directory
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4) [Directory]
dirs
  -- Write the directory entries. 
  (Int -> Directory -> PutM Int) -> Int -> [Directory] -> Put
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Int -> Directory -> PutM Int
writeDir Int
startDataOffset [Directory]
dirs

  where
    writeDir :: Int -> Directory -> PutM Int
writeDir Int
offset Directory
dir = do
      Int -> Directory -> Put
putDirectory Int
offset Directory
dir
      Int -> PutM Int
forall a. a -> PutM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> PutM Int) -> Int -> PutM Int
forall a b. (a -> b) -> a -> b
$ if Directory -> Int
dDataSize Directory
dir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4
             then Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Directory -> Int
dDataSize Directory
dir
             else Int
offset


-- | Write 'Text'
putTextStr :: Text -> B.Put
putTextStr :: Text -> Put
putTextStr Text
t = ByteString -> Put
B.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TxtE.encodeUtf8 Text
t


-- | Write a 'ElemPString'
putPStr :: Text -> B.Put
putPStr :: Text -> Put
putPStr Text
t = do
  Int8 -> Put
B.putInt8 (Int8 -> Put) -> (Int -> Int8) -> Int -> Put
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
. Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Text -> Int
Txt.length Text
t
  ByteString -> Put
B.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TxtE.encodeUtf8 Text
t


-- | Write a 'Header'
putHeader :: Header -> B.Put
putHeader :: Header -> Put
putHeader Header
h = do
  Text -> Put
putTextStr (Text -> Put) -> Text -> Put
forall a b. (a -> b) -> a -> b
$ Header -> Text
hName Header
h
  Int16 -> Put
B.putInt16be (Int16 -> Put) -> (Int -> Int16) -> Int -> Put
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
. Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Header -> Int
hVersion Header
h


-- | Write a 'Directory'
putDirectory :: Int -> Directory -> B.Put
putDirectory :: Int -> Directory -> Put
putDirectory Int
dirOffset Directory
d = do
  let name :: Text
name = Int -> Char -> Text -> Text
Txt.justifyLeft Int
4 Char
' ' (Text -> Text) -> (Text -> Text) -> Text -> Text
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
. Int -> Text -> Text
Txt.take Int
4 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Directory -> Text
dTagName Directory
d
  Text -> Put
putTextStr Text
name
  Int32 -> Put
B.putInt32be (Int32 -> Put) -> (Int -> Int32) -> Int -> Put
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
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dTagNum Directory
d
  Int16 -> Put
B.putInt16be (Int16 -> Put) -> (Int -> Int16) -> Int -> Put
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
. Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dElemTypeCode Directory
d
  Int16 -> Put
B.putInt16be (Int16 -> Put) -> (Int -> Int16) -> Int -> Put
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
. Int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dElemSize Directory
d
  Int32 -> Put
B.putInt32be (Int32 -> Put) -> (Int -> Int32) -> Int -> Put
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
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dElemNum Directory
d
  Int32 -> Put
B.putInt32be (Int32 -> Put) -> (Int -> Int32) -> Int -> Put
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
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Directory -> Int
dDataSize Directory
d

  -- data with a size >= 4 are written in the offset
  if Directory -> Int
dDataSize Directory
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4
    then Int32 -> Put
B.putInt32be (Int32 -> Put) -> (Int -> Int32) -> Int -> Put
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
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ Int
dirOffset
    else ByteString -> Put
B.putLazyByteString (ByteString -> Put)
-> (ByteString -> ByteString) -> ByteString -> Put
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
. Int64 -> ByteString -> ByteString
BSL.take Int64
4 (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Directory -> ByteString
dData Directory
d ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\0\0\0\0"

  Int32 -> Put
B.putInt32be Int32
0 -- reserved / datahandle


-- | Create a 'Header'
mkHeader :: Header
mkHeader :: Header
mkHeader =
  Header { hName :: Text
hName = Text
"ABIF"
         , hVersion :: Int
hVersion = Int
101
         }


-- | Create the root 'Directory' entry
mkRoot :: Directory
mkRoot :: Directory
mkRoot = 
  Directory { dTagName :: Text
dTagName = Text
"tdir"
                     , dTagNum :: Int
dTagNum = Int
1
                     , dElemTypeCode :: Int
dElemTypeCode = Int
1023
                     , dElemTypeDesc :: Text
dElemTypeDesc = Text
"root"
                     , dElemType :: ElemType
dElemType = ElemType
ElemRoot
                     , dElemSize :: Int
dElemSize = Int
28
                     , dDataOffset :: Int
dDataOffset = Int
0
                     , dDataDebug :: [Text]
dDataDebug = []
                     , dData :: ByteString
dData = ByteString
""
                     , dDataSize :: Int
dDataSize = Int
0
                     , dElemNum :: Int
dElemNum = Int
0
                     }
  

-- | Create a comment 'Directory' entry and 'ElemPString' data
mkComment :: Text -> Directory
mkComment :: Text -> Directory
mkComment Text
comment' = 
  let comment :: ByteString
comment = Put -> ByteString
B.runPut (Put -> ByteString) -> (Text -> Put) -> Text -> ByteString
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
. Text -> Put
putPStr (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
comment' in

  Directory { dTagName :: Text
dTagName = Text
"CMNT" -- Comment
            , dTagNum :: Int
dTagNum = Int
1
            , dElemTypeCode :: Int
dElemTypeCode = Int
18
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"pString"
            , dElemType :: ElemType
dElemType = ElemType
ElemPString
            , dElemSize :: Int
dElemSize = Int
1
            , dElemNum :: Int
dElemNum = Int
1
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = ByteString
comment
            , dDataSize :: Int
dDataSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
comment)
            } 


-- | Create a sample name (SMPL) 'Directory' entry and 'ElemPString' data
mkSampleName :: Text -> Directory
mkSampleName :: Text -> Directory
mkSampleName Text
sampleName' =
  let sampleName :: ByteString
sampleName = Put -> ByteString
B.runPut (Put -> ByteString) -> (Text -> Put) -> Text -> ByteString
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
. Text -> Put
putPStr (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
sampleName' in
  Directory { dTagName :: Text
dTagName = Text
"SMPL" -- Sample name
            , dTagNum :: Int
dTagNum = Int
1
            , dElemTypeCode :: Int
dElemTypeCode = Int
18
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"pString"
            , dElemType :: ElemType
dElemType = ElemType
ElemPString
            , dElemSize :: Int
dElemSize = Int
1
            , dElemNum :: Int
dElemNum = Int
10
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = ByteString
sampleName
            , dDataSize :: Int
dDataSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
sampleName)
            }

-- | Create a base order (FWO_) 'Directory' entry data
mkBaseOrder :: Base -> Base -> Base -> Base -> Directory
mkBaseOrder :: Base -> Base -> Base -> Base -> Directory
mkBaseOrder Base
w Base
x Base
y Base
z =
  Directory { dTagName :: Text
dTagName = Text
"FWO_" -- Base order
            , dTagNum :: Int
dTagNum = Int
1
            , dElemTypeCode :: Int
dElemTypeCode = Int
2
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"char"
            , dElemType :: ElemType
dElemType = ElemType
ElemChar
            , dElemSize :: Int
dElemSize = Int
1
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = Base -> ByteString
forall {a}. IsString a => Base -> a
getBase Base
w ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Base -> ByteString
forall {a}. IsString a => Base -> a
getBase Base
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Base -> ByteString
forall {a}. IsString a => Base -> a
getBase Base
y ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Base -> ByteString
forall {a}. IsString a => Base -> a
getBase Base
z
            , dDataSize :: Int
dDataSize = Int
4
            , dElemNum :: Int
dElemNum = Int
4
            }
  where
    getBase :: Base -> a
getBase Base
BaseA = a
"A"
    getBase Base
BaseC = a
"C"
    getBase Base
BaseG = a
"G"
    getBase Base
BaseT = a
"T"


-- | Create a lane (LANE) 'Directory' entry and data
mkLane :: Int16 -> Directory
mkLane :: Int16 -> Directory
mkLane Int16
lane =
  Directory { dTagName :: Text
dTagName = Text
"LANE" -- Lane or capliary number
            , dTagNum :: Int
dTagNum = Int
1
            , dElemTypeCode :: Int
dElemTypeCode = Int
4
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"short"
            , dElemType :: ElemType
dElemType = ElemType
ElemShort
            , dElemSize :: Int
dElemSize = Int
2
            , dElemNum :: Int
dElemNum = Int
1
            , dDataSize :: Int
dDataSize = Int
2
            , dDataOffset :: Int
dDataOffset = Int
0
            , dData :: ByteString
dData = Put -> ByteString
B.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Int16 -> Put
B.putInt16be Int16
lane
            , dDataDebug :: [Text]
dDataDebug = []
            }


-- | Create a called bases (PBAS) 'Directory' entry and data
mkCalledBases :: Text -> Directory
mkCalledBases :: Text -> Directory
mkCalledBases Text
fasta = 
  let
    generatedFastaLen :: Int
generatedFastaLen = Text -> Int
Txt.length Text
fasta
    pbas :: ByteString
pbas = ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
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
. Text -> ByteString
TxtE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
fasta
  in
  Directory { dTagName :: Text
dTagName = Text
"PBAS" -- Called bases
            , dTagNum :: Int
dTagNum = Int
1
            , dElemTypeCode :: Int
dElemTypeCode = Int
2
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"char"
            , dElemType :: ElemType
dElemType = ElemType
ElemChar
            , dElemSize :: Int
dElemSize = Int
1
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = ByteString
pbas
            , dDataSize :: Int
dDataSize = Int
generatedFastaLen
            , dElemNum :: Int
dElemNum = Int
generatedFastaLen 
            }


-- | Create a mobility file name (PDMF) 'Directory' entry and 'ElemPString' data
mkMobilityFileName :: Int -> Text -> Directory
mkMobilityFileName :: Int -> Text -> Directory
mkMobilityFileName Int
tagNum Text
fileName =
  let pdfm :: ByteString
pdfm = Put -> ByteString
B.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Put
putPStr Text
fileName in
  Directory { dTagName :: Text
dTagName = Text
"PDMF" -- Mobility file name
            , dTagNum :: Int
dTagNum = Int
tagNum
            , dElemTypeCode :: Int
dElemTypeCode = Int
18
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"pString"
            , dElemType :: ElemType
dElemType = ElemType
ElemPString
            , dElemSize :: Int
dElemSize = Int
1
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = ByteString
pdfm
            , dDataSize :: Int
dDataSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
pdfm)
            , dElemNum :: Int
dElemNum = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
pdfm) 
            }


-- | Create a signal strength (S/N%) 'Directory' entry and data
mkDyeSignalStrength :: Int16 -> Int16 -> Int16 -> Int16 -> Directory
mkDyeSignalStrength :: Int16 -> Int16 -> Int16 -> Int16 -> Directory
mkDyeSignalStrength Int16
w Int16
x Int16
y Int16
z =
  let sigStrength :: ByteString
sigStrength = Put -> ByteString
B.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
        Int16 -> Put
B.putInt16be Int16
w
        Int16 -> Put
B.putInt16be Int16
x
        Int16 -> Put
B.putInt16be Int16
y
        Int16 -> Put
B.putInt16be Int16
z
  in
  Directory { dTagName :: Text
dTagName = Text
"S/N%" -- Signal strength per dye
            , dTagNum :: Int
dTagNum = Int
1
            , dElemTypeCode :: Int
dElemTypeCode = Int
4
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"short"
            , dElemType :: ElemType
dElemType = ElemType
ElemShort
            , dElemSize :: Int
dElemSize = Int
2
            , dElemNum :: Int
dElemNum = Int
4
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = ByteString
sigStrength
            , dDataSize :: Int
dDataSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
sigStrength)
            }


-- | Create a peak locations (PLOC) 'Directory' entry and array of 'ElemShort' data
mkPeakLocations :: [Int16] -> Directory
mkPeakLocations :: [Int16] -> Directory
mkPeakLocations [Int16]
locs =
  let peakLocations :: ByteString
peakLocations = Put -> ByteString
B.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int16 -> Put) -> [Int16] -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Int16 -> Put
B.putInt16be [Int16]
locs in
  Directory { dTagName :: Text
dTagName = Text
"PLOC" -- Peak locations
            , dTagNum :: Int
dTagNum = Int
1
            , dElemTypeCode :: Int
dElemTypeCode = Int
4
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"short"
            , dElemType :: ElemType
dElemType = ElemType
ElemShort
            , dElemSize :: Int
dElemSize = Int
2
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = ByteString
peakLocations
            , dDataSize :: Int
dDataSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
peakLocations
            , dElemNum :: Int
dElemNum = [Int16] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int16]
locs
            }


-- | Create a data (DATA) 'Directory' entry and array of 'ElemShort' data
mkData :: Int -> [Int16] -> Directory
mkData :: Int -> [Int16] -> Directory
mkData Int
tagNum [Int16]
ds =
  let ds' :: ByteString
ds' = Put -> ByteString
B.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ (Int16 -> Put) -> [Int16] -> Put
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Int16 -> Put
B.putInt16be [Int16]
ds in
  Directory { dTagName :: Text
dTagName = Text
"DATA"
            , dTagNum :: Int
dTagNum = Int
tagNum
            , dElemTypeCode :: Int
dElemTypeCode = Int
4
            , dElemTypeDesc :: Text
dElemTypeDesc = Text
"short"
            , dElemType :: ElemType
dElemType = ElemType
ElemShort
            , dElemSize :: Int
dElemSize = Int
2
            , dDataOffset :: Int
dDataOffset = Int
0
            , dDataDebug :: [Text]
dDataDebug = []
            , dData :: ByteString
dData = ByteString
ds'
            , dDataSize :: Int
dDataSize = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
ds')
            , dElemNum :: Int
dElemNum = [Int16] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int16]
ds
            }

-- | Add a directory to an 'Abif'
addDirectory :: Abif -> Directory -> Abif
addDirectory :: Abif -> Directory -> Abif
addDirectory Abif
abif Directory
dir =
  Abif
abif { aDirs = aDirs abif <> [dir] }