{-# 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 #-}