{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_HADDOCK hide #-}
-- | Jenkins REST API method construction
module Jenkins.Rest.Method.Internal where

import           Control.Applicative
import           Data.ByteString (ByteString)
import           Data.Data (Data, Typeable)
#if __GLASGOW_HASKELL__ < 710
import           Data.Monoid (Monoid(..))
#endif
import           Data.String (IsString(..))
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Text (Text)
import           Network.URI (escapeURIChar, isUnreserved)

-- $setup
-- >>> :set -XOverloadedStrings


infix  1 :?
infix  3 :@
infix  7 :=
infixr 5 :/, :&

-- | Jenkins RESTFul API method encoding
data Method :: Type -> Format -> * where
  Empty :: Method 'Query f
  Text  :: Text -> Method 'Complete f
  (:/)  :: Method 'Complete f -> Method 'Complete f -> Method 'Complete f
  (:=)  :: Text -> Maybe Text -> Method 'Query f
  (:&)  :: Method 'Query f -> Method 'Query f -> Method 'Query f
  (:?)  :: Method 'Complete f -> Method 'Query f -> Method 'Complete f
  (:@)  :: Method 'Complete f -> SFormat f -> Method 'Complete f

deriving instance Show (SFormat f) => Show (Method t f)

-- | Only to support numeric literals
instance t ~ 'Complete => Num (Method t f) where
  + :: Method t f -> Method t f -> Method t f
(+)         = forall a. HasCallStack => String -> a
error String
"Method.(+): not supposed to be used"
  (-)         = forall a. HasCallStack => String -> a
error String
"Method.(-): not supposed to be used"
  * :: Method t f -> Method t f -> Method t f
(*)         = forall a. HasCallStack => String -> a
error String
"Method.(*): not supposed to be used"
  abs :: Method t f -> Method t f
abs         = forall a. HasCallStack => String -> a
error String
"Method.abs: not supposed to be used"
  signum :: Method t f -> Method t f
signum      = forall a. HasCallStack => String -> a
error String
"Method.signum: not supposed to be used"
  fromInteger :: Integer -> Method t f
fromInteger = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance IsString (Method 'Complete f) where
  fromString :: String -> Method 'Complete f
fromString = forall (f :: Format). Text -> Method 'Complete f
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

instance IsString (Method 'Query f) where
  fromString :: String -> Method 'Query f
fromString String
str = forall a. IsString a => String -> a
fromString String
str forall (f :: Format). Text -> Maybe Text -> Method 'Query f
:= forall a. Maybe a
Nothing

-- | Method types
data Type = Query | Complete
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Typeable, Typeable Type
Type -> DataType
Type -> Constr
(forall b. Data b => b -> b) -> Type -> Type
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Type -> u
forall u. (forall d. Data d => d -> u) -> Type -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Type -> m Type
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Type)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Type -> m Type
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Type -> m Type
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Type -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Type -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Type -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Type -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Type -> r
gmapT :: (forall b. Data b => b -> b) -> Type -> Type
$cgmapT :: (forall b. Data b => b -> b) -> Type -> Type
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Type)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Type)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Type)
dataTypeOf :: Type -> DataType
$cdataTypeOf :: Type -> DataType
toConstr :: Type -> Constr
$ctoConstr :: Type -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Type
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Type -> c Type
Data)

-- | Response formats
data Format = Json | Xml | Python
  deriving (Int -> Format -> ShowS
[Format] -> ShowS
Format -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> String
$cshow :: Format -> String
showsPrec :: Int -> Format -> ShowS
$cshowsPrec :: Int -> Format -> ShowS
Show, Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Typeable, Typeable Format
Format -> DataType
Format -> Constr
(forall b. Data b => b -> b) -> Format -> Format
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Format -> u
forall u. (forall d. Data d => d -> u) -> Format -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Format -> m Format
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Format -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Format -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Format -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Format -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Format -> r
gmapT :: (forall b. Data b => b -> b) -> Format -> Format
$cgmapT :: (forall b. Data b => b -> b) -> Format -> Format
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Format)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Format)
dataTypeOf :: Format -> DataType
$cdataTypeOf :: Format -> DataType
toConstr :: Format -> Constr
$ctoConstr :: Format -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Format
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Format -> c Format
Data)

data SFormat :: Format -> * where
  SJson   :: SFormat 'Json
  SXml    :: SFormat 'Xml
  SPython :: SFormat 'Python


-- | 'Formatter's know how to append the \"api/$format\" string to the method URL
newtype Formatter g = Formatter
  { forall (g :: Format).
Formatter g
-> (forall (f :: Format). Method 'Complete f) -> Method 'Complete g
unFormatter :: (forall f. Method 'Complete f) -> Method 'Complete g
  }

format :: Formatter f -> (forall g. Method 'Complete g) -> ByteString
format :: forall (f :: Format).
Formatter f
-> (forall (f :: Format). Method 'Complete f) -> ByteString
format Formatter f
f forall (f :: Format). Method 'Complete f
m = forall (f :: Format). Method 'Complete f -> ByteString
render (forall (g :: Format).
Formatter g
-> (forall (f :: Format). Method 'Complete f) -> Method 'Complete g
unFormatter Formatter f
f forall (f :: Format). Method 'Complete f
m)

-- | Render 'Method' to something that can be sent over the wire
render :: Method 'Complete f -> ByteString
render :: forall (f :: Format). Method 'Complete f -> ByteString
render Method 'Complete f
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall m. (Monoid m, Eq m) => m -> m -> m -> m
insert ByteString
"?")) (forall (f :: Format). Method 'Complete f -> Maybe ByteString
renderQ Method 'Complete f
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall m. (Monoid m, Eq m) => m -> m -> m -> m
insert ByteString
"/")) (forall (f :: Format). Method 'Complete f -> Maybe ByteString
renderF Method 'Complete f
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: Format). Method 'Complete f -> ByteString
renderP forall a b. (a -> b) -> a -> b
$ Method 'Complete f
m

-- | Render the method path
renderP :: Method 'Complete f -> ByteString
renderP :: forall (f :: Format). Method 'Complete f -> ByteString
renderP (Text Text
s) = Text -> ByteString
renderT Text
s
renderP (Method 'Complete f
x :/ Method 'Complete f
y) = forall (f :: Format). Method 'Complete f -> ByteString
renderP Method 'Complete f
x forall m. (IsString m, Monoid m, Eq m) => m -> m -> m
`slash` forall (f :: Format). Method 'Complete f -> ByteString
renderP Method 'Complete f
y
renderP (Method 'Complete f
x :? Method 'Query f
_) = forall (f :: Format). Method 'Complete f -> ByteString
renderP Method 'Complete f
x
renderP (Method 'Complete f
x :@ SFormat f
_) = forall (f :: Format). Method 'Complete f -> ByteString
renderP Method 'Complete f
x

-- | Render the query string
renderQ :: Method 'Complete f -> Maybe ByteString
renderQ :: forall (f :: Format). Method 'Complete f -> Maybe ByteString
renderQ (Text Text
_)  = forall a. Maybe a
Nothing
renderQ (Method 'Complete f
q :/ Method 'Complete f
q') = forall (f :: Format). Method 'Complete f -> Maybe ByteString
renderQ Method 'Complete f
q forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: Format). Method 'Complete f -> Maybe ByteString
renderQ Method 'Complete f
q'
renderQ (Method 'Complete f
q :@ SFormat f
_)  = forall (f :: Format). Method 'Complete f -> Maybe ByteString
renderQ Method 'Complete f
q
renderQ (Method 'Complete f
_ :? Method 'Query f
q)  = forall a. a -> Maybe a
Just (forall (f :: Format). Method 'Query f -> ByteString
renderQ' Method 'Query f
q)

renderQ' :: Method 'Query f -> ByteString
renderQ' :: forall (f :: Format). Method 'Query f -> ByteString
renderQ' (Method 'Query f
x :& Method 'Query f
y)       = forall m. (Monoid m, Eq m) => m -> m -> m -> m
insert ByteString
"&" (forall (f :: Format). Method 'Query f -> ByteString
renderQ' Method 'Query f
x) (forall (f :: Format). Method 'Query f -> ByteString
renderQ' Method 'Query f
y)
renderQ' (Text
x := Just Text
y)  = forall m. (Monoid m, Eq m) => m -> m -> m -> m
insert ByteString
"=" (Text -> ByteString
renderT Text
x)  (Text -> ByteString
renderT Text
y)
renderQ' (Text
x := Maybe Text
Nothing) = Text -> ByteString
renderT Text
x
renderQ' Method 'Query f
Empty          = Text -> ByteString
renderT Text
""

-- | Render the response format string
renderF :: Method 'Complete f -> Maybe ByteString
renderF :: forall (f :: Format). Method 'Complete f -> Maybe ByteString
renderF (Method 'Complete f
_ :@ SFormat f
SJson)   = forall a. a -> Maybe a
Just ByteString
"api/json"
renderF (Method 'Complete f
_ :@ SFormat f
SXml)    = forall a. a -> Maybe a
Just ByteString
"api/xml"
renderF (Method 'Complete f
_ :@ SFormat f
SPython) = forall a. a -> Maybe a
Just ByteString
"api/python"
renderF Method 'Complete f
_              = forall a. Maybe a
Nothing

-- | Render unicode text as a query string
--
-- >>> renderT "foo-bar-baz"
-- "foo-bar-baz"
--
-- >>> renderT "foo bar baz"
-- "foo%20bar%20baz"
--
-- >>> renderT "ДМИТРИЙ МАЛИКОВ"
-- "%D0%94%D0%9C%D0%98%D0%A2%D0%A0%D0%98%D0%99%20%D0%9C%D0%90%D0%9B%D0%98%D0%9A%D0%9E%D0%92"
renderT :: Text -> ByteString
renderT :: Text -> ByteString
renderT = Text -> ByteString
Text.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Text) -> Text -> Text
Text.concatMap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Char -> String
escapeURIChar Char -> Bool
isUnreserved)

-- | Insert \"\/\" between two 'String'-like things and concatenate everything.
slash :: (IsString m, Monoid m, Eq m) => m -> m -> m
slash :: forall m. (IsString m, Monoid m, Eq m) => m -> m -> m
slash = forall m. (Monoid m, Eq m) => m -> m -> m -> m
insert m
"/"

-- | Insert 'String'-like thing between two 'String'-like things and concatenate everything.
--
-- >>> "foo" `slash` "bar"
-- "foo/bar"
--
-- >>> "foo" `slash` ""
-- "foo"
insert :: (Monoid m, Eq m) => m -> m -> m -> m
insert :: forall m. (Monoid m, Eq m) => m -> m -> m -> m
insert m
t m
x m
y
  | m
x forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = m
y
  | m
y forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = m
x
  | Bool
otherwise   = m
x forall a. Monoid a => a -> a -> a
`mappend` m
t forall a. Monoid a => a -> a -> a
`mappend` m
y