-- | Hreq is a high-level easy to use type-driven HTTP client library inspired by Servant-Client.
-- Hreq provides an alternative approach to type-safe construction and interpretation of API
-- endpoints for Http client requests.
-- Hreq is greatly inspired by Servant Client.
--
-- == Examples
--
-- Assume we are making requests against an HTTP service providing a JSON user management API.
--
-- > {-# LANGUAGE DataKinds         #-}
-- > {-# LANGUAGE DeriveAnyClass    #-}
-- > {-# LANGUAGE DeriveGeneric     #-}
-- > {-# LANGUAGE OverloadedStrings #-}
-- > {-# LANGUAGE TypeApplications  #-}
-- > {-# LANGUAGE TypeOperators     #-}
-- >
-- > import Control.Monad.IO.Class (liftIO)
-- > import Data.Aeson (FromJSON, ToJSON)
-- > import Data.Text (Text)
-- > import GHC.Generics (Generic)
-- > import Hreq.Client
-- >
-- > data User = User
-- >  { name :: Text
-- >  , age  :: Int
-- >  } deriving (Show, Generic, FromJSON, ToJSON)
--
-- @User@ service API URL
--
-- > baseUrl :: BaseUrl
-- > baseUrl = HttpUrl "example.com" "user"
--
-- ===Simple Get request
--
-- Make a Get request obtaining a @User@ by a specified @user-name@ at <http://example.com/user/:userName>
--
-- > getUserByName :: RunClient m => Text -> m User
-- > getUserByName userName = hreq @(Capture Text :> GetJson User) (userName :. Empty)
--
-- The @Capture Text :> GetJson User@ type with in @getUserByName@ is an API endpoint type definition.
--
-- The API type definition in this instance demands that a heterogeneous list containing a 'Text' value is supplied to the 'hreq' function.
--
-- @userName ':.' 'Empty'@ forms the required heterogeneous list value for the 'hreq' function.
-- Finally, the API type states that we will obtain a 'JSON' @User@ response output.
--
-- ===Simple Post request
--
-- Make a Post request with Json User data for a request body returning a Json User response at <http://example.com/user>
--
-- > createUser :: RunClient m => User -> m ()
-- > createUser user = hreq @(JsonBody User :> EmptyResponse POST) (user :. Empty)
--
-- ===Get Request with QueryFlag
--
-- Make a Get requesting obtaining all users at API endpoint <http://example.com/user/all?old>
--
-- > getAllUsers :: RunClient m => m [User]
-- > getAllUsers = hreq @("all" :> QueryFlag "old" :> GetJson [User]) Empty
--
-- ===Running api endpoint functions
--
-- With in the main function; the API endpoint functions run within the 'Hreq' monad.
-- The Hreq monad has an instance of the 'RunClient' class and 'MonadIO' class.
--
-- > main :: IO ()
-- > main = runHreq baseUrl $ do
-- >  reqUser     <- getUserByName "allan"
-- >  createdUser <- createUser newUser
-- >  allUsers    <- getAllUsers
-- > --Delete users with age equal to 20
-- >  hreq @(Capture Int :> EmptyResponse DELETE) (20 :. Empty)
-- >  -- do something with API data
-- >  liftIO $ print (reqUser, createdUser, allUsers)
-- >  where
-- >    newUser :: User
-- >    newUser = User "allan" 12
--
-- ==More examples
--
-- ====Appending a path to the request path
--
-- >>> type PathsQuery = "user" :> "allan" :> GetJson User
--
-- > pathsExample :: RunClient m => m User
--
-- >>> pathsExample = hreq @PathsQuery Empty
--
-- ====Adding query params to a request
--
-- Any type with a 'ToHttpApiData' class instance can be used as a Param value type.
--
-- >>> type SingleParam = Param "name" String :> GetJson User
--
-- > singleParamExample :: RunClient m => m Response
--
-- >>> singleParamsExample =  hreq @SingleParam ("allan" :. Empty)
--
-- >>> type MultiParams = Param "name" String :> Param "age" Int :> GetJson User
--
-- >>> type MultiParamsList = Params '["name" := String, "age" := Int] :> GetJson User
--
-- > -- Note MultiParams and MultiParamsList are the same.
-- > -- Resulting URL is of the form http://example.com/api?name="allan"&age=20
--
-- > multiParamsExample :: RunClient m => m User
--
-- >>> multiParamsExample = hreq @MultiParams ("allan" :. 20 :. Empty)
--
-- ====Adding QueryFlags to a request
--
-- >>> type SingleQueryFlag = "user" :> QueryFlag "male" :> GetJson User
--
-- > singleQueryFlag :: RunClient m => m User
--
-- >>> singleQueryFlag = hreq @SingleQueryFlag Empty
--
-- >>> type MultiQueryFlags = "user" :> QueryFlag "male" :> QueryFlag "old" :> GetJson User
--
-- >>> type MultiQueryFlagList = "user" :> QueryFlags '["male", "old"] :> GetJson User
--
-- > -- Note MultiQueryFlags and MultiQueryFlagsList are the same
-- > -- The query flag values are inferred from provided type level strings (symbols)
-- > -- Resulting URL is of the form http://example.com/api?male&old
--
-- > multiFlagsExample :: RunClient m => m User
--
-- >>> multiFlagsExample = hreq @MultiQueryFlagList Empty
--
-- ====Adding Captures
--
-- Any type with a 'ToHttpApiData' class instance can be used as a 'Capture' value type.
--
-- >>> type SingleCapture = Capture UserName :> GetJson User
--
-- >>> type MultiCapturesList = "users" :> Captures '[UserName, UserAge] :> GetJson User
-- >>> type MultiCaptures = "users" :> Capture UserName :> Capture UserAge :> GetJson User
--
-- > -- Resulting URL is of the form http://example.com/users/allan/12
-- > -- Note that MultiCapturesList is equal to MultiCaptures.
--
-- > captureExample :: RunClient m => m User
--
-- >>> captureExample =  hreq @MultiCaptures $ UserName "allan" :. UserAge 12 :. Empty
--
-- =====CaptureAll
--
-- 'CaptureAll' is useful for a specifying a request composed of multiple URL parameter fragments of the
-- same type in a concise manner.
--
-- >>> type CaptureAllExample = "users" :> CaptureAll String :> GetJson User
--
-- > captureAllExample :: RunClient m => m User
--
-- >>> captureAllExample = hreq @CaptureAllExample $ ["allan",  "alex", "brian"] :. Empty
--
-- ====Adding a Request body
--
-- Request bodies are created by the 'ReqBody' type. A request body type is encoded to
-- into a byteString basing on the provided media/mime type.
--
-- The library nativelysupports some media types such as 'JSON' and 'PlainText' among others.
--
-- Example type using JSON as media type, the provided body type should have an Aeson @ToJSON@ instance
--
-- >>> type ReqBodyQuery = "users" :> ReqBody User JSON :> GetJson User
--
-- The above query can be written as below:
--
-- >>> type JsonBodyQuery = "users" :> JsonBody User :> GetJson User
--
-- ==== Response type Examples
--
-- Response are represented by the @'Verb' (method :: k1) (contents:: [k2])@ type.
--
-- @method@ : is a Standard HTTP verb type such as 'GET' or 'POST'
-- @contents@ : is a type level list containing expected response from making an http call.
--
-- The library provides convenience type synonyms out of the Verb type such as @GetJson@, @PostJson@ etc.
--
-- >>> type GetPlainText a = Get '[ResBody PlainText a]
--
-- > plainTextResponse :: RunClient m => m String
--
-- >>> plainTextResponse = hreq @("user" :> GetPlainText String) Empty
--
-- =====Returning multiple values Example
--
-- >>> type MultiResultsQuery = Get '[ ResBody JSON User, ResHeaders '[ "key-header" := String ] ]
--
-- > multiResults :: RunClient m => m (Hlist '[ User, [Header] ])
--
-- >>> multiResults = hreq @MultiResultsQuery Empty
--
module Hreq.Client
  ( module Hreq.Core.API
  , module Hreq.Core.Client
  , module Hreq.Client.Internal.HTTP
  , module Hreq.Client.Internal.Config
  ) where

import Hreq.Client.Internal.Config (HttpConfig (..), StatusRange (..), createDefConfig)
import Hreq.Client.Internal.HTTP (Hreq (..), RunClient (..), runHreq, runHreqWithConfig)

import Hreq.Core.API
import Hreq.Core.Client

-- $setup
-- >>> import Hreq.Core.API
-- >>> import GHC.Generics
-- >>> import Data.Aeson
-- >>> import Data.Hlist
-- >>> data User = User deriving (Show)
-- >>> instance ToJSON User where toJSON = undefined
-- >>> instance FromJSON User where parseJSON = undefined
-- >>> newtype UserName = UserName { unUserName :: String } deriving (Show, ToHttpApiData)
-- >>> newtype UserAge = UserAge { unUserAge :: Int } deriving (Show, ToHttpApiData)