{-# 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 :: forall k a. Eq k => k -> IndexedTraversal' k [(k, a)] a
assoc k
i = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t b) a b
itraversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall k a. Eq k => k -> Lens' [(k, a)] [a]
assoc2 k
k [a] -> f [a]
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,) k
k))) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             forall s t a b. Field1 s t a b => Lens s t a b
_1 ([a] -> f [a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((forall a. Eq a => a -> a -> Bool
==k
k) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = Lens' Request RequestHeaders
requestHeaders forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((HeaderName
name,ByteString
value) forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = Lens' Request RequestHeaders
requestHeaders forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
  \RequestHeaders
hdrs -> case 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) forall a. a -> [a] -> [a]
: RequestHeaders
hdrs

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