{-# LANGUAGE OverloadedStrings #-}

-- | Searches a provided sequence with the NCBI Blast REST service and returns a blast result in xml format as BlastReport.
--
-- The function blastHTTP takes the BlastHTTPQuery datatype as argument, which contains following elements:
--
-- 1. program:  Selects the blast-program to be used for the query. Example values are blastn, blastp, blastx,.. If Nothing is used as argument the function will default to blastn. Type: Maybe String
--
-- 2. database: Selects the database to be queried against. Example values are refseq_genomic, nr, est,.. Please consider that the database must be chosen in accordance with the blastprogram. Default value: refseq_genomic. Type: Maybe String
--
-- 3. querySequences: nucleotides or protein sequences, depending on the blast program used. If no sequence is provided an exception as String will be produced. Type: [Fasta]
--
-- 4. optionalArguments: This argument is optional and will filter the result if provided. Type: Maybe String
--
-- 5. optionalWalltime: Optional walltime in mircroseconds. If specified, will terminate the query after reaching the timelimit and return Left. Type: Maybe Int
--
-- and returns Either a BlastReport (Right) on success or an exception as String (Left)
--
-- If you plan to submit more than 20 searches in one session, please look up the Usage Guidelines in the webservice information <http://www.ncbi.nlm.nih.gov/BLAST/developer.shtml>.
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 Biobase.Fasta.Export()
import qualified Data.Either.Unwrap as E
import Data.Int
--import Debug.Trace
--import qualified Data.Aeson as DA
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)

-- | Parse HTML results into Xml Tree datastructure
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]

-- | Gets all subtrees with the specified id attribute
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))

-- | Send query and parse RID from retrieved HTML
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")

-- | Send query with or without optional arguments and return response HTML
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
    --initReq <- parseUrl "http://postcatcher.in/catchers/541811052cb53502000001a7"
    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)

-- | Send query with or without optional arguments and return response HTML
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')

-- | Retrieve session status with RID
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

-- | Retrieve result in blast tabular format with RID
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)

-- | Retrieve result in blast tabular format with RID
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

-- | Check if job results are ready and then retrieves results
--   If a walltime in microseconds was set query retrieval will termiate after it is consumed and return a Left result
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)
-- RUNNING
  | 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
  --Unexpected status, return Left
  | 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)

-- | Retrieve Blast results in Blast tabular format from the NCBI REST Blast interface
-- The querySequence has to be provided, all other parameters are optional and can be set to Nothing
-- optionalArguments is attached to the query as is .e.g: "&ALIGNMENTS=250"
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'
  --walltime of 1h in microseconds
  --let walltime = Just (7200000000 ::Int)
  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

-- | Retrieve Blast results in Blast JSON2 format from the NCBI REST Blast interface
-- The querySequence has to be provided, all other parameters are optional and can be set to Nothing
-- optionalArguments is attached to the query as is .e.g: "&ALIGNMENTS=250"
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'
  --walltime of 1h in microseconds
  --let walltime = Just (7200000000 ::Int)
  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

-- | Sends Query and retrieves result on reaching READY status, will return exeption message if no query sequence has been provided
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
     -- TODO do not use @concatMap show@.
     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'
     -- (concatMap show 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))


-- | Sends Query and retrieves result on reaching READY status, will return exeption message if no query sequence has been provided
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
     -- TODO see comment above!
     -- let sequenceString = urlEncode (concatMap show querySequences')
     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)
     --result <- retrieveJSONResult provider' rid
     --return (Right result)
     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))