module Bio.MMTF.Decode where

import           Bio.MMTF.Decode.Codec
import           Bio.MMTF.Decode.MessagePack
import           Bio.MMTF.Type

import           Control.Monad               ((>=>))
import           Data.ByteString.Lazy        (empty)
import           Data.Char                   (ord)
import           Data.Map.Strict             (Map)
import           Data.MessagePack            (Object)
import           Data.Text                   (Text, pack)
import           Data.Vector                 (Vector, fromList)

-- | Parses format data from ObjectMap
--
formatData :: MonadFail m => Map Text Object -> m FormatData
formatData :: Map Text Object -> m FormatData
formatData Map Text Object
mp = do Text
v <- Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"mmtfVersion"  Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
                   Text
p <- Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"mmtfProducer" Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
                   FormatData -> m FormatData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormatData -> m FormatData) -> FormatData -> m FormatData
forall a b. (a -> b) -> a -> b
$ Text -> Text -> FormatData
FormatData Text
v Text
p

-- | Parses model data from ObjectMap
--
modelData :: MonadFail m => Map Text Object -> m ModelData
modelData :: Map Text Object -> m ModelData
modelData Map Text Object
mp = Vector Int32 -> ModelData
ModelData (Vector Int32 -> ModelData)
-> ([Int32] -> Vector Int32) -> [Int32] -> ModelData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v ([Int32] -> ModelData) -> m [Int32] -> m ModelData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"chainsPerModel" Text -> Object -> m [Int32]
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m [a]
asIntList

-- | Parses chain data from ObjectMap
--
chainData :: MonadFail m => Map Text Object -> m ChainData
chainData :: Map Text Object -> m ChainData
chainData Map Text Object
mp = do [Int32]
gpc <- Map Text Object
-> Text -> (Text -> Object -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"groupsPerChain" Text -> Object -> m [Int32]
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m [a]
asIntList
                  [Text]
cil <- BinaryData -> [Text]
codec5 (BinaryData -> [Text])
-> (ByteString -> BinaryData) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Text]) -> m ByteString -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"chainIdList"   Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary
                  [Text]
cnl <- BinaryData -> [Text]
codec5 (BinaryData -> [Text])
-> (ByteString -> BinaryData) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Text]) -> m ByteString -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"chainNameList" Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                  ChainData -> m ChainData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainData -> m ChainData) -> ChainData -> m ChainData
forall a b. (a -> b) -> a -> b
$ Vector Int32 -> Vector Text -> Vector Text -> ChainData
ChainData ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
gpc) ([Text] -> Vector Text
forall a. [a] -> Vector a
l2v [Text]
cil) ([Text] -> Vector Text
forall a. [a] -> Vector a
l2v [Text]
cnl)

-- | Parses atom data from ObjectMap
--
atomData :: MonadFail m => Map Text Object -> m AtomData
atomData :: Map Text Object -> m AtomData
atomData Map Text Object
mp = do [Int32]
ail' <-       BinaryData -> [Int32]
codec8 (BinaryData -> [Int32])
-> (ByteString -> BinaryData) -> ByteString -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Int32]) -> m ByteString -> m [Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"atomIdList"    Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                 [Text]
all' <- [Char] -> [Text]
c2s ([Char] -> [Text])
-> (ByteString -> [Char]) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> [Char]
codec6 (BinaryData -> [Char])
-> (ByteString -> BinaryData) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Text]) -> m ByteString -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"altLocList"    Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                 [Float]
bfl' <-      BinaryData -> [Float]
codec10 (BinaryData -> [Float])
-> (ByteString -> BinaryData) -> ByteString -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Float]) -> m ByteString -> m [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"bFactorList"   Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                 [Float]
xcl' <-      BinaryData -> [Float]
codec10 (BinaryData -> [Float])
-> (ByteString -> BinaryData) -> ByteString -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Float]) -> m ByteString -> m [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"xCoordList"    Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary
                 [Float]
ycl' <-      BinaryData -> [Float]
codec10 (BinaryData -> [Float])
-> (ByteString -> BinaryData) -> ByteString -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Float]) -> m ByteString -> m [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"yCoordList"    Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary
                 [Float]
zcl' <-      BinaryData -> [Float]
codec10 (BinaryData -> [Float])
-> (ByteString -> BinaryData) -> ByteString -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Float]) -> m ByteString -> m [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"zCoordList"    Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary
                 [Float]
ol' <-        BinaryData -> [Float]
codec9 (BinaryData -> [Float])
-> (ByteString -> BinaryData) -> ByteString -> [Float]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Float]) -> m ByteString -> m [Float]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"occupancyList" Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                 AtomData -> m AtomData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AtomData -> m AtomData) -> AtomData -> m AtomData
forall a b. (a -> b) -> a -> b
$ Vector Int32
-> Vector Text
-> Vector Float
-> Vector Float
-> Vector Float
-> Vector Float
-> Vector Float
-> AtomData
AtomData ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
ail') ([Text] -> Vector Text
forall a. [a] -> Vector a
l2v [Text]
all') ([Float] -> Vector Float
forall a. [a] -> Vector a
l2v [Float]
bfl') ([Float] -> Vector Float
forall a. [a] -> Vector a
l2v [Float]
xcl') ([Float] -> Vector Float
forall a. [a] -> Vector a
l2v [Float]
ycl') ([Float] -> Vector Float
forall a. [a] -> Vector a
l2v [Float]
zcl') ([Float] -> Vector Float
forall a. [a] -> Vector a
l2v [Float]
ol')

-- | Parses group data from ObjectMap
--
groupData :: MonadFail m => Map Text Object -> m GroupData
groupData :: Map Text Object -> m GroupData
groupData Map Text Object
mp = do [GroupType]
gl' <-                                        Map Text Object
-> Text -> (Text -> Object -> m [Object]) -> m [Object]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"groupList"          Text -> Object -> m [Object]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Object]
asObjectList m [Object] -> ([Object] -> m [GroupType]) -> m [GroupType]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> m GroupType) -> [Object] -> m [GroupType]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Object -> m (Map Text Object)
forall (m :: * -> *). MonadFail m => Object -> m (Map Text Object)
transformObjectMap (Object -> m (Map Text Object))
-> (Map Text Object -> m GroupType) -> Object -> m GroupType
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Map Text Object -> m GroupType
forall (m :: * -> *). MonadFail m => Map Text Object -> m GroupType
groupType)
                  [Int32]
gtl' <-              BinaryData -> [Int32]
codec4 (BinaryData -> [Int32])
-> (ByteString -> BinaryData) -> ByteString -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Int32]) -> m ByteString -> m [Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"groupTypeList"     Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary
                  [Int32]
gil' <-              BinaryData -> [Int32]
codec8 (BinaryData -> [Int32])
-> (ByteString -> BinaryData) -> ByteString -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Int32]) -> m ByteString -> m [Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m ByteString) -> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"groupIdList"       Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary
                  [SecondaryStructure]
ssl' <- (Int8 -> SecondaryStructure) -> [Int8] -> [SecondaryStructure]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int8 -> SecondaryStructure
ssDec ([Int8] -> [SecondaryStructure])
-> (ByteString -> [Int8]) -> ByteString -> [SecondaryStructure]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> [Int8]
codec2 (BinaryData -> [Int8])
-> (ByteString -> BinaryData) -> ByteString -> [Int8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [SecondaryStructure])
-> m ByteString -> m [SecondaryStructure]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"secStructList"     Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                  [Text]
icl' <-        [Char] -> [Text]
c2s ([Char] -> [Text])
-> (ByteString -> [Char]) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> [Char]
codec6 (BinaryData -> [Char])
-> (ByteString -> BinaryData) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Text]) -> m ByteString -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"insCodeList"       Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                  [Int32]
sil' <-              BinaryData -> [Int32]
codec8 (BinaryData -> [Int32])
-> (ByteString -> BinaryData) -> ByteString -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Int32]) -> m ByteString -> m [Int32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"sequenceIndexList" Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                  GroupData -> m GroupData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupData -> m GroupData) -> GroupData -> m GroupData
forall a b. (a -> b) -> a -> b
$ Vector GroupType
-> Vector Int32
-> Vector Int32
-> Vector SecondaryStructure
-> Vector Text
-> Vector Int32
-> GroupData
GroupData ([GroupType] -> Vector GroupType
forall a. [a] -> Vector a
l2v [GroupType]
gl') ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
gtl') ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
gil') ([SecondaryStructure] -> Vector SecondaryStructure
forall a. [a] -> Vector a
l2v [SecondaryStructure]
ssl') ([Text] -> Vector Text
forall a. [a] -> Vector a
l2v [Text]
icl') ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
sil')

-- | Parses group type from ObjectMap
--
groupType :: MonadFail m => Map Text Object -> m GroupType
groupType :: Map Text Object -> m GroupType
groupType Map Text Object
mp = do [Int32]
fcl' <-          Map Text Object
-> Text -> (Text -> Object -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"formalChargeList" Text -> Object -> m [Int32]
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m [a]
asIntList
                  [Text]
anl' <-          Map Text Object -> Text -> (Text -> Object -> m [Text]) -> m [Text]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"atomNameList"     Text -> Object -> m [Text]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Text]
asStrList
                  [Text]
el'  <-          Map Text Object -> Text -> (Text -> Object -> m [Text]) -> m [Text]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"elementList"      Text -> Object -> m [Text]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Text]
asStrList
                  [(Int32, Int32)]
bal' <- [Int32] -> [(Int32, Int32)]
forall a. [a] -> [(a, a)]
l2pl ([Int32] -> [(Int32, Int32)]) -> m [Int32] -> m [(Int32, Int32)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"bondAtomList"     Text -> Object -> m [Int32]
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m [a]
asIntList
                  [Int32]
bol' <-          Map Text Object
-> Text -> (Text -> Object -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"bondOrderList"    Text -> Object -> m [Int32]
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m [a]
asIntList
                  Text
gn'  <-          Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"groupName"        Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
                  Char
slc' <-          Map Text Object -> Text -> (Text -> Object -> m Char) -> m Char
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"singleLetterCode" Text -> Object -> m Char
forall (m :: * -> *). MonadFail m => Text -> Object -> m Char
asChar
                  Text
cct' <-          Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"chemCompType"     Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
                  GroupType -> m GroupType
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupType -> m GroupType) -> GroupType -> m GroupType
forall a b. (a -> b) -> a -> b
$ Vector Int32
-> Vector Text
-> Vector Text
-> Vector (Int32, Int32)
-> Vector Int32
-> Text
-> Char
-> Text
-> GroupType
GroupType ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
fcl') ([Text] -> Vector Text
forall a. [a] -> Vector a
l2v [Text]
anl') ([Text] -> Vector Text
forall a. [a] -> Vector a
l2v [Text]
el') ([(Int32, Int32)] -> Vector (Int32, Int32)
forall a. [a] -> Vector a
l2v [(Int32, Int32)]
bal') ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
bol') Text
gn' Char
slc' Text
cct'

-- | Parses structure data from ObjectMap
--
structureData :: MonadFail m => Map Text Object -> m StructureData
structureData :: Map Text Object -> m StructureData
structureData Map Text Object
mp = do Text
ttl' <-                                  Map Text Object
-> Text -> (Text -> Object -> m Text) -> Text -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"title"               Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr        Text
""
                      Text
sid' <-                                  Map Text Object
-> Text -> (Text -> Object -> m Text) -> Text -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"structureId"         Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr        Text
""
                      Text
dd'  <-                                  Map Text Object
-> Text -> (Text -> Object -> m Text) -> Text -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"depositionDate"      Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr        Text
""
                      Text
rd'  <-                                  Map Text Object
-> Text -> (Text -> Object -> m Text) -> Text -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"releaseDate"         Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr        Text
""
                      Int32
nb'  <-                                  Map Text Object -> Text -> (Text -> Object -> m Int32) -> m Int32
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"numBonds"            Text -> Object -> m Int32
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m a
asInt
                      Int32
na'  <-                                  Map Text Object -> Text -> (Text -> Object -> m Int32) -> m Int32
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"numAtoms"            Text -> Object -> m Int32
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m a
asInt
                      Int32
ng'  <-                                  Map Text Object -> Text -> (Text -> Object -> m Int32) -> m Int32
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"numGroups"           Text -> Object -> m Int32
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m a
asInt
                      Int32
nc'  <-                                  Map Text Object -> Text -> (Text -> Object -> m Int32) -> m Int32
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"numChains"           Text -> Object -> m Int32
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m a
asInt
                      Int32
nm'  <-                                  Map Text Object -> Text -> (Text -> Object -> m Int32) -> m Int32
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP   Map Text Object
mp Text
"numModels"           Text -> Object -> m Int32
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m a
asInt
                      Text
sg'  <-                                  Map Text Object
-> Text -> (Text -> Object -> m Text) -> Text -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"spaceGroup"          Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr        Text
""
                      Maybe UnitCell
uc'  <-                  (Maybe [Float] -> ([Float] -> Maybe UnitCell) -> Maybe UnitCell
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Float] -> Maybe UnitCell
forall (m :: * -> *). MonadFail m => [Float] -> m UnitCell
ucDec) (Maybe [Float] -> Maybe UnitCell)
-> m (Maybe [Float]) -> m (Maybe UnitCell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m [Float]) -> m (Maybe [Float])
forall (m :: * -> *) a.
Monad m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m (Maybe a)
atPM  Map Text Object
mp Text
"unitCell"            Text -> Object -> m [Float]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Float]
asFloatList
                      [M44]
nol' <-                       [Float] -> [M44]
forall (m :: * -> *). MonadFail m => [Float] -> m M44
m44Dec ([Float] -> [M44]) -> m [Float] -> m [M44]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text -> (Text -> Object -> m [Float]) -> [Float] -> m [Float]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"ncsOperatorList"     Text -> Object -> m [Float]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Float]
asFloatList []
                      [Assembly]
bal' <-                                  Map Text Object
-> Text -> (Text -> Object -> m [Object]) -> [Object] -> m [Object]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"bioAssemblyList"     Text -> Object -> m [Object]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Object]
asObjectList [] m [Object] -> ([Object] -> m [Assembly]) -> m [Assembly]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> m Assembly) -> [Object] -> m [Assembly]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Object -> m (Map Text Object)
forall (m :: * -> *). MonadFail m => Object -> m (Map Text Object)
transformObjectMap (Object -> m (Map Text Object))
-> (Map Text Object -> m Assembly) -> Object -> m Assembly
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Map Text Object -> m Assembly
forall (m :: * -> *). MonadFail m => Map Text Object -> m Assembly
bioAssembly)
                      [Entity]
el'  <-                                  Map Text Object
-> Text -> (Text -> Object -> m [Object]) -> [Object] -> m [Object]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"entityList"          Text -> Object -> m [Object]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Object]
asObjectList [] m [Object] -> ([Object] -> m [Entity]) -> m [Entity]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> m Entity) -> [Object] -> m [Entity]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Object -> m (Map Text Object)
forall (m :: * -> *). MonadFail m => Object -> m (Map Text Object)
transformObjectMap (Object -> m (Map Text Object))
-> (Map Text Object -> m Entity) -> Object -> m Entity
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Map Text Object -> m Entity
forall (m :: * -> *). MonadFail m => Map Text Object -> m Entity
entity)
                      Maybe Float
res' <-                                  Map Text Object
-> Text -> (Text -> Object -> m Float) -> m (Maybe Float)
forall (m :: * -> *) a.
Monad m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m (Maybe a)
atPM  Map Text Object
mp Text
"resolution"          Text -> Object -> m Float
forall (m :: * -> *). MonadFail m => Text -> Object -> m Float
asFloat
                      Maybe Float
rf'  <-                                  Map Text Object
-> Text -> (Text -> Object -> m Float) -> m (Maybe Float)
forall (m :: * -> *) a.
Monad m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m (Maybe a)
atPM  Map Text Object
mp Text
"rFree"               Text -> Object -> m Float
forall (m :: * -> *). MonadFail m => Text -> Object -> m Float
asFloat
                      Maybe Float
rw'  <-                                  Map Text Object
-> Text -> (Text -> Object -> m Float) -> m (Maybe Float)
forall (m :: * -> *) a.
Monad m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m (Maybe a)
atPM  Map Text Object
mp Text
"rWork"               Text -> Object -> m Float
forall (m :: * -> *). MonadFail m => Text -> Object -> m Float
asFloat
                      [Text]
em'  <-                                  Map Text Object
-> Text -> (Text -> Object -> m [Text]) -> [Text] -> m [Text]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"experimentalMethods" Text -> Object -> m [Text]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Text]
asStrList []
                      [(Int32, Int32)]
btl' <-  [Int32] -> [(Int32, Int32)]
forall a. [a] -> [(a, a)]
l2pl ([Int32] -> [(Int32, Int32)])
-> (ByteString -> [Int32]) -> ByteString -> [(Int32, Int32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData -> [Int32]
codec4 (BinaryData -> [Int32])
-> (ByteString -> BinaryData) -> ByteString -> [Int32]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [(Int32, Int32)])
-> m ByteString -> m [(Int32, Int32)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"bondAtomList"        Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                      [Int8]
bol' <-         BinaryData -> [Int8]
codec2 (BinaryData -> [Int8])
-> (ByteString -> BinaryData) -> ByteString -> [Int8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BinaryData
parseBinary (ByteString -> [Int8]) -> m ByteString -> m [Int8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Object
-> Text
-> (Text -> Object -> m ByteString)
-> ByteString
-> m ByteString
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD Map Text Object
mp Text
"bondOrderList"       Text -> Object -> m ByteString
forall (m :: * -> *). MonadFail m => Text -> Object -> m ByteString
asBinary ByteString
empty
                      StructureData -> m StructureData
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StructureData -> m StructureData)
-> StructureData -> m StructureData
forall a b. (a -> b) -> a -> b
$ Text
-> Text
-> Text
-> Text
-> Int32
-> Int32
-> Int32
-> Int32
-> Int32
-> Text
-> Maybe UnitCell
-> Vector M44
-> Vector Assembly
-> Vector Entity
-> Maybe Float
-> Maybe Float
-> Maybe Float
-> Vector Text
-> Vector (Int32, Int32)
-> Vector Int8
-> StructureData
StructureData Text
ttl' Text
sid' Text
dd' Text
rd' Int32
nb' Int32
na'
                                          Int32
ng' Int32
nc' Int32
nm' Text
sg' Maybe UnitCell
uc' ([M44] -> Vector M44
forall a. [a] -> Vector a
l2v [M44]
nol')
                                           ([Assembly] -> Vector Assembly
forall a. [a] -> Vector a
l2v [Assembly]
bal') ([Entity] -> Vector Entity
forall a. [a] -> Vector a
l2v [Entity]
el') Maybe Float
res' Maybe Float
rf'
                                           Maybe Float
rw' ([Text] -> Vector Text
forall a. [a] -> Vector a
l2v [Text]
em') ([(Int32, Int32)] -> Vector (Int32, Int32)
forall a. [a] -> Vector a
l2v [(Int32, Int32)]
btl') ([Int8] -> Vector Int8
forall a. [a] -> Vector a
l2v [Int8]
bol')

-- | Parses bio assembly data from ObjectMap
--
bioAssembly :: MonadFail m => Map Text Object -> m Assembly
bioAssembly :: Map Text Object -> m Assembly
bioAssembly Map Text Object
mp = do Text
nme' <- Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"name"          Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
                    [Transform]
tlt' <- Map Text Object
-> Text -> (Text -> Object -> m [Object]) -> m [Object]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"transformList" Text -> Object -> m [Object]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Object]
asObjectList m [Object] -> ([Object] -> m [Transform]) -> m [Transform]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> m Transform) -> [Object] -> m [Transform]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Object -> m (Map Text Object)
forall (m :: * -> *). MonadFail m => Object -> m (Map Text Object)
transformObjectMap (Object -> m (Map Text Object))
-> (Map Text Object -> m Transform) -> Object -> m Transform
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Map Text Object -> m Transform
forall (m :: * -> *). MonadFail m => Map Text Object -> m Transform
transform)
                    Assembly -> m Assembly
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Assembly -> m Assembly) -> Assembly -> m Assembly
forall a b. (a -> b) -> a -> b
$ Vector Transform -> Text -> Assembly
Assembly ([Transform] -> Vector Transform
forall a. [a] -> Vector a
l2v [Transform]
tlt') Text
nme'

-- | Parses transform data from ObjectMap
--
transform :: MonadFail m => Map Text Object -> m Transform
transform :: Map Text Object -> m Transform
transform Map Text Object
mp = do [Int32]
cil' <- Map Text Object
-> Text -> (Text -> Object -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"chainIndexList" Text -> Object -> m [Int32]
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m [a]
asIntList
                  M44
mtx' <- Map Text Object
-> Text -> (Text -> Object -> m [Float]) -> m [Float]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"matrix"         Text -> Object -> m [Float]
forall (m :: * -> *). MonadFail m => Text -> Object -> m [Float]
asFloatList m [Float] -> ([Float] -> m M44) -> m M44
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Float] -> m M44
forall (m :: * -> *). MonadFail m => [Float] -> m M44
m44Dec
                  Transform -> m Transform
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Transform -> m Transform) -> Transform -> m Transform
forall a b. (a -> b) -> a -> b
$ Vector Int32 -> M44 -> Transform
Transform ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
cil') M44
mtx'

-- | Parses entity data from ObjectMap
--
entity :: MonadFail m => Map Text Object -> m Entity
entity :: Map Text Object -> m Entity
entity Map Text Object
mp = do [Int32]
cil' <- Map Text Object
-> Text -> (Text -> Object -> m [Int32]) -> m [Int32]
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"chainIndexList" Text -> Object -> m [Int32]
forall (m :: * -> *) a.
(MonadFail m, Integral a) =>
Text -> Object -> m [a]
asIntList
               Text
dsc' <- Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"description"    Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
               Text
tpe' <- Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"type"           Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
               Text
sqc' <- Map Text Object -> Text -> (Text -> Object -> m Text) -> m Text
forall (m :: * -> *) a.
MonadFail m =>
Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP Map Text Object
mp Text
"sequence"       Text -> Object -> m Text
forall (m :: * -> *). MonadFail m => Text -> Object -> m Text
asStr
               Entity -> m Entity
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Entity -> m Entity) -> Entity -> m Entity
forall a b. (a -> b) -> a -> b
$ Vector Int32 -> Text -> Text -> Text -> Entity
Entity ([Int32] -> Vector Int32
forall a. [a] -> Vector a
l2v [Int32]
cil') Text
dsc' Text
tpe' Text
sqc'

-- Helper functions

-- | Converts list of chars to list of one-sized
-- (or zero-sized in case of zero) strings
c2s :: [Char] -> [Text]
c2s :: [Char] -> [Text]
c2s [] = []
c2s (Char
x:[Char]
xs) | Char -> Int
ord Char
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Text
""Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Char] -> [Text]
c2s [Char]
xs
           | Bool
otherwise  = ([Char] -> Text
pack [Char
x])Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Char] -> [Text]
c2s [Char]
xs

-- | Converst list to an array
--
l2v :: [a] -> Vector a
l2v :: [a] -> Vector a
l2v = [a] -> Vector a
forall a. [a] -> Vector a
fromList

-- | List to list of pairs
--
l2pl :: [a] -> [(a, a)]
l2pl :: [a] -> [(a, a)]
l2pl []       = []
l2pl (a
x:a
y:[a]
xs) = (a
x,a
y) (a, a) -> [(a, a)] -> [(a, a)]
forall a. a -> [a] -> [a]
: [a] -> [(a, a)]
forall a. [a] -> [(a, a)]
l2pl [a]
xs
l2pl [a]
_        = [Char] -> [(a, a)]
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot convert a list of odd length to a list of pairs"