content: -- | Type level functions over 'ReqContent' and 'ResContent'
  --
  module Hreq.Core.API.TypeLevel where
  
  import Data.Kind (Type, Constraint)
  import GHC.TypeLits (Symbol, TypeError, ErrorMessage(..), KnownSymbol, KnownNat)
  import Network.HTTP.Types (Header)
  import Web.HttpApiData (ToHttpApiData)
  
  import Hreq.Core.Client.BasicAuth (BasicAuthData)
  import Hreq.Core.API.Request (ReqContent(..))
  import Hreq.Core.API.Response (ResContent (..))
  import Hreq.Core.API.Internal ((:>))
  import Hreq.Core.API.MediaType (MediaDecode, MediaEncode, HasMediaType)
  import Hreq.Core.API.Streaming (HasStreamBody)
  import Hreq.Core.API.Verb (Verb)
  
  -- | 'ApiToReq' transforms an API type into a type level list of
  -- Request component content types.
  -- The resulting list is used by the 'Hreq.Core.API.HasRequest.HasRequest' class.
  type family ApiToReq (a :: api) :: [ ReqContent Type]  where
    ApiToReq (Verb m ts) =  '[ ]
    ApiToReq ( (path :: Symbol) :> ts) = 'Path () path ': ApiToReq ts
    ApiToReq ( (x :: ReqContent Type) :> ts) = x ': ApiToReq ts
  
  -- | Given an API type, 'GetVerb' retrieves the Verb type component which
  -- is used by the 'Hreq.Core.Client.HasResponse.HasResponse' class.
  type family GetVerb (a :: api) :: Type  where
    GetVerb (Verb m ts) =  Verb m ts
    GetVerb (api :> sub) = GetVerb sub
  
  -- | 'HttpReq' interprets a 'ReqContent' list as a 'Type' level list
  -- used in the 'Hreq.Core.Client.HasRequest.HasRequest' class for representing
  -- request component inputs
  type family HttpReq (ts :: [ReqContent Type]) :: [  Type ] where
    HttpReq '[] = '[]
  
    HttpReq ('Path _ _ ': ts) = HttpReq ts
  
    HttpReq ('ReqBody ctyp a ': ts) = a ': HttpReq ts
  
    HttpReq ('StreamBody ctyp a ': ts) = a ': HttpReq ts
  
    HttpReq ('BasicAuth _ _ : ts) = BasicAuthData ': HttpReq ts
  
    HttpReq ('QueryFlags _ _ ': ts) = HttpReq ts
  
    HttpReq ('Params ( '(s, a) ': ps ) ': ts) = a ': HttpReq ('Params ps ': ts)
    HttpReq ('Params '[] : ts) = HttpReq ts
  
    HttpReq ('CaptureAll a ': ts) = [a] ': HttpReq ts
  
    HttpReq ('Captures ( a : cs ) ': ts) = a ': HttpReq ('Captures cs ': ts)
    HttpReq ('Captures '[] : ts) = HttpReq ts
  
    HttpReq ('ReqHeaders ( '(s, a) ': hs ) ': ts) = a ': HttpReq ('ReqHeaders hs ': ts)
    HttpReq ('ReqHeaders '[] : ts) = HttpReq ts
  
  -- | 'HttpRes' interprets a 'ResContent' list as a Type level list for
  -- used 'Hreq.Core.Client.HasResponse.HasResponse' class to represent responses
  type family HttpRes (res :: [ ResContent Type ]) :: [ Type ] where
    HttpRes '[] = '[]
    HttpRes ('ResBody ctyp a ': ts) = a ': HttpRes ts
    HttpRes ('ResStatus _a code ': ts) = HttpRes ts
    HttpRes ('ResHeaders (s ': hs) ': ts) = [Header] ': HttpRes ts
    HttpRes ('ResHeaders '[]  ': ts) = HttpRes ts
    HttpRes ('Raw a ': ts) = HttpRes ts
  
  -- | Response content types Constraints.
  type family HttpResConstraints (res :: [ResContent Type]) :: Constraint where
    HttpResConstraints '[] = ()
    HttpResConstraints  ('ResStatus _a code ': ts) = (KnownNat code, HttpResConstraints ts)
    HttpResConstraints  ('ResBody ctyp a ': ts) =
       (HasMediaType ctyp, MediaDecode ctyp a, HttpResConstraints ts)
    HttpResConstraints  ('ResStream ctyp a ': ts) = (HasMediaType ctyp, HttpResConstraints ts)
    HttpResConstraints ('ResHeaders hs ': ts) = (HttpSymbolTypePair hs, HttpResConstraints ts)
    HttpResConstraints ('Raw a ': ts) = HttpResConstraints ts
  
  -- | Request content types Constraints.
  type family HttpReqConstraints (req :: [ReqContent Type]) :: Constraint where
    HttpReqConstraints '[] = ()
  
    HttpReqConstraints ('Path _ path ': ts) = (KnownSymbol path, HttpReqConstraints ts)
  
    HttpReqConstraints ('BasicAuth _ _ ': ts) = HttpReqConstraints ts
  
    HttpReqConstraints ('ReqBody ctyp a ': ts ) =
      (HasMediaType ctyp, MediaEncode ctyp a, HttpReqConstraints ts)
  
    HttpReqConstraints ('StreamBody ctyp a ': ts ) =
      (HasMediaType ctyp, HasStreamBody a, HttpReqConstraints ts)
  
  
    HttpReqConstraints ('QueryFlags _a fs ': ts) = (All KnownSymbol fs, HttpReqConstraints ts)
  
    HttpReqConstraints ('Params ( '(s, a) ': ps) ': ts) =
      (KnownSymbol s, ToHttpApiData a,  HttpReqConstraints ('Params ps ': ts))
    HttpReqConstraints ('Params '[] ': ts) =  HttpReqConstraints ts
  
    HttpReqConstraints ('Captures ( a : cs) ': ts) =
      (ToHttpApiData a,  HttpReqConstraints ('Captures cs ': ts))
    HttpReqConstraints ('Captures '[] ': ts) =  HttpReqConstraints ts
  
    HttpReqConstraints ('CaptureAll a ': ts) = (ToHttpApiData a, HttpReqConstraints ts)
  
    HttpReqConstraints ('ReqHeaders ('(s, a) ': hs) ': ts) =
       (KnownSymbol s, ToHttpApiData a, HttpReqConstraints ('ReqHeaders hs ': ts))
    HttpReqConstraints ('ReqHeaders '[] ': ts) = HttpReqConstraints ts
  
  -- | For a given HTTP API data 'Symbol' 'Type' tuple list generate Constraints for all the members.
  type family HttpSymbolTypePair (ts :: [(Symbol, Type)]) :: Constraint where
    HttpSymbolTypePair ts =  (All KnownSymbol (AllFsts ts), All ToHttpApiData (AllSnds ts))
  
  -- | Cross check that there are no repeated instance of an item
  -- with in a type level list. For instance we want to have only
  -- one 'ResBody' with in a Response type level list
  type family UniqMembers (ts :: [k]) (label :: Symbol) :: Constraint  where
    UniqMembers '[] label = ()
    UniqMembers (a ': ts) label = (UniqMember a ts label, UniqMembers ts label)
  
  type family UniqMember (a :: k) (ts :: [k]) (label :: Symbol) :: Constraint where
     UniqMember a '[] label = ()
     UniqMember a (a ': ts) label = TypeError ( 'Text "Type "
                                                ':<>: 'ShowType a
                                                ':<>: 'Text "Should be unique with in the "
                                                ':<>: 'Text label
                                                ':<>: 'Text " type level list"
                                               )
     UniqMember a (b ': ts ) label = UniqMember b ts label
  
  
  {-------------------------------------------------------------------------------
    Helper type families
  -------------------------------------------------------------------------------}
  
  type family All (a :: k -> Constraint) (ts :: [k]) :: Constraint where
    All c '[] = ()
    All c (t ': ts) = (c t, All c ts)
  
  type family AllFsts (a :: [(k1, k2)]) :: [k1] where
    AllFsts '[] = '[]
    AllFsts ('(f, s) ': ts) = f ': AllFsts ts
  
  type family AllSnds (a :: [(k1, k2)]) :: [k2] where
    AllSnds '[] = '[]
    AllSnds ('(f, s) ': ts) = s ': AllSnds ts
  