{-# LANGUAGE RankNTypes, TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Network.Wreq.Internal.Lens
    (
      HTTP.Request
    , method
    , secure
    , host
    , port
    , path
    , queryString
    , requestHeaders
    , requestBody
    , requestVersion
    , requestManagerOverride
    , onRequestBodyException
    , proxy
    , hostAddress
    , rawBody
    , decompress
    , redirectCount
    , responseTimeout
    , checkResponse
    , cookieJar
    , seshCookies
    , seshManager
    , seshRun
    , seshRunHistory
    -- * Useful functions
    , assoc
    , assoc2
    , setHeader
    , maybeSetHeader
    , deleteKey
    ) where

import Control.Lens hiding (makeLenses)
import Data.List (partition)
import Network.HTTP.Client (Request)
import Network.HTTP.Types (HeaderName)
import Network.Wreq.Lens.Machinery (makeLenses)
import Network.Wreq.Internal.Types (Session)
import qualified Data.ByteString as S
import qualified Network.HTTP.Client as HTTP

makeLenses ''HTTP.Request
makeLenses ''Session

assoc :: (Eq k) => k -> IndexedTraversal' k [(k, a)] a
assoc :: k -> IndexedTraversal' k [(k, a)] a
assoc k
i = ((k, a) -> f (k, a)) -> [(k, a)] -> f [(k, a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((k, a) -> f (k, a)) -> [(k, a)] -> f [(k, a)])
-> (p a (f a) -> (k, a) -> f (k, a))
-> p a (f a)
-> [(k, a)]
-> f [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indexed k a (f a) -> (k, a) -> f (k, a)
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed (Indexed k a (f a) -> (k, a) -> f (k, a))
-> (p a (f a) -> Indexed k a (f a))
-> p a (f a)
-> (k, a)
-> f (k, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> p a (f a) -> Indexed k a (f a)
forall i (p :: * -> * -> *) (f :: * -> *) a.
(Indexable i p, Eq i, Applicative f) =>
i -> Optical' p (Indexed i) f a a
index k
i

assoc2 :: Eq k => k -> Lens' [(k,a)] [a]
-- This is only a lens up to the ordering of the list (which changes
-- when we modify the list).
-- assoc2 :: (Eq b, Functor f) => b -> ([a] -> f [a]) -> [(b, a)] -> f [(b, a)]
assoc2 :: k -> Lens' [(k, a)] [a]
assoc2 k
k [a] -> f [a]
f = (([a], [(k, a)]) -> [(k, a)]) -> f ([a], [(k, a)]) -> f [(k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> [(k, a)] -> [(k, a)]) -> ([a], [(k, a)]) -> [(k, a)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([(k, a)] -> [(k, a)] -> [(k, a)]
forall a. [a] -> [a] -> [a]
(++) ([(k, a)] -> [(k, a)] -> [(k, a)])
-> ([a] -> [(k, a)]) -> [a] -> [(k, a)] -> [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (k, a)) -> [a] -> [(k, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) k
k))) (f ([a], [(k, a)]) -> f [(k, a)])
-> ([(k, a)] -> f ([a], [(k, a)])) -> [(k, a)] -> f [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             ([(k, a)] -> f [a]) -> ([(k, a)], [(k, a)]) -> f ([a], [(k, a)])
forall s t a b. Field1 s t a b => Lens s t a b
_1 ([a] -> f [a]
f ([a] -> f [a]) -> ([(k, a)] -> [a]) -> [(k, a)] -> f [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> a) -> [(k, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, a) -> a
forall a b. (a, b) -> b
snd) (([(k, a)], [(k, a)]) -> f ([a], [(k, a)]))
-> ([(k, a)] -> ([(k, a)], [(k, a)]))
-> [(k, a)]
-> f ([a], [(k, a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> Bool) -> [(k, a)] -> ([(k, a)], [(k, a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k) (k -> Bool) -> ((k, a) -> k) -> (k, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, a) -> k
forall a b. (a, b) -> a
fst)

-- | Set a header to the given value, replacing any prior value.
setHeader :: HeaderName -> S.ByteString -> Request -> Request
setHeader :: HeaderName -> ByteString -> Request -> Request
setHeader HeaderName
name ByteString
value = (RequestHeaders -> Identity RequestHeaders)
-> Request -> Identity Request
Lens' Request RequestHeaders
requestHeaders ((RequestHeaders -> Identity RequestHeaders)
 -> Request -> Identity Request)
-> (RequestHeaders -> RequestHeaders) -> Request -> Request
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((HeaderName
name,ByteString
value) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
:) (RequestHeaders -> RequestHeaders)
-> (RequestHeaders -> RequestHeaders)
-> RequestHeaders
-> RequestHeaders
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> RequestHeaders -> RequestHeaders
forall a b. Eq a => a -> [(a, b)] -> [(a, b)]
deleteKey HeaderName
name

-- | Set a header to the given value, but only if the header was not
-- already set.
maybeSetHeader :: HeaderName -> S.ByteString -> Request -> Request
maybeSetHeader :: HeaderName -> ByteString -> Request -> Request
maybeSetHeader HeaderName
name ByteString
value = (RequestHeaders -> Identity RequestHeaders)
-> Request -> Identity Request
Lens' Request RequestHeaders
requestHeaders ((RequestHeaders -> Identity RequestHeaders)
 -> Request -> Identity Request)
-> (RequestHeaders -> RequestHeaders) -> Request -> Request
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
  \RequestHeaders
hdrs -> case HeaderName -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
name RequestHeaders
hdrs of
             Just ByteString
_  -> RequestHeaders
hdrs
             Maybe ByteString
Nothing -> (HeaderName
name,ByteString
value) (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: RequestHeaders
hdrs

deleteKey :: (Eq a) => a -> [(a,b)] -> [(a,b)]
deleteKey :: a -> [(a, b)] -> [(a, b)]
deleteKey a
key = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
key) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
forall a b. (a, b) -> a
fst)