{-# LANGUAGE CPP #-}

module Bio.MMTF.Decode.Codec where

import           Data.Binary          (Binary, decode)
import           Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B (length, null, splitAt, unpack)
import           Data.Char            (chr)
import           Data.Int             (Int16, Int32, Int8)
import           Data.List            (mapAccumL)
import           Data.Text            (Text)
import qualified Data.Text            as T (pack)

#if !MIN_VERSION_base(4,13,0)
import Bio.MMTF.Decode.MessagePack (MonadFail)
#endif

import           Bio.MMTF.Type
import           Bio.Structure

codecCommon :: Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon :: (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon  ByteString -> a
f Int
th ByteString
bs | ByteString -> Bool
B.null ByteString
bs         = []
                     | ByteString -> Int64
B.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
ith = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"Wrong number of bytes in bytestring"
                     | Bool
otherwise         = let (ByteString
start, ByteString
rest) = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
ith ByteString
bs
                                           in ByteString -> a
f ByteString
start a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (ByteString -> a) -> Int -> ByteString -> [a]
forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> a
f Int
th ByteString
rest
  where ith :: Int64
ith = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
th

data BinaryData = BD { BinaryData -> Int32
binaryCodec  :: !Int32
                     , BinaryData -> Int32
binaryLength :: !Int32
                     , BinaryData -> Int32
binaryParam  :: !Int32
                     , BinaryData -> ByteString
binaryData   :: !ByteString
                     }
  deriving Int -> BinaryData -> ShowS
[BinaryData] -> ShowS
BinaryData -> [Char]
(Int -> BinaryData -> ShowS)
-> (BinaryData -> [Char])
-> ([BinaryData] -> ShowS)
-> Show BinaryData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BinaryData] -> ShowS
$cshowList :: [BinaryData] -> ShowS
show :: BinaryData -> [Char]
$cshow :: BinaryData -> [Char]
showsPrec :: Int -> BinaryData -> ShowS
$cshowsPrec :: Int -> BinaryData -> ShowS
Show

-- | Parse useless header for binary data
--
parseBinary :: ByteString -> BinaryData
parseBinary :: ByteString -> BinaryData
parseBinary ByteString
bs = let (ByteString
cdc, ByteString
rest1) = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
4 ByteString
bs
                     (ByteString
lnh, ByteString
rest2) = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
4 ByteString
rest1
                     (ByteString
prm, ByteString
rest)  = Int64 -> ByteString -> (ByteString, ByteString)
B.splitAt Int64
4 ByteString
rest2
                 in  Int32 -> Int32 -> Int32 -> ByteString -> BinaryData
BD (ByteString -> Int32
forall a. Binary a => ByteString -> a
decode ByteString
cdc) (ByteString -> Int32
forall a. Binary a => ByteString -> a
decode ByteString
lnh) (ByteString -> Int32
forall a. Binary a => ByteString -> a
decode ByteString
prm) ByteString
rest

-- | Interpret bytes as array of 32-bit floating-point numbers.
--
codec1 :: BinaryData -> [Float]
codec1 :: BinaryData -> [Float]
codec1 = (ByteString -> Float) -> Int -> ByteString -> [Float]
forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> Float
forall a. Binary a => ByteString -> a
decode Int
4 (ByteString -> [Float])
-> (BinaryData -> ByteString) -> BinaryData -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> ByteString
binaryData

-- | Interpret bytes as array of 8-bit signed integers.
--
codec2 :: BinaryData -> [Int8]
codec2 :: BinaryData -> [Int8]
codec2 = (ByteString -> Int8) -> Int -> ByteString -> [Int8]
forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> Int8
forall a. Binary a => ByteString -> a
decode Int
1 (ByteString -> [Int8])
-> (BinaryData -> ByteString) -> BinaryData -> [Int8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> ByteString
binaryData

-- | Interpret bytes as array of 16-bit signed integers.
--
codec3 :: BinaryData -> [Int16]
codec3 :: BinaryData -> [Int16]
codec3 = (ByteString -> Int16) -> Int -> ByteString -> [Int16]
forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> Int16
forall a. Binary a => ByteString -> a
decode Int
2 (ByteString -> [Int16])
-> (BinaryData -> ByteString) -> BinaryData -> [Int16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> ByteString
binaryData

-- | Interpret bytes as array of 32-bit signed integers.
--
codec4 :: BinaryData -> [Int32]
codec4 :: BinaryData -> [Int32]
codec4 = (ByteString -> Int32) -> Int -> ByteString -> [Int32]
forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> Int32
forall a. Binary a => ByteString -> a
decode Int
4 (ByteString -> [Int32])
-> (BinaryData -> ByteString) -> BinaryData -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> ByteString
binaryData

-- | Interpret bytes as array of 8-bit unsigned integers, then iteratively
-- consume length many bytes to form a string array.
--
codec5 :: BinaryData -> [Text]
codec5 :: BinaryData -> [Text]
codec5 BinaryData
bd = (ByteString -> Text) -> Int -> ByteString -> [Text]
forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> Text
decodeBytes (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Int32 -> Int
forall a b. (a -> b) -> a -> b
$ BinaryData -> Int32
binaryParam BinaryData
bd) (BinaryData -> ByteString
binaryData BinaryData
bd)
  where decodeBytes :: ByteString -> Text
        decodeBytes :: ByteString -> Text
decodeBytes ByteString
bs = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr (Int -> Char) -> [Int] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
0) (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> [Word8] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [Word8]
B.unpack ByteString
bs)

-- | Interpret bytes as array of 32-bit signed integers, then run-length
-- decode into array of characters.
--
codec6 :: BinaryData -> [Char]
codec6 :: BinaryData -> [Char]
codec6 = (Int32 -> Char) -> [Int32] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Int32 -> Int) -> Int32 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Int32] -> [Char])
-> (BinaryData -> [Int32]) -> BinaryData -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> [Int32]
codec7

-- | Interpret bytes as array of 32-bit signed integers, then run-length
-- decode into array of 32-bit signed integers.
--
codec7 :: BinaryData -> [Int32]
codec7 :: BinaryData -> [Int32]
codec7 = [Int32] -> [Int32]
forall a. Integral a => [a] -> [a]
runLengthDec ([Int32] -> [Int32])
-> (BinaryData -> [Int32]) -> BinaryData -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> [Int32]
codec4

-- | Interpret bytes as array of 32-bit signed integers, then run-length
-- decode into array of 32-bit signed integers, then delta decode into
-- array of 32-bit signed integers.
--
codec8 :: BinaryData -> [Int32]
codec8 :: BinaryData -> [Int32]
codec8 = [Int32] -> [Int32]
forall a. Num a => [a] -> [a]
deltaDec ([Int32] -> [Int32])
-> (BinaryData -> [Int32]) -> BinaryData -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> [Int32]
codec7

-- | Interpret bytes as array of 32-bit signed integers, then run-length
-- decode into array of 32-bit signed integers, then integer decode into
-- array of 32-bit floating-point numbers using the divisor parameter.
--
codec9 :: BinaryData -> [Float]
codec9 :: BinaryData -> [Float]
codec9 BinaryData
bd = Int32 -> [Int32] -> [Float]
forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) ([Int32] -> [Float]) -> [Int32] -> [Float]
forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int32]
codec7 BinaryData
bd

-- | Interpret bytes as array of 16-bit signed integers, then unpack into
-- array of 32-bit integers, then delta decode into array of 32-bit
-- integers, then integer decode into array of 32-bit floating-point
-- numbers using the divisor parameter.
--
codec10 :: BinaryData -> [Float]
codec10 :: BinaryData -> [Float]
codec10 BinaryData
bd = Int32 -> [Int32] -> [Float]
forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) ([Int32] -> [Float]) -> ([Int16] -> [Int32]) -> [Int16] -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int32) -> [Int32] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int32] -> [Int32]) -> ([Int16] -> [Int32]) -> [Int16] -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int32] -> [Int32]
forall a. Num a => [a] -> [a]
deltaDec ([Int32] -> [Int32]) -> ([Int16] -> [Int32]) -> [Int16] -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int16] -> [Int32]
forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec ([Int16] -> [Float]) -> [Int16] -> [Float]
forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int16]
codec3 BinaryData
bd

-- | Interpret bytes as array of 16-bit signed integers, then integer
-- decode into array of 32-bit floating-point numbers using the divisor parameter.
--
codec11 :: BinaryData -> [Float]
codec11 :: BinaryData -> [Float]
codec11 BinaryData
bd = Int32 -> [Int32] -> [Float]
forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) ([Int32] -> [Float]) -> [Int32] -> [Float]
forall a b. (a -> b) -> a -> b
$ (Int16 -> Int32) -> [Int16] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map Int16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int16] -> [Int32]) -> [Int16] -> [Int32]
forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int16]
codec3 BinaryData
bd

-- | Interpret bytes as array of 16-bit signed integers, then unpack into
-- array of 32-bit signed integers, then integer decode into array
-- of 32-bit floating-point numbers using the divisor parameter.
--
codec12 :: BinaryData -> [Float]
codec12 :: BinaryData -> [Float]
codec12 BinaryData
bd = Int32 -> [Int32] -> [Float]
forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) ([Int32] -> [Float]) -> [Int32] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Int16] -> [Int32]
forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec ([Int16] -> [Int32]) -> [Int16] -> [Int32]
forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int16]
codec3 BinaryData
bd

-- | Interpret array of bytes as array of 8-bit signed integers, then
-- unpack into array of 32-bit signed integers, then integer decode into
-- array of 32-bit floating-point numbers using the divisor parameter.
--
codec13 :: BinaryData -> [Float]
codec13 :: BinaryData -> [Float]
codec13 BinaryData
bd = Int32 -> [Int32] -> [Float]
forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) ([Int32] -> [Float]) -> [Int32] -> [Float]
forall a b. (a -> b) -> a -> b
$ [Int8] -> [Int32]
forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec ([Int8] -> [Int32]) -> [Int8] -> [Int32]
forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int8]
codec2 BinaryData
bd

-- | Interpret bytes as array of 16-bit signed integers, then unpack
-- into array of 32-bit signed integers.
--
codec14 :: BinaryData -> [Int32]
codec14 :: BinaryData -> [Int32]
codec14 BinaryData
bd = [Int16] -> [Int32]
forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec ([Int16] -> [Int32]) -> [Int16] -> [Int32]
forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int16]
codec3 BinaryData
bd

-- | Interpret bytes as array of 8-bit signed integers, then unpack
-- into array of 32-bit signed integers.
--
codec15 :: BinaryData -> [Int32]
codec15 :: BinaryData -> [Int32]
codec15 BinaryData
bd = [Int8] -> [Int32]
forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec ([Int8] -> [Int32]) -> [Int8] -> [Int32]
forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int8]
codec2 BinaryData
bd

-- Decodings

runLengthDec :: Integral a => [a] -> [a]
runLengthDec :: [a] -> [a]
runLengthDec [] = []
runLengthDec [a
_] = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"List must have even length for run-length encoding"
runLengthDec (a
x:a
l:[a]
xs) = Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
l) a
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a] -> [a]
forall a. Integral a => [a] -> [a]
runLengthDec [a]
xs

deltaDec :: Num a => [a] -> [a]
deltaDec :: [a] -> [a]
deltaDec = (a, [a]) -> [a]
forall a b. (a, b) -> b
snd ((a, [a]) -> [a]) -> ([a] -> (a, [a])) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> (a, a)) -> a -> [a] -> (a, [a])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL (\a
x a
y -> (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
y,a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
y)) a
0

recIndexDec :: (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec :: [a] -> [Int32]
recIndexDec [] = []
recIndexDec [a]
xs = Int32 -> [a] -> [Int32]
forall a. (Integral a, Bounded a) => Int32 -> [a] -> [Int32]
recIndexDecAcc Int32
0 [a]
xs
  where recIndexDecAcc :: (Integral a, Bounded a) => Int32 -> [a] -> [Int32]
        recIndexDecAcc :: Int32 -> [a] -> [Int32]
recIndexDecAcc Int32
acc []     | Int32
acc Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int32
0  = [Int32
acc]
                                  | Bool
otherwise = []
        recIndexDecAcc Int32
acc (a
x:[a]
ys) | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
forall a. Bounded a => a
minBound Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
forall a. Bounded a => a
maxBound = a -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
acc Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: Int32 -> [a] -> [Int32]
forall a. (Integral a, Bounded a) => Int32 -> [a] -> [Int32]
recIndexDecAcc Int32
0 [a]
ys
                                  | Bool
otherwise                    = Int32 -> [a] -> [Int32]
forall a. (Integral a, Bounded a) => Int32 -> [a] -> [Int32]
recIndexDecAcc (a -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
acc) [a]
ys

integerDec :: Integral a => a -> [a] -> [Float]
integerDec :: a -> [a] -> [Float]
integerDec a
divisor = (a -> Float) -> [a] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
divisor)

ssDec :: Int8 -> SecondaryStructure
ssDec :: Int8 -> SecondaryStructure
ssDec Int8
n | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0    = SecondaryStructure
PiHelix
        | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
1    = SecondaryStructure
Bend
        | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
2    = SecondaryStructure
AlphaHelix
        | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
3    = SecondaryStructure
Extended
        | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
4    = SecondaryStructure
ThreeTenHelix
        | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
5    = SecondaryStructure
Bridge
        | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
6    = SecondaryStructure
Turn
        | Int8
n Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
7    = SecondaryStructure
Coil
        | Bool
otherwise = SecondaryStructure
Undefined

ucDec :: MonadFail m => [Float] -> m UnitCell
ucDec :: [Float] -> m UnitCell
ucDec [Float
a,Float
b,Float
c,Float
d,Float
e,Float
f] = UnitCell -> m UnitCell
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnitCell -> m UnitCell) -> UnitCell -> m UnitCell
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float -> Float -> Float -> UnitCell
UnitCell Float
a Float
b Float
c Float
d Float
e Float
f
ucDec [Float]
_             = [Char] -> m UnitCell
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Wrong list format for unit cell"

m44Dec :: MonadFail m => [Float] -> m M44
m44Dec :: [Float] -> m M44
m44Dec [ Float
a11, Float
a12, Float
a13, Float
a14
       , Float
a21, Float
a22, Float
a23, Float
a24
       , Float
a31, Float
a32, Float
a33, Float
a34
       , Float
a41, Float
a42, Float
a43, Float
a44] = M44 -> m M44
forall (f :: * -> *) a. Applicative f => a -> f a
pure (M44 -> m M44) -> M44 -> m M44
forall a b. (a -> b) -> a -> b
$ Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> M44
M44 Float
a11 Float
a12 Float
a13 Float
a14 Float
a21 Float
a22 Float
a23 Float
a24 Float
a31 Float
a32 Float
a33 Float
a34 Float
a41 Float
a42 Float
a43 Float
a44
m44Dec [Float]
_                     = [Char] -> m M44
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Wrong list format for 4x4 transformation matrix"