{-# LANGUAGE CPP #-}

{-|
A small library for querying a Web API.

@
{-# LANGUAGE OverloadedStrings #-}

import Data.Text.IO as T
import Network.HTTP.Query

main = do
  let api = "http://www.example.com/api/1"
      endpoint = api +/+ "search"
  res <- webAPIQuery endpoint $ makeKey "q" "needle"
  T.putStrLn $
    case lookupKey "results" res of
      Nothing ->
        fromMaybe "search failed" $ lookupKey "error" res
      Just results ->
        lookupKey' "location" results
@
-}

module Network.HTTP.Query (
  withURLQuery,
  webAPIQuery,
  apiQueryURI,
  Query,
  QueryItem,
  maybeKey,
  makeKey,
  makeItem,
  (+/+),
  lookupKey,
  lookupKeyEither,
  lookupKey'
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad.IO.Class (MonadIO)
#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (fromText)
#endif
import Data.Aeson.Types
#if !MIN_VERSION_http_conduit(2,3,3)
import Data.ByteString (ByteString)
#endif
import qualified Data.ByteString.Char8 as B
import Data.Text (Text)
import Network.HTTP.Client.Conduit
import Network.HTTP.Simple
import Network.URI

#if !MIN_VERSION_http_conduit(2,3,1)
type Query = [(ByteString, Maybe ByteString)]
#endif
#if !MIN_VERSION_http_conduit(2,3,3)
type QueryItem = (ByteString, Maybe ByteString)
#endif

-- | Maybe create a query key
maybeKey :: String -> Maybe String -> Query
maybeKey :: String -> Maybe String -> Query
maybeKey String
_ Maybe String
Nothing = []
maybeKey String
k Maybe String
mval = [(String -> ByteString
B.pack String
k, (String -> ByteString) -> Maybe String -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ByteString
B.pack Maybe String
mval)]

-- | Make a singleton key-value Query
makeKey :: String -> String -> Query
makeKey :: String -> String -> Query
makeKey String
k String
val = [(String -> ByteString
B.pack String
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
B.pack String
val))]

-- | Make a key-value QueryItem
makeItem :: String -> String -> QueryItem
makeItem :: String -> String -> QueryItem
makeItem String
k String
val = (String -> ByteString
B.pack String
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (String -> ByteString
B.pack String
val))

-- | Combine two path segments with a slash
--
-- > "abc" +/+ "def" == "abc/def"
-- > "abc/" +/+ "def" == "abc/def"
-- > "abc" +/+ "/def" == "abc/def"
infixr 5 +/+
(+/+) :: String -> String -> String
String
"" +/+ :: String -> String -> String
+/+ String
s = String
s
String
s +/+ String
"" = String
s
String
s +/+ String
t | String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
        | String -> Char
forall a. [a] -> a
head String
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
String
s +/+ String
t = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
t

-- | Sets up an API request for some action
withURLQuery :: String -> Query -> (Request -> a) -> a
withURLQuery :: String -> Query -> (Request -> a) -> a
withURLQuery String
url Query
params Request -> a
act =
  case String -> Maybe URI
parseURI String
url of
    Maybe URI
Nothing -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse uri: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
url
    Just URI
uri ->
      let req :: Request
req = Query -> Request -> Request
setRequestQueryString Query
params (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
                URI -> Request
requestFromURI_ URI
uri
      in Request -> a
act Request
req

-- | Low-level web api query
webAPIQuery :: (MonadIO m, FromJSON a)
            => String -- ^ URL of endpoint
            -> Query -- ^ query options
            -> m a -- ^ returned JSON
webAPIQuery :: String -> Query -> m a
webAPIQuery String
url Query
params =
  String -> Query -> (Request -> m a) -> m a
forall a. String -> Query -> (Request -> a) -> a
withURLQuery String
url Query
params ((Request -> m a) -> m a) -> (Request -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ (Response a -> a) -> m (Response a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response a -> a
forall a. Response a -> a
getResponseBody (m (Response a) -> m a)
-> (Request -> m (Response a)) -> Request -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response a)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON

-- | Get the URI for a web query
apiQueryURI :: String -- ^ url of endpoint
            -> Query -- ^ query options
            -> URI
apiQueryURI :: String -> Query -> URI
apiQueryURI String
url Query
params =
  String -> Query -> (Request -> URI) -> URI
forall a. String -> Query -> (Request -> a) -> a
withURLQuery String
url Query
params Request -> URI
getUri

-- FIXME support "key1.key2" etc
-- | Look up key in object
lookupKey :: FromJSON a => Text -> Object -> Maybe a
lookupKey :: Text -> Object -> Maybe a
lookupKey Text
k =
  (Object -> Parser a) -> Object -> Maybe a
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe (Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text -> Text
fromText Text
k)

-- | Like lookupKey but returns error message if not found
lookupKeyEither :: FromJSON a => Text -> Object -> Either String a
lookupKeyEither :: Text -> Object -> Either String a
lookupKeyEither Text
k = (Object -> Parser a) -> Object -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text -> Text
fromText Text
k)

-- | Like lookupKey but raises an error if no key found
lookupKey' :: FromJSON a => Text -> Object -> a
lookupKey' :: Text -> Object -> a
lookupKey' Text
k =
  (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall a. HasCallStack => String -> a
error a -> a
forall a. a -> a
id (Either String a -> a)
-> (Object -> Either String a) -> Object -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Parser a) -> Object -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
parseEither (Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text -> Text
fromText Text
k)

#if !MIN_VERSION_aeson(2,0,0)
fromText :: Text -> Text
fromText :: Text -> Text
fromText = Text -> Text
forall a. a -> a
id
#endif