{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

{- |
Module      :  GitHub.REST.Endpoint
Maintainer  :  Brandon Chinn <brandon@leapyear.io>
Stability   :  experimental
Portability :  portable

Define the 'GHEndpoint' helper type for defining a call to a GitHub API endpoint.
-}
module GitHub.REST.Endpoint (
  GHEndpoint (..),
  EndpointVals,
  GitHubData,
  endpointPath,
  renderMethod,
) where

import Data.Maybe (fromMaybe)

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Data.Text (Text)
import qualified Data.Text as Text
import Network.HTTP.Types (Method, StdMethod, renderStdMethod)

import GitHub.REST.KeyValue (KeyValue, kvToText)

type EndpointVals = [KeyValue]
type GitHubData = [KeyValue]

-- | A call to a GitHub API endpoint.
data GHEndpoint = GHEndpoint
  { GHEndpoint -> StdMethod
method :: StdMethod
  , -- | The GitHub API endpoint, with colon-prefixed components that will be replaced; e.g.
    -- @"\/users\/:username\/repos"@
    GHEndpoint -> Text
endpoint :: Text
  , -- | Key-value pairs to replace colon-prefixed components in 'endpoint'; e.g.
    -- @[ "username" := ("alice" :: Text) ]@
    GHEndpoint -> EndpointVals
endpointVals :: EndpointVals
  , -- | Key-value pairs to send in the request body; e.g.
    -- @[ "sort" := ("created" :: Text), "direction" := ("asc" :: Text) ]@
    GHEndpoint -> EndpointVals
ghData :: GitHubData
  }

-- | Return the endpoint path, populated by the values in 'endpointVals'.
endpointPath :: GHEndpoint -> Text
endpointPath :: GHEndpoint -> Text
endpointPath GHEndpoint{EndpointVals
Text
StdMethod
ghData :: EndpointVals
endpointVals :: EndpointVals
endpoint :: Text
method :: StdMethod
ghData :: GHEndpoint -> EndpointVals
endpointVals :: GHEndpoint -> EndpointVals
endpoint :: GHEndpoint -> Text
method :: GHEndpoint -> StdMethod
..} = Text -> [Text] -> Text
Text.intercalate Text
"/" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
populate ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"/" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
endpoint
  where
    values :: [(Text, Text)]
values = (KeyValue -> (Text, Text)) -> EndpointVals -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map KeyValue -> (Text, Text)
kvToText EndpointVals
endpointVals
    populate :: Text -> Text
populate Text
t = case Text -> Maybe (Char, Text)
Text.uncons Text
t of
      Just (Char
':', Text
key) ->
        Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe
          (Text -> Text
forall c. Text -> c
fail' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
"Could not find value for key '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
          (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
key [(Text, Text)]
values
      Maybe (Char, Text)
_ -> Text
t
    fail' :: Text -> c
fail' Text
msg = [Char] -> c
forall a. HasCallStack => [Char] -> a
error ([Char] -> c) -> (Text -> [Char]) -> Text -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> c) -> Text -> c
forall a b. (a -> b) -> a -> b
$ Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endpoint

-- | Render the method of the endpoint.
renderMethod :: GHEndpoint -> Method
renderMethod :: GHEndpoint -> Method
renderMethod = StdMethod -> Method
renderStdMethod (StdMethod -> Method)
-> (GHEndpoint -> StdMethod) -> GHEndpoint -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHEndpoint -> StdMethod
method