{-# LANGUAGE OverloadedStrings #-}

module Bio.RealWorld.Uniprot
    ( mapID
    ) where

import           Conduit
import qualified Data.ByteString.Char8 as B
import qualified Data.HashMap.Strict   as M
import           Network.HTTP.Conduit

base :: String
base :: String
base = String
"http://www.uniprot.org/uploadlists/"

mapID :: [B.ByteString]   -- ^ A list of IDs
      -> B.ByteString     -- ^ From database
      -> B.ByteString     -- ^ To database
      -> IO [Maybe B.ByteString]
mapID :: [ByteString] -> ByteString -> ByteString -> IO [Maybe ByteString]
mapID [ByteString]
ids ByteString
from ByteString
to = do
    Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
base
    let request :: Request
request = [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString [(ByteString, Maybe ByteString)]
query Request
initReq
            { method :: ByteString
method = ByteString
"GET"
            , requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
"User-Agent", ByteString
"kk@test.org")]
            }
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    HashMap ByteString ByteString
r <- ([(ByteString, ByteString)] -> HashMap ByteString ByteString)
-> IO [(ByteString, ByteString)]
-> IO (HashMap ByteString ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ByteString, ByteString)] -> HashMap ByteString ByteString
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList (IO [(ByteString, ByteString)]
 -> IO (HashMap ByteString ByteString))
-> IO [(ByteString, ByteString)]
-> IO (HashMap ByteString ByteString)
forall a b. (a -> b) -> a -> b
$ ResourceT IO [(ByteString, ByteString)]
-> IO [(ByteString, ByteString)]
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO [(ByteString, ByteString)]
 -> IO [(ByteString, ByteString)])
-> ResourceT IO [(ByteString, ByteString)]
-> IO [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ do
        Response (ConduitM () ByteString (ResourceT IO) ())
response <- Request
-> Manager
-> ResourceT
     IO (Response (ConduitM () ByteString (ResourceT IO) ()))
forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
http Request
request Manager
manager
        ConduitT () Void (ResourceT IO) [(ByteString, ByteString)]
-> ResourceT IO [(ByteString, ByteString)]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) [(ByteString, ByteString)]
 -> ResourceT IO [(ByteString, ByteString)])
-> ConduitT () Void (ResourceT IO) [(ByteString, ByteString)]
-> ResourceT IO [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () ByteString (ResourceT IO) ())
-> ConduitM () ByteString (ResourceT IO) ()
forall body. Response body -> body
responseBody Response (ConduitM () ByteString (ResourceT IO) ())
response ConduitM () ByteString (ResourceT IO) ()
-> ConduitM
     ByteString Void (ResourceT IO) [(ByteString, ByteString)]
-> ConduitT () Void (ResourceT IO) [(ByteString, ByteString)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq, Element seq ~ Word8) =>
ConduitT seq seq m ()
linesUnboundedAsciiC ConduitT ByteString ByteString (ResourceT IO) ()
-> ConduitM
     ByteString Void (ResourceT IO) [(ByteString, ByteString)]
-> ConduitM
     ByteString Void (ResourceT IO) [(ByteString, ByteString)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.|
            (Int
-> ConduitT ByteString (ByteString, ByteString) (ResourceT IO) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1 ConduitT ByteString (ByteString, ByteString) (ResourceT IO) ()
-> ConduitT ByteString (ByteString, ByteString) (ResourceT IO) ()
-> ConduitT ByteString (ByteString, ByteString) (ResourceT IO) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> (ByteString, ByteString))
-> ConduitT ByteString (ByteString, ByteString) (ResourceT IO) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC ((\[ByteString
a,ByteString
b] -> (ByteString
a,ByteString
b)) ([ByteString] -> (ByteString, ByteString))
-> (ByteString -> [ByteString])
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
B.split Char
'\t')) ConduitT ByteString (ByteString, ByteString) (ResourceT IO) ()
-> ConduitM
     (ByteString, ByteString)
     Void
     (ResourceT IO)
     [(ByteString, ByteString)]
-> ConduitM
     ByteString Void (ResourceT IO) [(ByteString, ByteString)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM
  (ByteString, ByteString)
  Void
  (ResourceT IO)
  [(ByteString, ByteString)]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
    [Maybe ByteString] -> IO [Maybe ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Maybe ByteString] -> IO [Maybe ByteString])
-> [Maybe ByteString] -> IO [Maybe ByteString]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe ByteString)
-> [ByteString] -> [Maybe ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> HashMap ByteString ByteString -> Maybe ByteString)
-> HashMap ByteString ByteString -> ByteString -> Maybe ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> HashMap ByteString ByteString -> Maybe ByteString
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup HashMap ByteString ByteString
r) [ByteString]
ids
  where
    query :: [(ByteString, Maybe ByteString)]
query = [ (ByteString
"from", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
from)
            , (ByteString
"to", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
to)
            , (ByteString
"format", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"tab")
            , (ByteString
"query", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.unwords [ByteString]
ids)
            ]