module Network.HTTP.Pony.Transformer.CaseInsensitive where
import Control.Lens.Setter (ASetter, over)
import Control.Lens.Traversal (traversed)
import Control.Lens.Tuple (_1, _2, Field1, Field2)
import Data.CaseInsensitive (FoldCase, CI, mk, original)
import Data.Profunctor (Star(..), runStar, dimap)
type Middleware f s t a b = (a -> f b) -> s -> f t
transform x y = runStar . dimap x y . Star
caseInsensitiveWith :: (FoldCase header, Functor f)
=> ASetter req req' header (CI header)
-> ASetter res' res (CI header') header'
-> Middleware f req res req' res'
caseInsensitiveWith x y = transform
(over x mk)
(over y original)
caseInsensitive
:: (FoldCase header, Field1 a1 b3 (CI b4) b4, Field1 s2 res s3 b2,
Field1 a b1 header (CI header), Field1 s req' s1 b,
Field2 s3 b2 (f2 a1) (f2 b3), Field2 s1 b (f1 a) (f1 b1),
Traversable f2, Traversable f1, Functor f) =>
Middleware f s res req' s2
caseInsensitive = caseInsensitiveWith
(_1 . _2 . traversed . _1)
(_1 . _2 . traversed . _1)