{-# LANGUAGE FlexibleInstances #-}
module Network.HTTP.Types.QueryLike
(
  QueryLike(..)
, QueryKeyLike(..)
, QueryValueLike(..)
)
where

import           Network.HTTP.Types.URI
import           Data.Maybe
import qualified Data.ByteString        as B
import qualified Data.ByteString.Lazy   as L
import qualified Data.Text              as T
import qualified Data.Text.Encoding     as T
import           Control.Arrow

-- | Types which can, and commonly are, converted to 'Query' are in this class.
-- 
-- You can use lists of simple key value pairs, with 'B.ByteString' (strict, or lazy: 
-- 'L.ByteString'), 'T.Text', or 'String' as the key/value types. You can also have the value
-- type lifted into a Maybe to support keys without values; and finally it is possible to put
-- each pair into a Maybe for key-value pairs that aren't always present.
class QueryLike a where
  -- | Convert to 'Query'.
  toQuery :: a -> Query

-- | Types which, in a Query-like key-value list, are used in the Key position.
class QueryKeyLike a where
  toQueryKey :: a -> B.ByteString

-- | Types which, in a Query-like key-value list, are used in the Value position.
class QueryValueLike a where
  toQueryValue :: a -> Maybe B.ByteString

instance (QueryKeyLike k, QueryValueLike v) => QueryLike [(k, v)] where
  toQuery :: [(k, v)] -> Query
toQuery = ((k, v) -> QueryItem) -> [(k, v)] -> Query
forall a b. (a -> b) -> [a] -> [b]
map (k -> ByteString
forall a. QueryKeyLike a => a -> ByteString
toQueryKey (k -> ByteString) -> (v -> Maybe ByteString) -> (k, v) -> QueryItem
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** v -> Maybe ByteString
forall a. QueryValueLike a => a -> Maybe ByteString
toQueryValue)

instance (QueryKeyLike k, QueryValueLike v) => QueryLike [Maybe (k, v)] where
  toQuery :: [Maybe (k, v)] -> Query
toQuery = [(k, v)] -> Query
forall a. QueryLike a => a -> Query
toQuery ([(k, v)] -> Query)
-> ([Maybe (k, v)] -> [(k, v)]) -> [Maybe (k, v)] -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (k, v)] -> [(k, v)]
forall a. [Maybe a] -> [a]
catMaybes

instance QueryKeyLike B.ByteString where toQueryKey :: ByteString -> ByteString
toQueryKey = ByteString -> ByteString
forall a. a -> a
id
instance QueryKeyLike L.ByteString where toQueryKey :: ByteString -> ByteString
toQueryKey = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
instance QueryKeyLike T.Text where toQueryKey :: Text -> ByteString
toQueryKey = Text -> ByteString
T.encodeUtf8
instance QueryKeyLike [Char] where toQueryKey :: [Char] -> ByteString
toQueryKey = Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

instance QueryValueLike B.ByteString where toQueryValue :: ByteString -> Maybe ByteString
toQueryValue = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
instance QueryValueLike L.ByteString where toQueryValue :: ByteString -> Maybe ByteString
toQueryValue = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
instance QueryValueLike T.Text where toQueryValue :: Text -> Maybe ByteString
toQueryValue = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Text -> ByteString) -> Text -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
instance QueryValueLike [Char] where toQueryValue :: [Char] -> Maybe ByteString
toQueryValue = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> ([Char] -> ByteString) -> [Char] -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack

instance QueryValueLike a => QueryValueLike (Maybe a) where
  toQueryValue :: Maybe a -> Maybe ByteString
toQueryValue = Maybe ByteString
-> (a -> Maybe ByteString) -> Maybe a -> Maybe ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe ByteString
forall a. Maybe a
Nothing a -> Maybe ByteString
forall a. QueryValueLike a => a -> Maybe ByteString
toQueryValue