{-# LANGUAGE OverloadedStrings #-}
module Biobase.BLAST.HTTP ( BlastHTTPQuery (..),
blastHTTP,
blastTabularHTTP,
) where
import Network.HTTP.Conduit
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Char8 as B
import qualified Control.Monad as CM
import Text.XML.HXT.Core hiding (trace)
import Network.Socket
import Data.List
import Control.Concurrent
import Data.Maybe
import Network.HTTP.Base
import Biobase.BLAST.Import
import Biobase.BLAST.Types
import Biobase.Fasta.Strict
import qualified Data.Either.Unwrap as E
import Data.Int
import qualified Codec.Archive.Zip as CZ
data BlastHTTPQuery = BlastHTTPQuery
{ BlastHTTPQuery -> Maybe String
provider :: Maybe String
, BlastHTTPQuery -> Maybe String
program :: Maybe String
, BlastHTTPQuery -> Maybe String
database :: Maybe String
, BlastHTTPQuery -> [Fasta () ()]
querySequences :: [Fasta () ()]
, BlastHTTPQuery -> Maybe String
optionalArguments :: Maybe String
, BlastHTTPQuery -> Maybe Int
optionalWalltime :: Maybe Int
}
deriving (Int -> BlastHTTPQuery -> ShowS
[BlastHTTPQuery] -> ShowS
BlastHTTPQuery -> String
(Int -> BlastHTTPQuery -> ShowS)
-> (BlastHTTPQuery -> String)
-> ([BlastHTTPQuery] -> ShowS)
-> Show BlastHTTPQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlastHTTPQuery] -> ShowS
$cshowList :: [BlastHTTPQuery] -> ShowS
show :: BlastHTTPQuery -> String
$cshow :: BlastHTTPQuery -> String
showsPrec :: Int -> BlastHTTPQuery -> ShowS
$cshowsPrec :: Int -> BlastHTTPQuery -> ShowS
Show, BlastHTTPQuery -> BlastHTTPQuery -> Bool
(BlastHTTPQuery -> BlastHTTPQuery -> Bool)
-> (BlastHTTPQuery -> BlastHTTPQuery -> Bool) -> Eq BlastHTTPQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlastHTTPQuery -> BlastHTTPQuery -> Bool
$c/= :: BlastHTTPQuery -> BlastHTTPQuery -> Bool
== :: BlastHTTPQuery -> BlastHTTPQuery -> Bool
$c== :: BlastHTTPQuery -> BlastHTTPQuery -> Bool
Eq)
parseHTML :: String -> IOStateArrow s0 b0 XmlTree
parseHTML :: String -> IOStateArrow s0 b0 XmlTree
parseHTML = SysConfigList -> String -> IOStateArrow s0 b0 XmlTree
forall s b. SysConfigList -> String -> IOStateArrow s b XmlTree
readString [Bool -> SysConfig
withParseHTML Bool
yes, Bool -> SysConfig
withWarnings Bool
no]
atId :: ArrowXml a => String -> a XmlTree XmlTree
atId :: String -> a XmlTree XmlTree
atId String
elementId = a XmlTree XmlTree -> a XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
deep (a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasAttrValue String
"id" (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
elementId))
startSession :: String -> String -> String -> String -> Maybe String -> IO String
startSession :: String -> String -> String -> String -> Maybe String -> IO String
startSession String
provider' String
program' String
database' String
querySequences' Maybe String
optionalArguments'
| String
provider' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ebi" = String -> String -> String -> Maybe String -> IO String
startSessionEBI String
program' String
database' String
querySequences' Maybe String
optionalArguments'
| Bool
otherwise = String -> String -> String -> Maybe String -> IO String
startSessionNCBI String
program' String
database' String
querySequences' Maybe String
optionalArguments'
startSessionEBI :: String -> String -> String -> Maybe String -> IO String
startSessionEBI :: String -> String -> String -> Maybe String -> IO String
startSessionEBI String
program' String
database' String
querySequences' Maybe String
optionalArguments' = do
ByteString
requestXml <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
withSocketsDo
(IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Maybe String -> IO ByteString
sendQueryEBI String
program' String
database' String
querySequences' Maybe String
optionalArguments'
let requestID :: String
requestID = ByteString -> String
L8.unpack ByteString
requestXml
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
requestID
startSessionNCBI :: String -> String -> String -> Maybe String -> IO String
startSessionNCBI :: String -> String -> String -> Maybe String -> IO String
startSessionNCBI String
program' String
database' String
querySequences' Maybe String
optionalArguments' = do
ByteString
requestXml <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
withSocketsDo
(IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Maybe String -> IO ByteString
sendQueryNCBI String
program' String
database' String
querySequences' Maybe String
optionalArguments'
let requestXMLString :: String
requestXMLString = ByteString -> String
L8.unpack ByteString
requestXml
([String] -> String) -> IO [String] -> IO String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
CM.liftM [String] -> String
forall a. [a] -> a
head (IOSArrow XmlTree String -> IO [String]
forall c. IOSArrow XmlTree c -> IO [c]
runX (IOSArrow XmlTree String -> IO [String])
-> IOSArrow XmlTree String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> IOStateArrow () XmlTree XmlTree
forall s0 b0. String -> IOStateArrow s0 b0 XmlTree
parseHTML String
requestXMLString IOStateArrow () XmlTree XmlTree
-> IOStateArrow () XmlTree XmlTree
-> IOStateArrow () XmlTree XmlTree
forall (a :: * -> * -> *) (t :: * -> *) b c d.
(ArrowTree a, Tree t) =>
a b (t c) -> a (t c) d -> a b d
//> String -> IOStateArrow () XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a XmlTree XmlTree
atId String
"rid" IOStateArrow () XmlTree XmlTree
-> IOSArrow XmlTree String -> IOSArrow XmlTree String
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> String -> IOSArrow XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
"value")
sendQueryEBI :: String -> String -> String -> Maybe String -> IO L8.ByteString
sendQueryEBI :: String -> String -> String -> Maybe String -> IO ByteString
sendQueryEBI String
program' String
database' String
querySequences' Maybe String
_ = do
String -> IO ()
putStrLn String
"Making HTTP request"
Response ByteString
res <- do
Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
"http://www.ebi.ac.uk/Tools/services/rest/ncbiblast/run"
let req :: Request
req = (([(ByteString, ByteString)] -> Request -> Request)
-> Request -> [(ByteString, ByteString)] -> Request
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(ByteString, ByteString)] -> Request -> Request
urlEncodedBody) Request
initReq ([(ByteString, ByteString)] -> Request)
-> [(ByteString, ByteString)] -> Request
forall a b. (a -> b) -> a -> b
$
[ (ByteString
"email", ByteString
"florian.eggenhofer@univie.ac.at")
, (ByteString
"program", (String -> ByteString
B.pack String
program'))
, (ByteString
"database", (String -> ByteString
B.pack String
database'))
, (ByteString
"stype", ByteString
"dna")
, (ByteString
"sequence", (String -> ByteString
B.pack String
querySequences'))
]
ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings IO Manager
-> (Manager -> IO (Response ByteString))
-> IO (Response ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
req
{ method :: ByteString
method = ByteString
"POST" }
String -> IO ()
putStrLn String
"EBI Response"
Response ByteString -> IO ()
forall a. Show a => a -> IO ()
print Response ByteString
res
String -> IO ()
putStrLn String
"EBI Response Body"
ByteString -> IO ()
forall a. Show a => a -> IO ()
print (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res)
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res)
sendQueryNCBI :: String -> String -> String -> Maybe String -> IO L8.ByteString
sendQueryNCBI :: String -> String -> String -> Maybe String -> IO ByteString
sendQueryNCBI String
program' String
database' String
querySequences' Maybe String
optionalArguments'
| Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
optionalArguments' = String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp (String
"https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?CMD=Put&PROGRAM=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
program' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&DATABASE=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
database' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
optionalArguments' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&QUERY=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
querySequences')
| Bool
otherwise = String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp (String
"https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?CMD=Put&PROGRAM=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
program' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&DATABASE=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
database' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&QUERY=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
querySequences')
retrieveSessionStatus :: String -> String -> IO String
retrieveSessionStatus :: String -> String -> IO String
retrieveSessionStatus String
provider' String
rid = do
if String
provider' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ebi"
then do
ByteString
statusXml <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
withSocketsDo (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp (String
"http://www.ebi.ac.uk/Tools/services/rest/ncbiblast/status/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rid)
let statusXMLString :: String
statusXMLString = ByteString -> String
L8.unpack ByteString
statusXml
String -> IO ()
putStrLn String
"EBI statusXMLString"
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
statusXMLString
else do
ByteString
statusXml <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
withSocketsDo (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp (String
"https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?CMD=Get&FORMAT_OBJECT=SearchInfo&RID=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rid)
let statusXMLString :: String
statusXMLString = ByteString -> String
L8.unpack ByteString
statusXml
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
statusXMLString
retrieveTabularResult :: String -> String -> IO (Either String [BlastTabularResult])
retrieveTabularResult :: String -> String -> IO (Either String [BlastTabularResult])
retrieveTabularResult String
provider' String
rid = do
if String
provider' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ebi"
then do
ByteString
resultResponse <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
withSocketsDo (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp (String
"http://www.ebi.ac.uk/Tools/services/rest/ncbiblast/result/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/Tabular")
let resultHeaderLessResponse :: ByteString
resultHeaderLessResponse = Int64 -> ByteString -> ByteString
L8.drop (Int64
0 :: Int64) ByteString
resultResponse
let resultTabular :: [BlastTabularResult]
resultTabular = ByteString -> [BlastTabularResult]
parseTabularHTTPBlasts ByteString
resultHeaderLessResponse
Either String [BlastTabularResult]
-> IO (Either String [BlastTabularResult])
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlastTabularResult] -> Either String [BlastTabularResult]
forall a b. b -> Either a b
Right [BlastTabularResult]
resultTabular)
else do
ByteString
resultResponse <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
withSocketsDo (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp (String
"https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?RESULTS_FILE=on&RID=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&FORMAT_TYPE=Tabular&FORMAT_OBJECT=Alignment&CMD=Get")
let resultHeaderLessResponse :: ByteString
resultHeaderLessResponse = Int64 -> ByteString -> ByteString
L8.drop (Int64
60 :: Int64) ByteString
resultResponse
let resultTabular :: [BlastTabularResult]
resultTabular = ByteString -> [BlastTabularResult]
parseTabularHTTPBlasts ByteString
resultHeaderLessResponse
Either String [BlastTabularResult]
-> IO (Either String [BlastTabularResult])
forall (m :: * -> *) a. Monad m => a -> m a
return ([BlastTabularResult] -> Either String [BlastTabularResult]
forall a b. b -> Either a b
Right [BlastTabularResult]
resultTabular)
retrieveJSONResult :: String -> String -> IO (Either String BlastJSON2)
retrieveJSONResult :: String -> String -> IO (Either String BlastJSON2)
retrieveJSONResult String
provider' String
rid = do
ByteString
resultResponse <- IO ByteString -> IO ByteString
forall a. IO a -> IO a
withSocketsDo (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp (String
"https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?RESULTS_FILE=on&RID=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rid String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&FORMAT_TYPE=JSON2&FORMAT_OBJECT=Alignment&CMD=Get")
let archive :: Archive
archive = ByteString -> Archive
CZ.toArchive ByteString
resultResponse
let files :: [String]
files = Archive -> [String]
CZ.filesInArchive Archive
archive
let bs :: ByteString
bs = Entry -> ByteString
CZ.fromEntry (Maybe Entry -> Entry
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Archive -> Maybe Entry
CZ.findEntryByPath ([String]
files [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int
1) Archive
archive))
let eitherjson :: Either String BlastJSON2
eitherjson = ByteString -> Either String BlastJSON2
parseJSONBlast ByteString
bs
Either String BlastJSON2 -> IO (Either String BlastJSON2)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String BlastJSON2
eitherjson
checkSessionStatus :: String -> String -> Maybe Int -> Int -> IO (Either String String)
checkSessionStatus :: String -> String -> Maybe Int -> Int -> IO (Either String String)
checkSessionStatus String
provider' String
rid Maybe Int
walltime Int
consumedTime = do
Int -> IO ()
threadDelay Int
120000000
String
status <- String -> String -> IO String
retrieveSessionStatus String
provider' String
rid
if (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
walltime)
then do
String
-> String
-> String
-> Maybe Int
-> Int
-> IO (Either String String)
waitOrRetrieve String
provider' String
status String
rid Maybe Int
walltime Int
consumedTime
else do
if (Int
consumedTime Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
walltime))
then do
String
-> String
-> String
-> Maybe Int
-> Int
-> IO (Either String String)
waitOrRetrieve String
provider' String
status String
rid Maybe Int
walltime (Int
consumedTime Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
120000000)
else do
let exceptionMessage :: String
exceptionMessage = String
"BLASTHTTP: Query did not return result within walltime"
Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
exceptionMessage)
waitOrRetrieve :: String -> String -> String -> Maybe Int -> Int -> IO (Either String String)
waitOrRetrieve :: String
-> String
-> String
-> Maybe Int
-> Int
-> IO (Either String String)
waitOrRetrieve String
provider' String
status String
rid Maybe Int
walltime Int
consumedTime
| String
provider' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"ebi" = String -> String -> Maybe Int -> Int -> IO (Either String String)
waitOrRetrieveEBI String
status String
rid Maybe Int
walltime Int
consumedTime
| Bool
otherwise = String -> String -> Maybe Int -> Int -> IO (Either String String)
waitOrRetrieveNCBI String
status String
rid Maybe Int
walltime Int
consumedTime
waitOrRetrieveEBI :: String -> String -> Maybe Int -> Int -> IO (Either String String)
waitOrRetrieveEBI :: String -> String -> Maybe Int -> Int -> IO (Either String String)
waitOrRetrieveEBI String
status String
rid Maybe Int
walltime Int
consumedTime
| String
"FINISHED" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. b -> Either a b
Right String
rid)
| String
"FAILURE" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = do
let exceptionMessage :: String
exceptionMessage = String
"BLASTHTTP: The EBI blast job failed."
Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
exceptionMessage)
| String
"ERROR" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = do
let exceptionMessage :: String
exceptionMessage = String
"BLASTHTTP: An error occurred attempting to get the EBI blast job status."
Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
exceptionMessage)
| String
"NOT_FOUND" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = do
let exceptionMessage :: String
exceptionMessage = String
"BLASTHTTP: The EBI blast job cannot be found."
Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
exceptionMessage)
| Bool
otherwise = String -> String -> Maybe Int -> Int -> IO (Either String String)
checkSessionStatus String
"ebi" String
rid Maybe Int
walltime Int
consumedTime
waitOrRetrieveNCBI :: String -> String -> Maybe Int -> Int -> IO (Either String String)
waitOrRetrieveNCBI :: String -> String -> Maybe Int -> Int -> IO (Either String String)
waitOrRetrieveNCBI String
status String
rid Maybe Int
walltime Int
consumedTime
| String
"Status=READY" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. b -> Either a b
Right String
rid)
| String
"Status=FAILURE" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = do
let exceptionMessage :: String
exceptionMessage = String
"Search $rid failed; please report to blast-help at ncbi.nlm.nih.gov.\n"
Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
exceptionMessage)
| String
"Status=UNKNOWN" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = do
let exceptionMessage :: String
exceptionMessage = String
"Search $rid expired.\n"
Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
exceptionMessage)
| String
"Status=WAITING" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
status = do
String -> String -> Maybe Int -> Int -> IO (Either String String)
checkSessionStatus String
"ncbi" String
rid Maybe Int
walltime Int
consumedTime
| Bool
otherwise = do
let exceptionMessage :: String
exceptionMessage = String
"Status has unexpected value " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
status String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - aborting blast search\n"
Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String String
forall a b. a -> Either a b
Left String
exceptionMessage)
blastTabularHTTP :: BlastHTTPQuery -> IO (Either String [BlastTabularResult])
blastTabularHTTP :: BlastHTTPQuery -> IO (Either String [BlastTabularResult])
blastTabularHTTP (BlastHTTPQuery Maybe String
provider' Maybe String
program' Maybe String
database' [Fasta () ()]
querySequences' Maybe String
optionalArguments' Maybe Int
walltime') = do
let defaultProvider :: String
defaultProvider = String
"ncbi"
let defaultProgram :: String
defaultProgram = String
"blastn"
let defaultDatabase :: String
defaultDatabase = String
"refseq_genomic"
let defaultWalltime :: Maybe a
defaultWalltime = Maybe a
forall a. Maybe a
Nothing
let selectedProvider :: String
selectedProvider = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultProvider Maybe String
provider'
let selectedProgram :: String
selectedProgram = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultProgram Maybe String
program'
let selectedDatabase :: String
selectedDatabase = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultDatabase Maybe String
database'
let selectedWalltime :: Maybe Int
selectedWalltime = Maybe Int -> (Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
forall a. Maybe a
defaultWalltime Int -> Maybe Int
forall a. a -> Maybe a
Just Maybe Int
walltime'
String
-> String
-> String
-> [Fasta () ()]
-> Maybe String
-> Maybe Int
-> IO (Either String [BlastTabularResult])
performTabularQuery String
selectedProvider String
selectedProgram String
selectedDatabase [Fasta () ()]
querySequences' Maybe String
optionalArguments' Maybe Int
selectedWalltime
blastHTTP :: BlastHTTPQuery -> IO (Either String BlastJSON2)
blastHTTP :: BlastHTTPQuery -> IO (Either String BlastJSON2)
blastHTTP (BlastHTTPQuery Maybe String
provider' Maybe String
program' Maybe String
database' [Fasta () ()]
querySequences' Maybe String
optionalArguments' Maybe Int
walltime') = do
let defaultProvider :: String
defaultProvider = String
"ncbi"
let defaultProgram :: String
defaultProgram = String
"blastn"
let defaultDatabase :: String
defaultDatabase = String
"refseq_genomic"
let defaultWalltime :: Maybe a
defaultWalltime = Maybe a
forall a. Maybe a
Nothing
let selectedProvider :: String
selectedProvider = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultProvider Maybe String
provider'
let selectedProgram :: String
selectedProgram = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultProgram Maybe String
program'
let selectedDatabase :: String
selectedDatabase = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
defaultDatabase Maybe String
database'
let selectedWalltime :: Maybe Int
selectedWalltime = Maybe Int -> (Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe Int
forall a. Maybe a
defaultWalltime Int -> Maybe Int
forall a. a -> Maybe a
Just Maybe Int
walltime'
String
-> String
-> String
-> [Fasta () ()]
-> Maybe String
-> Maybe Int
-> IO (Either String BlastJSON2)
performJSONQuery String
selectedProvider String
selectedProgram String
selectedDatabase [Fasta () ()]
querySequences' Maybe String
optionalArguments' Maybe Int
selectedWalltime
performTabularQuery :: String -> String -> String -> [Fasta () ()] -> Maybe String -> Maybe Int -> IO (Either String [BlastTabularResult])
performTabularQuery :: String
-> String
-> String
-> [Fasta () ()]
-> Maybe String
-> Maybe Int
-> IO (Either String [BlastTabularResult])
performTabularQuery String
provider' String
program' String
database' [Fasta () ()]
querySequences' Maybe String
optionalArgumentMaybe Maybe Int
walltime
| [Fasta () ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Fasta () ()]
querySequences' = do
let exceptionMessage :: String
exceptionMessage = String
"Error - no query sequence provided"
Either String [BlastTabularResult]
-> IO (Either String [BlastTabularResult])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String [BlastTabularResult]
forall a b. a -> Either a b
Left String
exceptionMessage)
| Bool
otherwise = do
let sequenceString :: String
sequenceString = ShowS
urlEncode ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Fasta () () -> String) -> [Fasta () ()] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> String)
-> (Fasta () () -> ByteString) -> Fasta () () -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Fasta () () -> ByteString
forall k1 k2 (which :: k1) (ty :: k2).
Int -> Fasta which ty -> ByteString
fastaToByteString Int
999999999) [Fasta () ()]
querySequences'
String
rid <- String -> String -> String -> String -> Maybe String -> IO String
startSession String
provider' String
program' String
database' String
sequenceString (String -> Maybe String
forall a. a -> Maybe a
Just (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"&FORMAT_TYPE=TABULAR" (String
"&FORMAT_TYPE=TABULAR" String -> ShowS
forall a. [a] -> [a] -> [a]
++) Maybe String
optionalArgumentMaybe))
Either String String
sessionStatus <- String -> String -> Maybe Int -> Int -> IO (Either String String)
checkSessionStatus String
provider' String
rid Maybe Int
walltime (Int
0 :: Int)
if Either String String -> Bool
forall a b. Either a b -> Bool
E.isRight Either String String
sessionStatus
then String -> String -> IO (Either String [BlastTabularResult])
retrieveTabularResult String
provider' String
rid
else Either String [BlastTabularResult]
-> IO (Either String [BlastTabularResult])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String [BlastTabularResult]
forall a b. a -> Either a b
Left (Either String String -> String
forall a b. Either a b -> a
E.fromLeft Either String String
sessionStatus))
performJSONQuery :: String -> String -> String -> [Fasta () ()] -> Maybe String -> Maybe Int -> IO (Either String BlastJSON2)
performJSONQuery :: String
-> String
-> String
-> [Fasta () ()]
-> Maybe String
-> Maybe Int
-> IO (Either String BlastJSON2)
performJSONQuery String
provider' String
program' String
database' [Fasta () ()]
querySequences' Maybe String
optionalArgumentMaybe Maybe Int
walltime
| [Fasta () ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Fasta () ()]
querySequences' = do
let exceptionMessage :: String
exceptionMessage = String
"Error - no query sequence provided"
Either String BlastJSON2 -> IO (Either String BlastJSON2)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String BlastJSON2
forall a b. a -> Either a b
Left String
exceptionMessage)
| Bool
otherwise = do
let sequenceString :: String
sequenceString = ShowS
urlEncode ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Fasta () () -> String) -> [Fasta () ()] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ByteString -> String
forall a b. ConvertibleStrings a b => a -> b
convertString (ByteString -> String)
-> (Fasta () () -> ByteString) -> Fasta () () -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Fasta () () -> ByteString
forall k1 k2 (which :: k1) (ty :: k2).
Int -> Fasta which ty -> ByteString
fastaToByteString Int
999999999) [Fasta () ()]
querySequences'
String
rid <- String -> String -> String -> String -> Maybe String -> IO String
startSession String
provider' String
program' String
database' String
sequenceString (String -> Maybe String
forall a. a -> Maybe a
Just (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"" String -> ShowS
forall a. [a] -> [a] -> [a]
++) Maybe String
optionalArgumentMaybe))
Either String String
sessionStatus <- String -> String -> Maybe Int -> Int -> IO (Either String String)
checkSessionStatus String
provider' String
rid Maybe Int
walltime (Int
0 :: Int)
if Either String String -> Bool
forall a b. Either a b -> Bool
E.isRight Either String String
sessionStatus
then String -> String -> IO (Either String BlastJSON2)
retrieveJSONResult String
provider' String
rid
else Either String BlastJSON2 -> IO (Either String BlastJSON2)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String BlastJSON2
forall a b. a -> Either a b
Left (Either String String -> String
forall a b. Either a b -> a
E.fromLeft Either String String
sessionStatus))