{-# 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 :: forall a. Binary a => (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 forall a. Ord a => a -> a -> Bool
< Int64
ith = 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 forall a. a -> [a] -> [a]
: forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> a
f Int
th ByteString
rest
  where ith :: Int64
ith = 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]
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 (forall a. Binary a => ByteString -> a
decode ByteString
cdc) (forall a. Binary a => ByteString -> a
decode ByteString
lnh) (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 = forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon forall a. Binary a => ByteString -> a
decode Int
4 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 = forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon forall a. Binary a => ByteString -> a
decode Int
1 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 = forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon forall a. Binary a => ByteString -> a
decode Int
2 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 = forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon forall a. Binary a => ByteString -> a
decode Int
4 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 = forall a. Binary a => (ByteString -> a) -> Int -> ByteString -> [a]
codecCommon ByteString -> Text
decodeBytes (forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a b. (a -> b) -> a -> b
$ Int -> Char
chr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Int
0) (forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) 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 = forall a. Integral a => [a] -> [a]
runLengthDec 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 = forall a. Num a => [a] -> [a]
deltaDec 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 = forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) 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 = forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => [a] -> [a]
deltaDec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec 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 = forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 = forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec 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 = forall a. Integral a => a -> [a] -> [Float]
integerDec (BinaryData -> Int32
binaryParam BinaryData
bd) forall a b. (a -> b) -> a -> b
$ forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec 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 = forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec 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 = forall a. (Integral a, Bounded a, Eq a) => [a] -> [Int32]
recIndexDec forall a b. (a -> b) -> a -> b
$ BinaryData -> [Int8]
codec2 BinaryData
bd

-- Decodings

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

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

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

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

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

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

m44Dec :: MonadFail m => [Float] -> m M44
m44Dec :: forall (m :: * -> *). MonadFail m => [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] = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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]
_                     = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Wrong list format for 4x4 transformation matrix"