{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

-- | A request can be thought of as having a query component which is
-- a mapping from a set of query keys (which are just strings) to values of
-- @'QueryKeyState' 'Text'@.
--
-- This module provides tools for extracting information from this mapping
-- or constructing them.
module Network.HTTP.Kinder.Query (

  -- * Classes for encoding and decoding
    QueryEncode (..)
  , QueryDecode (..)

  -- ** Listing constraints to type-level lists

  , AllQueryEncodes
  , AllQueryDecodes

  -- ** Types for encoding/decoding request queries
  , QueryKeyState (..)
  , Flag (..)

  -- * Extra serialization utilities
  , queryEncodePair

) where

import           Control.Monad
import           Data.Singletons.Prelude
import           Data.Singletons.TypeLits
import           Data.String
import           Data.Text                  (Text)
import           GHC.Exts
import           Network.HTTP.Kinder.Common

-- Data Types
-- ----------------------------------------------------------------------------

-- | 'Flag' provides semantics for query parameters which may merely exist
-- without actually storing a value---"flag" semantics.
data Flag = Here | NotHere

-- | 'QueryKeyState' describes the state of a given key within a query-map.
-- The key may be complete absent, it may exist without a value, or it may
-- exist with some value at a given type.
data QueryKeyState a
  = QueryKeyPresent
  | QueryKeyValued a
  | QueryKeyAbsent
  deriving ( Eq, Ord, Show, Read, Functor )

instance Applicative QueryKeyState where
  pure = QueryKeyValued
  (<*>) = ap

-- | Monad instance equivalent to @Either Bool@
instance Monad QueryKeyState where
  return = pure
  m >>= f =
    case m of
      QueryKeyValued a -> f a
      QueryKeyPresent -> QueryKeyPresent
      QueryKeyAbsent -> QueryKeyAbsent

-- Classes
-- ----------------------------------------------------------------------------

-- | Determines a representation of a query value for a given query key.
class QueryEncode (s :: Symbol) a where
  queryEncode :: sing s -> a -> QueryKeyState Text


-- | For a given concrete type @a@, a list of pairs @ts@ satisfies
-- @'AllQueryEncode' a ts@ if each @(n, a)@ in @ts@ has @'QueryEncode'
-- n a@.
type family AllQueryEncodes hs :: Constraint where
  AllQueryEncodes '[] = ()
  AllQueryEncodes ( '(s, a) ': hs ) = (QueryEncode s a, AllQueryEncodes hs)


-- | Attempts to parse a representation of a query value at a given query
-- key.
class QueryDecode (s :: Symbol) a where
  queryDecode :: sing s -> QueryKeyState Text -> Either String a

-- | For a given concrete type @a@, a list of pairs @ts@ satisfies
-- @'AllQueryDecode' a ts@ if each @(n, a)@ in @ts@ has @'QueryDecode'
-- n a@.
type family AllQueryDecodes hs :: Constraint where
  AllQueryDecodes '[] = ()
  AllQueryDecodes ( '(s, a) ': hs ) = (QueryDecode s a, AllQueryDecodes hs)


-- | Produces a pair of @(name, representation)@ from a given query encoding.
queryEncodePair :: (KnownSymbol n, QueryEncode n a) => Sing n -> a -> Maybe (Text, Maybe Text)
queryEncodePair s a =
  case queryEncode s a of
    QueryKeyAbsent -> Nothing
    QueryKeyPresent -> Just (name, Nothing)
    QueryKeyValued v -> Just (name, Just v)
  where
    name = fromString (withKnownSymbol s (symbolVal s))

-- Instances
-- ----------------------------------------------------------------------------

instance QueryEncode s a => QueryEncode s (QueryKeyState a) where
  queryEncode p v = v >>= queryEncode p

instance QueryEncode s Flag where
  queryEncode _ Here = QueryKeyPresent
  queryEncode _ NotHere = QueryKeyAbsent

instance QueryEncode s (Raw Text) where
  queryEncode _ (Raw t) = QueryKeyValued t

-- Handles the common case of an optional value. In other words, this will
-- treat a query parameter which was provided without a value as having
-- actually provided an empty value @""@.
instance QueryEncode s a => QueryEncode s (Maybe a) where
  queryEncode _ Nothing = QueryKeyAbsent
  queryEncode p (Just a) =
    case queryEncode p a of
      QueryKeyAbsent -> QueryKeyAbsent
      QueryKeyPresent -> QueryKeyValued ""
      QueryKeyValued txt -> QueryKeyValued txt

instance QueryDecode s a => QueryDecode s (QueryKeyState a) where
  queryDecode p v =
    case v of
      QueryKeyAbsent -> Right QueryKeyAbsent
      QueryKeyPresent -> Right QueryKeyPresent
      QueryKeyValued _ ->
        case queryDecode p v of
          Left err -> Left err
          Right val -> Right (QueryKeyValued val)

-- | This instance act "strictly" in that if the key is present but given
-- a value then it will fail to parse for this type. To be lenient use
-- 'QueryKeyState' directly.
instance QueryDecode s Flag where
  queryDecode _ QueryKeyAbsent = Right NotHere
  queryDecode _ QueryKeyPresent = Right Here
  queryDecode _ QueryKeyValued {} = Left "expected a flag query param, found a value"

instance QueryDecode s (Raw Text) where
  queryDecode _ QueryKeyAbsent = Left "expected query key"
  queryDecode _ QueryKeyPresent = Left "expected query value"
  queryDecode _ (QueryKeyValued t) = Right (Raw t)

instance QueryDecode s a => QueryDecode s (Maybe a) where
  queryDecode _ QueryKeyAbsent = Right Nothing
  queryDecode p QueryKeyPresent = queryDecode p (QueryKeyValued "")
  queryDecode p (QueryKeyValued t) = fmap Just (queryDecode p (QueryKeyValued t))