{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
-- | Jenkins REST API methods
module Jenkins.Rest.Method
  ( -- * Construct URLs
    -- ** Path
    text
  , int
  , (-/-)
    -- ** Query
  , (-=-)
  , (-&-)
  , query
    -- ** Put together the segments and the query
  , (-?-)
    -- ** Format
  , Formatter
  , json
  , xml
  , python
  , plain
  , -- * Shortcuts
    job
  , build
  , view
  , queue
  , overallLoad
  , computer
    -- * Types
  , Method
  , Type(..)
  , Format(..)
  ) where

import Data.Text (Text)

import Jenkins.Rest.Method.Internal


-- $setup
-- >>> :set -XDataKinds
-- >>> :set -XOverloadedStrings
-- >>> class P t where pp :: Method t f -> Data.ByteString.ByteString
-- >>> instance P Complete where pp = render
-- >>> instance P Query    where pp = renderQ'
-- >>> let pp' = render


infix  1 -?-
infix  7 -=-
infixr 5 -/-, -&-


-- | Use a string as an URI segment
--
-- >>> pp (text "foo")
-- "foo"
--
-- /Note:/ with @-XOverloadedStrings@ extension enabled it's possible to use string
-- literals as segments of the Jenkins API method URL
--
-- >>> pp' "foo"
-- "foo"
--
-- /Note:/ don't put @/@ in the string literal unless you want it URL-encoded,
-- use @(-/-)@ instead
--
-- >>> pp' "foo/bar"
-- "foo%2Fbar"
text :: Text -> Method 'Complete f
text :: forall (f :: Format). Text -> Method 'Complete f
text = forall (f :: Format). Text -> Method 'Complete f
Text

-- | Use an integer as an URI segment
--
-- >>> pp (int 4)
-- "4"
int :: Int -> Method 'Complete f
int :: forall (f :: Format). Int -> Method 'Complete f
int = forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Combine two paths
--
-- >>> pp ("foo" -/- "bar" -/- "baz")
-- "foo/bar/baz"
(-/-) :: Method 'Complete f -> Method 'Complete f -> Method 'Complete f
-/- :: forall (f :: Format).
Method 'Complete f -> Method 'Complete f -> Method 'Complete f
(-/-) = forall (f :: Format).
Method 'Complete f -> Method 'Complete f -> Method 'Complete f
(:/)

-- | Make a key-value pair
--
-- >>> pp ("foo" -=- "bar")
-- "foo=bar"
(-=-) :: Text -> Text -> Method 'Query f
Text
x -=- :: forall (f :: Format). Text -> Text -> Method 'Query f
-=- Text
y = Text
x forall (f :: Format). Text -> Maybe Text -> Method 'Query f
:= forall a. a -> Maybe a
Just Text
y

-- | Create the union of two queries
--
-- >>> pp ("foo" -=- "bar" -&- "baz")
-- "foo=bar&baz"
(-&-) :: Method 'Query f -> Method 'Query f -> Method 'Query f
-&- :: forall (f :: Format).
Method 'Query f -> Method 'Query f -> Method 'Query f
(-&-) = forall (f :: Format).
Method 'Query f -> Method 'Query f -> Method 'Query f
(:&)

-- | Take a list of key-value pairs and render them as a query
--
-- >>> pp (query [("foo", Nothing), ("bar", Just "baz"), ("quux", Nothing)])
-- "foo&bar=baz&quux"
--
-- >>> pp (query [])
-- ""
query :: [(Text, Maybe Text)] -> Method 'Query f
query :: forall (f :: Format). [(Text, Maybe Text)] -> Method 'Query f
query = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: Format).
Method 'Query f -> Method 'Query f -> Method 'Query f
(:&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: Format). Text -> Maybe Text -> Method 'Query f
(:=)) forall (f :: Format). Method 'Query f
Empty

-- | Put path and query together
--
-- >>> pp ("qux" -/- "quux" -?- "foo" -=- "bar" -&- "baz")
-- "qux/quux?foo=bar&baz"
--
-- >>> pp ("" -?- "foo" -=- "bar")
-- "foo=bar"
--
-- >>> pp ("/" -?- "foo" -=- "bar")
-- "%2F?foo=bar"
(-?-) :: Method 'Complete f -> Method 'Query f -> Method 'Complete f
-?- :: forall (f :: Format).
Method 'Complete f -> Method 'Query f -> Method 'Complete f
(-?-) = forall (f :: Format).
Method 'Complete f -> Method 'Query f -> Method 'Complete f
(:?)

-- | Append the JSON formatting request to the method URL
--
-- >>> format json "foo"
-- "foo/api/json"
json :: Formatter 'Json
json :: Formatter 'Json
json = forall (g :: Format).
((forall (f :: Format). Method 'Complete f) -> Method 'Complete g)
-> Formatter g
Formatter (\forall (f :: Format). Method 'Complete f
m -> forall (f :: Format). Method 'Complete f
m forall (f :: Format).
Method 'Complete f -> SFormat f -> Method 'Complete f
:@ SFormat 'Json
SJson)
{-# ANN json ("HLint: ignore Avoid lambda" :: String) #-}

-- | Append the XML formatting request to the method URL
--
-- >>> format xml "foo"
-- "foo/api/xml"
xml :: Formatter 'Xml
xml :: Formatter 'Xml
xml = forall (g :: Format).
((forall (f :: Format). Method 'Complete f) -> Method 'Complete g)
-> Formatter g
Formatter (\forall (f :: Format). Method 'Complete f
m -> forall (f :: Format). Method 'Complete f
m forall (f :: Format).
Method 'Complete f -> SFormat f -> Method 'Complete f
:@ SFormat 'Xml
SXml)
{-# ANN xml ("HLint: ignore Avoid lambda" :: String) #-}

-- | Append the Python formatting request to the method URL
--
-- >>> format python "foo"
-- "foo/api/python"
python :: Formatter 'Python
python :: Formatter 'Python
python = forall (g :: Format).
((forall (f :: Format). Method 'Complete f) -> Method 'Complete g)
-> Formatter g
Formatter (\forall (f :: Format). Method 'Complete f
m -> forall (f :: Format). Method 'Complete f
m forall (f :: Format).
Method 'Complete f -> SFormat f -> Method 'Complete f
:@ SFormat 'Python
SPython)
{-# ANN python ("HLint: ignore Avoid lambda" :: String) #-}

-- | The formatter that does exactly nothing
--
-- >>> format plain "foo"
-- "foo"
plain :: Formatter f
plain :: forall (f :: Format). Formatter f
plain = forall (g :: Format).
((forall (f :: Format). Method 'Complete f) -> Method 'Complete g)
-> Formatter g
Formatter (\forall (f :: Format). Method 'Complete f
m -> forall (f :: Format). Method 'Complete f
m)
{-# ANN plain ("HLint: ignore Use id" :: String) #-}


-- | Job data
--
-- >>> format json (job "name")
-- "job/name/api/json"
--
-- >>> pp (job "name" -/- "config.xml")
-- "job/name/config.xml"
job :: Text -> Method 'Complete f
job :: forall (f :: Format). Text -> Method 'Complete f
job Text
name = Method 'Complete f
"job" forall (f :: Format).
Method 'Complete f -> Method 'Complete f -> Method 'Complete f
-/- forall (f :: Format). Text -> Method 'Complete f
text Text
name

-- | Job build data
--
-- >>> format json (build "name" 4)
-- "job/name/4/api/json"
build :: Text -> Int -> Method 'Complete f
build :: forall (f :: Format). Text -> Int -> Method 'Complete f
build Text
name Int
num = Method 'Complete f
"job" forall (f :: Format).
Method 'Complete f -> Method 'Complete f -> Method 'Complete f
-/- forall (f :: Format). Text -> Method 'Complete f
text Text
name forall (f :: Format).
Method 'Complete f -> Method 'Complete f -> Method 'Complete f
-/- forall (f :: Format). Int -> Method 'Complete f
int Int
num

-- | View data
--
-- >>> format xml (view "name")
-- "view/name/api/xml"
view :: Text -> Method 'Complete f
view :: forall (f :: Format). Text -> Method 'Complete f
view Text
name = Method 'Complete f
"view" forall (f :: Format).
Method 'Complete f -> Method 'Complete f -> Method 'Complete f
-/- forall (f :: Format). Text -> Method 'Complete f
text Text
name

-- | Build queue data
--
-- >>> format python queue
-- "queue/api/python"
queue :: Method 'Complete f
queue :: forall (f :: Format). Method 'Complete f
queue = Method 'Complete f
"queue"

-- | Server statistics
--
-- >>> format xml overallLoad
-- "overallLoad/api/xml"
overallLoad :: Method 'Complete f
overallLoad :: forall (f :: Format). Method 'Complete f
overallLoad = Method 'Complete f
"overallLoad"

-- | Nodes data
--
-- >>> format python computer
-- "computer/api/python"
computer :: Method 'Complete f
computer :: forall (f :: Format). Method 'Complete f
computer = Method 'Complete f
"computer"