-- |

{-# LANGUAGE FlexibleContexts #-}

module Network.HTTP.Pony.Transformer.CaseInsensitive where

import Data.Profunctor (Star(..), runStar, dimap)
import Control.Lens (over, ASetter, _1, _2, traversed,
                     Field1, Field2, Traversable)
import Data.CaseInsensitive (FoldCase, CI, mk, original)

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)