{-# LANGUAGE OverloadedStrings #-}

module Bio.RealWorld.BioGRID
    ( TAB2(..)
    , fetchByGeneNames
    ) where

import Network.HTTP.Conduit
import Data.List
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T

accessKey :: String
accessKey :: String
accessKey = String
"accessKey=6168b8d02b2aa2e9a45af6f3afac4461"

base :: String
base :: String
base = String
"http://webservice.thebiogrid.org/"

-- | BioGRID tab2 format
data TAB2 = TAB2
    { TAB2 -> ByteString
_biogridId :: B.ByteString
    , TAB2 -> ByteString
_entrezIdA :: B.ByteString
    , TAB2 -> ByteString
_entrezIdB :: B.ByteString
    , TAB2 -> ByteString
_biogridIdA :: B.ByteString
    , TAB2 -> ByteString
_biogridIdB :: B.ByteString
    , TAB2 -> Text
_systematicNameA :: T.Text
    , TAB2 -> Text
_systematicNameB :: T.Text
    , TAB2 -> Text
_symbolA :: T.Text
    , TAB2 -> Text
_symbolB :: T.Text
    , TAB2 -> [Text]
_synonymsA :: [T.Text]
    , TAB2 -> [Text]
_synonymsB :: [T.Text]
    , TAB2 -> Text
_experimentalSystemName :: T.Text
    , TAB2 -> Text
_experimentalSystemType :: T.Text
    , TAB2 -> Text
_firstAuthor :: T.Text
    , TAB2 -> ByteString
_pubmedId :: B.ByteString
    , TAB2 -> ByteString
_organismIdA :: B.ByteString
    , TAB2 -> ByteString
_organismIdB :: B.ByteString
    , TAB2 -> Text
_throughput :: T.Text
    , TAB2 -> Maybe Double
_score :: Maybe Double
    , TAB2 -> Text
_ptm :: T.Text
    , TAB2 -> [Text]
_phenotypes :: [T.Text]
    , TAB2 -> [Text]
_qualifications :: [T.Text]
    , TAB2 -> [Text]
_tags :: [T.Text]
    , TAB2 -> Text
_source :: T.Text
    } deriving (Int -> TAB2 -> ShowS
[TAB2] -> ShowS
TAB2 -> String
(Int -> TAB2 -> ShowS)
-> (TAB2 -> String) -> ([TAB2] -> ShowS) -> Show TAB2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TAB2] -> ShowS
$cshowList :: [TAB2] -> ShowS
show :: TAB2 -> String
$cshow :: TAB2 -> String
showsPrec :: Int -> TAB2 -> ShowS
$cshowsPrec :: Int -> TAB2 -> ShowS
Show)

parseAsTab2 :: BL.ByteString -> TAB2
parseAsTab2 :: ByteString -> TAB2
parseAsTab2 ByteString
l = ByteString
-> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Text
-> Text
-> Text
-> Text
-> [Text]
-> [Text]
-> Text
-> Text
-> Text
-> ByteString
-> ByteString
-> ByteString
-> Text
-> Maybe Double
-> Text
-> [Text]
-> [Text]
-> [Text]
-> Text
-> TAB2
TAB2 (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
0)
                     (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
1)
                     (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
2)
                     (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
3)
                     (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
4)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
5)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
6)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
7)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
8)
                     (Text -> Text -> [Text]
T.splitOn Text
"|" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
9)
                     (Text -> Text -> [Text]
T.splitOn Text
"|" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
10)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
11)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
12)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
13)
                     (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
14)
                     (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
15)
                     (ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
16)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
17)
                     (String -> Maybe Double
forall a. Read a => String -> Maybe a
getScore (String -> Maybe Double) -> String -> Maybe Double
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
18)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
19)
                     (Text -> Text -> [Text]
T.splitOn Text
"|" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
20)
                     (Text -> Text -> [Text]
T.splitOn Text
"|" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
21)
                     (Text -> Text -> [Text]
T.splitOn Text
"|" (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
22)
                     (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BL.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ [ByteString]
xs[ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!!Int
23)
  where
    xs :: [ByteString]
xs = Char -> ByteString -> [ByteString]
BL.split Char
'\t' ByteString
l
    getScore :: String -> Maybe a
getScore String
"-" = Maybe a
forall a. Maybe a
Nothing
    getScore String
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. Read a => String -> a
read String
x

-- | retreive first 10,000 records
fetchByGeneNames :: [String] -> IO [TAB2]
fetchByGeneNames :: [String] -> IO [TAB2]
fetchByGeneNames [String]
genes = do
    Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"&" [String
url, String
geneList, String
tax, String
accessKey]
    let request :: Request
request = Request
initReq { method :: ByteString
method = ByteString
"GET"
                          , requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
"Content-type", ByteString
"text/plain")]
                          }
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    Response ByteString
r <- Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
request Manager
manager
    [TAB2] -> IO [TAB2]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TAB2] -> IO [TAB2]) -> [TAB2] -> IO [TAB2]
forall a b. (a -> b) -> a -> b
$ (ByteString -> TAB2) -> [ByteString] -> [TAB2]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> TAB2
parseAsTab2 ([ByteString] -> [TAB2]) -> [ByteString] -> [TAB2]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BL.lines (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
r
  where
    url :: String
url = String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/interactions/?searchNames=ture&includeInteractors=false"
    geneList :: String
geneList = String
"geneList=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" [String]
genes
    tax :: String
tax = String
"taxId=9606"
{-# INLINE fetchByGeneNames #-}