{-# 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 (
  Query,
  QueryItem,
  maybeKey,
  makeKey,
  makeItem,
  (+/+),
  webAPIQuery,
  lookupKey,
  lookupKeyEither,
  lookupKey'
  ) where

import Control.Monad.IO.Class (MonadIO)
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 _ Nothing = []
maybeKey k :: String
k mval :: 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 k :: String
k val :: 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 k :: String
k val :: 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
+/+ s :: String
s = String
s
s :: String
s +/+ "" = String
s
s :: String
s +/+ t :: String
t | String -> Char
forall a. [a] -> a
last String
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/' = 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
== '/' = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
s :: String
s +/+ t :: String
t = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ '/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
t

-- | 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 url :: String
url params :: Query
params =
  case String -> Maybe URI
parseURI String
url of
    Nothing -> String -> m a
forall a. HasCallStack => String -> a
error (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ "Cannot parse uri: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
url
    Just uri :: URI
uri ->
      let req :: Request
req = Request -> Request
setRequestCheckStatus (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
                Query -> Request -> Request
setRequestQueryString Query
params (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
                URI -> Request
requestFromURI_ URI
uri
      in Response a -> a
forall a. Response a -> a
getResponseBody (Response a -> a) -> m (Response a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> m (Response a)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Request -> m (Response a)
httpJSON Request
req

-- FIXME support "key1.key2" etc
-- | Look up key in object
lookupKey :: FromJSON a => Text -> Object -> Maybe a
lookupKey :: Text -> Object -> Maybe a
lookupKey k :: 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
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 k :: 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
k)

-- | Like lookupKey but raises an error if no key found
lookupKey' :: FromJSON a => Text -> Object -> a
lookupKey' :: Text -> Object -> a
lookupKey' k :: 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
k)