{-# LANGUAGE OverloadedStrings #-}

module Bio.RealWorld.ENCODE
    ( KeyWords(..)
    , search

    -- * common search
    , terms
    , cellIs
    , organismIs
    , assayIs

    -- * specific search
    , getFile
    , queryById
    , openUrl
    , jsonFromUrl

    -- * Inspection
    , (|@)
    , (|!)
    , as
    , (&)

    -- * printing
    , showResult
    ) where

import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.Aeson.KeyMap as M
import qualified Data.Aeson.Key as M
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as BS
import qualified Data.Sequence as S
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Maybe (fromMaybe)
import Network.HTTP.Conduit
import Data.Default.Class

import Bio.RealWorld.ID

-- | Terms and constraints.
data KeyWords = KeyWords (S.Seq String) (S.Seq String)

instance Default KeyWords where
    def :: KeyWords
def = Seq String -> Seq String -> KeyWords
KeyWords Seq String
forall a. Seq a
S.empty (Seq String -> KeyWords) -> Seq String -> KeyWords
forall a b. (a -> b) -> a -> b
$ [String] -> Seq String
forall a. [a] -> Seq a
S.fromList [String
"frame=object", String
"limit=all"]

instance Show KeyWords where
    show :: KeyWords -> String
show (KeyWords Seq String
x Seq String
y) = Seq String -> String
f Seq String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ Seq String -> String
g Seq String
y
      where
        f :: Seq String -> String
f Seq String
x' | Seq String -> Bool
forall a. Seq a -> Bool
S.null Seq String
x' = String
""
             | Bool
otherwise = String
"searchTerm=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> ShowS) -> Seq String -> String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\String
a String
b -> String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'+'Char -> ShowS
forall a. a -> [a] -> [a]
:String
a)) Seq String
x' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"&"
        g :: Seq String -> String
g Seq String
y' | Seq String -> Bool
forall a. Seq a -> Bool
S.null Seq String
y' = String
""
             | Bool
otherwise =  (String -> ShowS) -> Seq String -> String
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\String
a String
b -> String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'&'Char -> ShowS
forall a. a -> [a] -> [a]
:String
a)) Seq String
y'

instance Semigroup KeyWords where
    <> :: KeyWords -> KeyWords -> KeyWords
(<>) (KeyWords Seq String
a Seq String
b) (KeyWords Seq String
a' Seq String
b') = Seq String -> Seq String -> KeyWords
KeyWords (Seq String
a Seq String -> Seq String -> Seq String
forall a. Seq a -> Seq a -> Seq a
S.>< Seq String
a') (Seq String
b Seq String -> Seq String -> Seq String
forall a. Seq a -> Seq a -> Seq a
S.>< Seq String
b')

base :: String
base :: String
base = String
"https://www.encodeproject.org/"

-- | general search using keywords and a set of constraints. Example:
-- search ["chip", "sp1"] ["type=experiment"]
search :: KeyWords -> IO (Either String [Value])
search :: KeyWords -> IO (Either String [Value])
search KeyWords
kw = 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
"GET"
                          , requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
"accept", Method
"application/json")]
                          }
    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 [Value] -> IO (Either String [Value])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [Value] -> IO (Either String [Value]))
-> Either String [Value] -> IO (Either String [Value])
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Value)
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Either String Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody) Response ByteString
r Either String Value
-> (Value -> Either String [Value]) -> Either String [Value]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        (Value -> Parser [Value]) -> Value -> Either String [Value]
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (String -> (Object -> Parser [Value]) -> Value -> Parser [Value]
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ENCODE_JSON" (Object -> Key -> Parser [Value]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"@graph"))
  where
    url :: String
url = String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"search/?" String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyWords -> String
forall a. Show a => a -> String
show KeyWords
kw

showResult :: Value -> IO ()
showResult :: Value -> IO ()
showResult = ByteString -> IO ()
B.putStrLn (ByteString -> IO ()) -> (Value -> ByteString) -> Value -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty

terms :: [String] -> KeyWords
terms :: [String] -> KeyWords
terms [String]
xs = Seq String -> Seq String -> KeyWords
KeyWords ([String] -> Seq String
forall a. [a] -> Seq a
S.fromList [String]
xs) Seq String
forall a. Seq a
S.empty

assayIs :: String -> KeyWords
assayIs :: String -> KeyWords
assayIs String
x = Seq String -> Seq String -> KeyWords
KeyWords Seq String
forall a. Seq a
S.empty (Seq String -> KeyWords) -> Seq String -> KeyWords
forall a b. (a -> b) -> a -> b
$
                     [String] -> Seq String
forall a. [a] -> Seq a
S.fromList [String
"type=experiment", String
"assay_term_name=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x]

organismIs :: String -> KeyWords
organismIs :: String -> KeyWords
organismIs String
x = Seq String -> Seq String -> KeyWords
KeyWords Seq String
forall a. Seq a
S.empty (Seq String -> KeyWords) -> Seq String -> KeyWords
forall a b. (a -> b) -> a -> b
$
    [String] -> Seq String
forall a. [a] -> Seq a
S.fromList [String
"replicates.library.biosample.donor.organism.scientific_name=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x]

cellIs :: String -> KeyWords
cellIs :: String -> KeyWords
cellIs String
x = Seq String -> Seq String -> KeyWords
KeyWords Seq String
forall a. Seq a
S.empty (Seq String -> KeyWords) -> Seq String -> KeyWords
forall a b. (a -> b) -> a -> b
$ [String] -> Seq String
forall a. [a] -> Seq a
S.fromList [String
"biosample_term_name=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x]

-- | accession
queryById :: EncodeAcc -> IO (Either String Value)
queryById :: EncodeAcc -> IO (Either String Value)
queryById EncodeAcc
acc = String -> IO (Either String Value)
jsonFromUrl (String -> IO (Either String Value))
-> String -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String
"experiments/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Method -> String
BS.unpack (EncodeAcc -> Method
forall a. BioID a => a -> Method
fromID EncodeAcc
acc)

getFile :: FilePath -> String -> IO ()
getFile :: String -> String -> IO ()
getFile String
out String
url = String -> String -> IO ByteString
openUrl (String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
url) String
"application/octet-stream" IO ByteString -> (ByteString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                  String -> ByteString -> IO ()
B.writeFile String
out

openUrl :: String -> String -> IO B.ByteString
openUrl :: String -> String -> IO ByteString
openUrl String
url String
datatype = 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
"GET"
                          , requestHeaders :: RequestHeaders
requestHeaders = [(HeaderName
"accept", String -> Method
BS.pack String
datatype)]
                          }
    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
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
r

jsonFromUrl :: String -> IO (Either String Value)
jsonFromUrl :: String -> IO (Either String Value)
jsonFromUrl String
url = ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String Value)
-> IO ByteString -> IO (Either String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO ByteString
openUrl (String
base String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
url) String
"application/json"


(|@) :: Value -> T.Text -> Value
|@ :: Value -> Text -> Value
(|@) (Object Object
obj) Text
key = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe (String -> Value
forall a. HasCallStack => String -> a
error String
errMsg) (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
M.lookup (Text -> Key
M.fromText Text
key) Object
obj
  where
    errMsg :: String
errMsg = String
"No such key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" In: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Object -> String
forall a. Show a => a -> String
show Object
obj
(|@) Value
_ Text
_ = String -> Value
forall a. HasCallStack => String -> a
error String
"not an object"
{-# INLINE (|@) #-}

(|!) :: Value -> Int -> Value
|! :: Value -> Int -> Value
(|!) (Array Array
ar) Int
i = Array
ar Array -> Int -> Value
forall a. Vector a -> Int -> a
V.! Int
i
(|!) Value
_ Int
_ = String -> Value
forall a. HasCallStack => String -> a
error String
"not an array"
{-# INLINE (|!) #-}

(&) :: a -> (a -> b) -> b
& :: a -> (a -> b) -> b
(&) = ((a -> b) -> a -> b) -> a -> (a -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)
{-# INLINE (&) #-}

as :: FromJSON a => Value -> a
as :: Value -> a
as = Result a -> a
forall p. Result p -> p
getResult (Result a -> a) -> (Value -> Result a) -> Value -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON
  where
    getResult :: Result p -> p
getResult (Error String
e) = String -> p
forall a. HasCallStack => String -> a
error String
e
    getResult (Success p
x) = p
x
{-# INLINE as #-}