From 295197778094310d0408f3983bba6084798f9184 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Tue, 11 Feb 2020 16:17:52 +0300 Subject: [PATCH] version 0.1.2.7: support GHC-8.8 (#26) --- ChangeLog.md | 4 ++++ package.yaml | 2 +- src/Bio/FASTA.hs | 21 +++++++++++------ src/Bio/GB.hs | 8 ++++++- src/Bio/MAE.hs | 7 +++++- src/Bio/MMTF.hs | 10 +++++++-- src/Bio/MMTF/Decode.hs | 20 ++++++++--------- src/Bio/MMTF/Decode/Codec.hs | 10 +++++++-- src/Bio/MMTF/Decode/MessagePack.hs | 36 ++++++++++++++++++------------ src/Bio/Uniprot.hs | 8 ++++++- 10 files changed, 87 insertions(+), 39 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 31a0730..0833aa8 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,10 @@ ## [Unreleased] +## [0.1.2.7] - 2020-02-11 +### Changed +- Support GHC-8.8. + ## [0.1.2.6] - 2019-12-12 ### Fixed - Fixes for instance of `StructureModels` for `Mae` when working with structures without explicit chain names. diff --git a/package.yaml b/package.yaml index cbcb79a..2b12fec 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: cobot-io -version: 0.1.2.6 +version: 0.1.2.7 github: "less-wrong/cobot-io" license: BSD3 category: Bio diff --git a/src/Bio/FASTA.hs b/src/Bio/FASTA.hs index 140b028..7ea8aee 100644 --- a/src/Bio/FASTA.hs +++ b/src/Bio/FASTA.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Bio.FASTA ( module T , fromFile @@ -6,16 +8,21 @@ module Bio.FASTA ) where import Bio.FASTA.Parser -import Bio.FASTA.Type as T -import Bio.FASTA.Writer (fastaToText) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Attoparsec.Text (parseOnly) -import Data.Text.IO (readFile, writeFile) -import Prelude hiding (writeFile, readFile) +import Bio.FASTA.Type as T +import Bio.FASTA.Writer (fastaToText) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Attoparsec.Text (parseOnly) +import Data.Text.IO (readFile, writeFile) +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail (MonadFail (..)) +import Prelude hiding (fail, readFile, writeFile) +#else +import Prelude hiding (readFile, writeFile) +#endif -- | Reads 'FastaSequence' from given file. -- -fromFile :: MonadIO m => FilePath -> m (Fasta Char) +fromFile :: (MonadFail m, MonadIO m) => FilePath -> m (Fasta Char) fromFile f = liftIO (readFile f) >>= either fail pure . parseOnly fastaP -- | Writes 'FastaSequence' to file. diff --git a/src/Bio/GB.hs b/src/Bio/GB.hs index ac54792..1b9c711 100644 --- a/src/Bio/GB.hs +++ b/src/Bio/GB.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Bio.GB ( module T , fromFile @@ -15,10 +17,14 @@ import Data.Attoparsec.Text (parseOnly) import Data.Bifunctor (first) import Data.Text (Text, pack) import qualified Data.Text.IO as TIO (readFile, writeFile) +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail (MonadFail(..)) +import Prelude hiding (fail) +#endif -- | Reads 'GenBankSequence' from givem file. -- -fromFile :: MonadIO m => FilePath -> m GenBankSequence +fromFile :: (MonadFail m, MonadIO m) => FilePath -> m GenBankSequence fromFile f = liftIO (TIO.readFile f) >>= either fail pure . parseOnly genBankP -- | Writes 'GenBankSequence' to file. diff --git a/src/Bio/MAE.hs b/src/Bio/MAE.hs index f0b9c3d..4545176 100644 --- a/src/Bio/MAE.hs +++ b/src/Bio/MAE.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -34,10 +35,14 @@ import qualified Data.Text.IO as TIO (readFile) import Data.Vector (Vector) import qualified Data.Vector as V (fromList) import Linear.V3 (V3 (..)) +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail (MonadFail(..)) +import Prelude hiding (fail) +#endif -- | Reads 'Mae' from givem file. -- -fromFile :: MonadIO m => FilePath -> m Mae +fromFile :: (MonadFail m, MonadIO m) => FilePath -> m Mae fromFile f = liftIO (TIO.readFile f) >>= either fail pure . parseOnly maeP -- | Reads 'Mae' from 'Text'. diff --git a/src/Bio/MMTF.hs b/src/Bio/MMTF.hs index f4a55a9..4b4adcf 100644 --- a/src/Bio/MMTF.hs +++ b/src/Bio/MMTF.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + {-# OPTIONS_GHC -fno-warn-orphans #-} module Bio.MMTF ( module Bio.MMTF.Type @@ -22,14 +24,18 @@ import Data.Text (Text) import Data.Vector (Vector, empty, toList, (!)) import Linear.V3 (V3 (..)) import Network.HTTP.Simple (getResponseBody, httpLBS) +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail (MonadFail(..)) +import Prelude hiding (fail) +#endif -- | Decodes a 'ByteString' to 'MMTF' -- -decode :: Monad m => ByteString -> m MMTF +decode :: MonadFail m => ByteString -> m MMTF decode = unpack -- | Fetches MMTF structure from RSCB -fetch :: MonadIO m => String -> m MMTF +fetch :: (MonadFail m, MonadIO m) => String -> m MMTF fetch pdbid = do let url = fromString $ "https://mmtf.rcsb.org/v1.0/full/" <> pdbid resp <- httpLBS url decode (getResponseBody resp) diff --git a/src/Bio/MMTF/Decode.hs b/src/Bio/MMTF/Decode.hs index dd668f5..8e895ed 100644 --- a/src/Bio/MMTF/Decode.hs +++ b/src/Bio/MMTF/Decode.hs @@ -14,19 +14,19 @@ import Data.Vector (Vector, fromList) -- | Parses format data from ObjectMap -- -formatData :: Monad m => Map Text Object -> m FormatData +formatData :: MonadFail m => Map Text Object -> m FormatData formatData mp = do v <- atP mp "mmtfVersion" asStr p <- atP mp "mmtfProducer" asStr pure $ FormatData v p -- | Parses model data from ObjectMap -- -modelData :: Monad m => Map Text Object -> m ModelData +modelData :: MonadFail m => Map Text Object -> m ModelData modelData mp = ModelData . l2v <$> atP mp "chainsPerModel" asIntList -- | Parses chain data from ObjectMap -- -chainData :: Monad m => Map Text Object -> m ChainData +chainData :: MonadFail m => Map Text Object -> m ChainData chainData mp = do gpc <- atP mp "groupsPerChain" asIntList cil <- codec5 . parseBinary <$> atP mp "chainIdList" asBinary cnl <- codec5 . parseBinary <$> atPMD mp "chainNameList" asBinary empty @@ -34,7 +34,7 @@ chainData mp = do gpc <- atP mp "groupsPerChain" asIntList -- | Parses atom data from ObjectMap -- -atomData :: Monad m => Map Text Object -> m AtomData +atomData :: MonadFail m => Map Text Object -> m AtomData atomData mp = do ail' <- codec8 . parseBinary <$> atPMD mp "atomIdList" asBinary empty all' <- c2s . codec6 . parseBinary <$> atPMD mp "altLocList" asBinary empty bfl' <- codec10 . parseBinary <$> atPMD mp "bFactorList" asBinary empty @@ -46,7 +46,7 @@ atomData mp = do ail' <- codec8 . parseBinary <$> atPMD mp "atomIdList" -- | Parses group data from ObjectMap -- -groupData :: Monad m => Map Text Object -> m GroupData +groupData :: MonadFail m => Map Text Object -> m GroupData groupData mp = do gl' <- atP mp "groupList" asObjectList >>= traverse (transformObjectMap >=> groupType) gtl' <- codec4 . parseBinary <$> atP mp "groupTypeList" asBinary gil' <- codec8 . parseBinary <$> atP mp "groupIdList" asBinary @@ -57,7 +57,7 @@ groupData mp = do gl' <- atP mp "groupL -- | Parses group type from ObjectMap -- -groupType :: Monad m => Map Text Object -> m GroupType +groupType :: MonadFail m => Map Text Object -> m GroupType groupType mp = do fcl' <- atP mp "formalChargeList" asIntList anl' <- atP mp "atomNameList" asStrList el' <- atP mp "elementList" asStrList @@ -70,7 +70,7 @@ groupType mp = do fcl' <- atP mp "formalChargeList" asIntList -- | Parses structure data from ObjectMap -- -structureData :: Monad m => Map Text Object -> m StructureData +structureData :: MonadFail m => Map Text Object -> m StructureData structureData mp = do ttl' <- atPMD mp "title" asStr "" sid' <- atPMD mp "structureId" asStr "" dd' <- atPMD mp "depositionDate" asStr "" @@ -98,21 +98,21 @@ structureData mp = do ttl' <- atPMD mp "title" -- | Parses bio assembly data from ObjectMap -- -bioAssembly :: Monad m => Map Text Object -> m Assembly +bioAssembly :: MonadFail m => Map Text Object -> m Assembly bioAssembly mp = do nme' <- atP mp "name" asStr tlt' <- atP mp "transformList" asObjectList >>= traverse (transformObjectMap >=> transform) pure $ Assembly (l2v tlt') nme' -- | Parses transform data from ObjectMap -- -transform :: Monad m => Map Text Object -> m Transform +transform :: MonadFail m => Map Text Object -> m Transform transform mp = do cil' <- atP mp "chainIndexList" asIntList mtx' <- atP mp "matrix" asFloatList >>= m44Dec pure $ Transform (l2v cil') mtx' -- | Parses entity data from ObjectMap -- -entity :: Monad m => Map Text Object -> m Entity +entity :: MonadFail m => Map Text Object -> m Entity entity mp = do cil' <- atP mp "chainIndexList" asIntList dsc' <- atP mp "description" asStr tpe' <- atP mp "type" asStr diff --git a/src/Bio/MMTF/Decode/Codec.hs b/src/Bio/MMTF/Decode/Codec.hs index d8333b5..9e478ed 100644 --- a/src/Bio/MMTF/Decode/Codec.hs +++ b/src/Bio/MMTF/Decode/Codec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Bio.MMTF.Decode.Codec where import Data.Binary (Binary, decode) @@ -9,6 +11,10 @@ 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 @@ -161,11 +167,11 @@ ssDec n | n == 0 = PiHelix | n == 7 = Coil | otherwise = Undefined -ucDec :: Monad m => [Float] -> m UnitCell +ucDec :: MonadFail m => [Float] -> m UnitCell ucDec [a,b,c,d,e,f] = pure $ UnitCell a b c d e f ucDec _ = fail "Wrong list format for unit cell" -m44Dec :: Monad m => [Float] -> m M44 +m44Dec :: MonadFail m => [Float] -> m M44 m44Dec [ a11, a12, a13, a14 , a21, a22, a23, a24 , a31, a32, a33, a34 diff --git a/src/Bio/MMTF/Decode/MessagePack.hs b/src/Bio/MMTF/Decode/MessagePack.hs index a591d77..6a46a56 100644 --- a/src/Bio/MMTF/Decode/MessagePack.hs +++ b/src/Bio/MMTF/Decode/MessagePack.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Bio.MMTF.Decode.MessagePack where import Data.ByteString.Lazy (ByteString, fromStrict) @@ -8,14 +10,20 @@ import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T (unpack) -transformObjectMap :: Monad m => Object -> m (Map Text Object) -transformObjectMap (ObjectMap kv) = let mkPair :: Monad m => (Object, Object) -> m (Text, Object) +#if !MIN_VERSION_base(4,13,0) +-- Data.MessagePack includes MonadFail constraints only for GHC-8.8+, so we can't use +-- "real" Control.Monad.Fail.MonadFail here on GHC-8.6. +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 :: Monad m => Map Text Object -> Text -> (Text -> Object -> m a) -> m a +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 @@ -25,45 +33,45 @@ atP m k conv = 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 :: Monad m => Map Text Object -> Text -> (Text -> Object -> m a) -> a -> m a +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 :: Monad m => Text -> Object -> m Text + +asStr :: MonadFail m => Text -> Object -> m Text asStr _ (ObjectStr s) = pure s asStr m _ = fail $ T.unpack m <> ": not a string data" -asChar :: Monad m => Text -> Object -> m Char +asChar :: MonadFail m => Text -> Object -> m Char asChar m = (head . T.unpack <$>) . asStr m -asInt :: (Monad m, Integral a) => Text -> Object -> m a +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 :: Monad m => Text -> Object -> m Float +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 :: (Monad m, Integral a) => Text -> Object -> m [a] +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 :: Monad m => Text -> Object -> m [Text] +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 :: Monad m => Text -> Object -> m [Float] +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 :: Monad m => Text -> Object -> m [Object] +asObjectList :: MonadFail m => Text -> Object -> m [Object] asObjectList _ (ObjectArray l) = pure l asObjectList m _ = fail $ T.unpack m <> ": not an array data" -asBinary :: Monad m => Text -> Object -> m ByteString +asBinary :: MonadFail m => Text -> Object -> m ByteString asBinary _ (ObjectBin bs) = pure (fromStrict bs) asBinary m _ = fail $ T.unpack m <> ": not a binary data" diff --git a/src/Bio/Uniprot.hs b/src/Bio/Uniprot.hs index 6c1a856..d74dc1e 100644 --- a/src/Bio/Uniprot.hs +++ b/src/Bio/Uniprot.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module Bio.Uniprot ( module T , parseRecord @@ -9,12 +11,16 @@ import Data.String ( IsString(..) ) import Data.Attoparsec.Text ( parseOnly ) import Control.Monad.IO.Class ( MonadIO ) import Network.HTTP.Simple ( httpBS, getResponseBody ) +#if !MIN_VERSION_base(4,13,0) +import Control.Monad.Fail ( MonadFail(..) ) +import Prelude hiding ( fail ) +#endif import Bio.Uniprot.Type as T import Bio.Uniprot.Parser -- | Fetches Uniprot record from Uniprot -fetch :: MonadIO m => String -> m Record +fetch :: (MonadFail m, MonadIO m) => String -> m Record fetch recid = do let url = fromString $ "https://www.uniprot.org/uniprot/" <> recid <> ".txt" resp <- httpBS url case parseOnly parseRecord (decodeUtf8 $ getResponseBody resp) of