{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK not-home #-}

module Servant.API.QueryString (QueryString, DeepQuery, FromDeepQuery (..), ToDeepQuery (..), generateDeepParam) where

import Data.Bifunctor (Bifunctor (first))
import Data.Kind (Type)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable
  ( Typeable,
  )
import GHC.TypeLits
  ( Symbol,
  )
import Web.HttpApiData (FromHttpApiData)
import Web.Internal.HttpApiData (FromHttpApiData (..))

-- | Extract the whole query string from a request. This is useful for query strings
-- containing dynamic parameter names. For query strings with static parameter names,
-- 'QueryParam' is more suited.
--
-- Example:
--
-- >>> -- /books?author=<author name>&year=<book year>
-- >>> type MyApi = "books" :> QueryString :> Get '[JSON] [Book]
data QueryString
  deriving (Typeable)

-- | Extract an deep object from a query string.
--
-- Example:
--
-- >>> -- /books?filter[author][name]=<author name>&filter[year]=<book year>
-- >>> type MyApi = "books" :> DeepQuery "filter" BookQuery :> Get '[JSON] [Book]
data DeepQuery (sym :: Symbol) (a :: Type)
  deriving (Typeable)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Servant.API
-- >>> import Data.Aeson
-- >>> import Data.Text
-- >>> data Book
-- >>> data BookQuery
-- >>> instance ToJSON Book where { toJSON = undefined }

-- | Extract a deep object from (possibly nested) query parameters.
-- a param like @filter[a][b][c]=d@ will be represented as
-- @'(["a", "b", "c"], Just "d")'@. Note that a parameter with no
-- nested field is possible: @filter=a@ will be represented as
-- @'([], Just "a")'@
class FromDeepQuery a where
  fromDeepQuery :: [([Text], Maybe Text)] -> Either String a

instance (FromHttpApiData a) => FromDeepQuery (Map Text a) where
  fromDeepQuery :: [([Text], Maybe Text)] -> Either String (Map Text a)
fromDeepQuery [([Text], Maybe Text)]
params =
    let parseParam :: ([t], Maybe Text) -> Either String (t, a)
parseParam ([t
k], Just Text
rawV) = (t
k,) (a -> (t, a)) -> Either String a -> Either String (t, a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> String) -> Either Text a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> String
T.unpack (Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
rawV)
        parseParam ([t]
_, Maybe Text
Nothing) = String -> Either String (t, a)
forall a b. a -> Either a b
Left String
"Empty map value"
        parseParam ([], Maybe Text
_) = String -> Either String (t, a)
forall a b. a -> Either a b
Left String
"Empty map parameter"
        parseParam ([t]
_, Just Text
_) = String -> Either String (t, a)
forall a b. a -> Either a b
Left String
"Nested map values"
     in [(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, a)] -> Map Text a)
-> Either String [(Text, a)] -> Either String (Map Text a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Text], Maybe Text) -> Either String (Text, a))
-> [([Text], Maybe Text)] -> Either String [(Text, a)]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Text], Maybe Text) -> Either String (Text, a)
forall {a} {t}.
FromHttpApiData a =>
([t], Maybe Text) -> Either String (t, a)
parseParam [([Text], Maybe Text)]
params

-- | Generate query parameters from an object, using the deep object syntax.
-- A result of @'(["a", "b", "c"], Just "d")'@ attributed to the @filter@
-- parameter name will result in the following query parameter:
-- @filter[a][b][c]=d@
class ToDeepQuery a where
  toDeepQuery :: a -> [([Text], Maybe Text)]

-- | Turn a nested path into a deep object query param
--
-- >>> generateDeepParam "filter" (["a", "b", "c"], Just "d")
-- ("filter[a][b][c]",Just "d")
generateDeepParam :: Text -> ([Text], Maybe Text) -> (Text, Maybe Text)
generateDeepParam :: Text -> ([Text], Maybe Text) -> (Text, Maybe Text)
generateDeepParam Text
name ([Text]
keys, Maybe Text
value) =
  let makeKeySegment :: a -> a
makeKeySegment a
key = a
"[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
key a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"]"
   in (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
makeKeySegment [Text]
keys, Maybe Text
value)