{-# LANGUAGE CPP #-}
module Bio.MMTF.Decode.MessagePack where
import Data.ByteString.Lazy (ByteString, fromStrict)
import Data.Map.Strict (Map, fromList)
import qualified Data.Map.Strict as M (lookup)
import Data.MessagePack
import Data.Text (Text)
import qualified Data.Text as T (unpack)
#if !MIN_VERSION_base(4,13,0)
type MonadFail m = Monad m
#endif
transformObjectMap :: MonadFail m => Object -> m (Map Text Object)
transformObjectMap (ObjectMap kv) = let mkPair :: MonadFail m => (Object, Object) -> m (Text, Object)
mkPair (ObjectStr txt, v) = pure (txt, v)
mkPair _ = fail "Non-string key"
in fromList <$> traverse mkPair kv
transformObjectMap _ = fail "Wrong MessagePack MMTF format"
atP :: MonadFail m => Map Text Object -> Text -> (Text -> Object -> m a) -> m a
atP m k conv =
case M.lookup k m of
Just x -> conv k x
Nothing -> fail $ "Required field '" ++ uk ++ "' was not found"
where uk = T.unpack k
atPM :: Monad m => Map Text Object -> Text -> (Text -> Object -> m a) -> m (Maybe a)
atPM m k conv = traverse (conv k) $ M.lookup k m
atPMD :: MonadFail m => Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a
atPMD m k conv def = do x <- atPM m k conv
case x of
Just r -> pure r
Nothing -> pure def
asStr :: MonadFail m => Text -> Object -> m Text
asStr _ (ObjectStr s) = pure s
asStr m _ = fail $ T.unpack m <> ": not a string data"
asChar :: MonadFail m => Text -> Object -> m Char
asChar m = (head . T.unpack <$>) . asStr m
asInt :: (MonadFail m, Integral a) => Text -> Object -> m a
asInt _ (ObjectInt i) = pure (fromIntegral i)
asInt _ (ObjectWord w) = pure (fromIntegral w)
asInt m _ = fail $ T.unpack m <> ": not an int data"
asFloat :: MonadFail m => Text -> Object -> m Float
asFloat _ (ObjectFloat f) = pure f
asFloat _ (ObjectDouble f) = pure (realToFrac f)
asFloat m _ = fail $ T.unpack m <> ": not a float data"
asIntList :: (MonadFail m, Integral a) => Text -> Object -> m [a]
asIntList m (ObjectArray l) = traverse (asInt m) l
asIntList m _ = fail $ T.unpack m <> ": not an array of ints data"
asStrList :: MonadFail m => Text -> Object -> m [Text]
asStrList m (ObjectArray l) = traverse (asStr m) l
asStrList m _ = fail $ T.unpack m <> ": not an array of string data"
asFloatList :: MonadFail m => Text -> Object -> m [Float]
asFloatList m (ObjectArray l) = traverse (asFloat m) l
asFloatList m _ = fail $ T.unpack m <> ": not an array of float data"
asObjectList :: MonadFail m => Text -> Object -> m [Object]
asObjectList _ (ObjectArray l) = pure l
asObjectList m _ = fail $ T.unpack m <> ": not an array data"
asBinary :: MonadFail m => Text -> Object -> m ByteString
asBinary _ (ObjectBin bs) = pure (fromStrict bs)
asBinary m _ = fail $ T.unpack m <> ": not a binary data"