{-# LANGUAGE OverloadedStrings #-}
module Bio.RealWorld.Ensembl
    ( lookup
    ) where

import Prelude hiding (lookup)
import Data.Aeson
import Data.List.Split (chunksOf)
import qualified Data.ByteString.Char8 as B
import qualified Data.HashMap.Strict as M
import Network.HTTP.Conduit

import Bio.RealWorld.ID (BioID(..), EnsemblID)

base :: String
base :: String
base = String
"http://rest.ensembl.org/"

lookup :: [EnsemblID] -> IO (Either String Object)
lookup :: [EnsemblID] -> IO (Either String Object)
lookup [EnsemblID]
xs = do
    [Either String Object]
rs <- ([EnsemblID] -> IO (Either String Object))
-> [[EnsemblID]] -> IO [Either String Object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [EnsemblID] -> IO (Either String Object)
lookupHelp ([[EnsemblID]] -> IO [Either String Object])
-> [[EnsemblID]] -> IO [Either String Object]
forall a b. (a -> b) -> a -> b
$ Int -> [EnsemblID] -> [[EnsemblID]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
1000 [EnsemblID]
xs
    Either String Object -> IO (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> IO (Either String Object))
-> Either String Object -> IO (Either String Object)
forall a b. (a -> b) -> a -> b
$ (Either String Object
 -> Either String Object -> Either String Object)
-> [Either String Object] -> Either String Object
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Either String Object
-> Either String Object -> Either String Object
forall (m :: * -> *) k v.
(Monad m, Eq k, Hashable k) =>
m (HashMap k v) -> m (HashMap k v) -> m (HashMap k v)
f [Either String Object]
rs
  where
    f :: m (HashMap k v) -> m (HashMap k v) -> m (HashMap k v)
f m (HashMap k v)
a m (HashMap k v)
b = do
        HashMap k v
a' <- m (HashMap k v)
a
        HashMap k v
b' <- m (HashMap k v)
b
        HashMap k v -> m (HashMap k v)
forall (m :: * -> *) a. Monad m => a -> m a
return (HashMap k v -> m (HashMap k v)) -> HashMap k v -> m (HashMap k v)
forall a b. (a -> b) -> a -> b
$ HashMap k v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
M.union HashMap k v
a' HashMap k v
b'

lookupHelp :: [EnsemblID] -> IO (Either String Object)
lookupHelp :: [EnsemblID] -> IO (Either String Object)
lookupHelp [EnsemblID]
xs = do
    Request
initReq <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
    let request :: Request
request = Request
initReq { method :: Method
method = Method
"POST"
                          , requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
"Content-type", Method
"application/json")]
                          , requestBody :: RequestBody
requestBody = RequestBody
body
                          }
    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
    Either String Object -> IO (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> IO (Either String Object))
-> (Response ByteString -> Either String Object)
-> Response ByteString
-> IO (Either String Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Object
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Object)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Either String Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> IO (Either String Object))
-> Response ByteString -> IO (Either String Object)
forall a b. (a -> b) -> a -> b
$ Response ByteString
r
  where
    url :: String
url = String
base String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/lookup/id/"
    ids :: Method
ids = String -> Method
B.pack (String -> Method) -> String -> Method
forall a b. (a -> b) -> a -> b
$ [Method] -> String
forall a. Show a => a -> String
show ([Method] -> String) -> [Method] -> String
forall a b. (a -> b) -> a -> b
$ (EnsemblID -> Method) -> [EnsemblID] -> [Method]
forall a b. (a -> b) -> [a] -> [b]
map EnsemblID -> Method
forall a. BioID a => a -> Method
fromID [EnsemblID]
xs
    body :: RequestBody
body = Method -> RequestBody
RequestBodyBS (Method -> RequestBody) -> Method -> RequestBody
forall a b. (a -> b) -> a -> b
$ Method -> [Method] -> Method
B.intercalate Method
"" [Method
"{ \"ids\" :", Method
ids, Method
"}"]
{-# INLINE lookupHelp #-}