{-# 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
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
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
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
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
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
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)
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
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
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
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
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
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
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
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
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
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
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"