{-# LANGUAGE FlexibleContexts #-}
module Web.Route.Invertible.Map.Query
  ( QueryMap(..)
  , defaultQueryMap
  , singletonQuery
  , singletonQueryState
  , lookupQuery
  ) where

import qualified Data.HashMap.Lazy as HM

import Web.Route.Invertible.Placeholder
import Web.Route.Invertible.Map.Placeholder
import Web.Route.Invertible.Query
import Web.Route.Invertible.Dynamics

-- |A map for parsing query parameters as 'Placeholder's by name, kept in alphabetical order to ensure consistent unions.
data QueryMap a = QueryFinal (Maybe a) | QueryMap
  { QueryMap a -> QueryString
queryParam :: !QueryString
  , QueryMap a -> PlaceholderMap QueryString (QueryMap a)
queryMap :: !(PlaceholderMap QueryString (QueryMap a))
  , QueryMap a -> QueryMap a
queryMissing :: !(QueryMap a)
  } deriving (QueryMap a -> QueryMap a -> Bool
(QueryMap a -> QueryMap a -> Bool)
-> (QueryMap a -> QueryMap a -> Bool) -> Eq (QueryMap a)
forall a. Eq a => QueryMap a -> QueryMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryMap a -> QueryMap a -> Bool
$c/= :: forall a. Eq a => QueryMap a -> QueryMap a -> Bool
== :: QueryMap a -> QueryMap a -> Bool
$c== :: forall a. Eq a => QueryMap a -> QueryMap a -> Bool
Eq, Int -> QueryMap a -> ShowS
[QueryMap a] -> ShowS
QueryMap a -> String
(Int -> QueryMap a -> ShowS)
-> (QueryMap a -> String)
-> ([QueryMap a] -> ShowS)
-> Show (QueryMap a)
forall a. Show a => Int -> QueryMap a -> ShowS
forall a. Show a => [QueryMap a] -> ShowS
forall a. Show a => QueryMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryMap a] -> ShowS
$cshowList :: forall a. Show a => [QueryMap a] -> ShowS
show :: QueryMap a -> String
$cshow :: forall a. Show a => QueryMap a -> String
showsPrec :: Int -> QueryMap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QueryMap a -> ShowS
Show)

instance Functor QueryMap where
  fmap :: (a -> b) -> QueryMap a -> QueryMap b
fmap a -> b
f (QueryFinal Maybe a
v) = Maybe b -> QueryMap b
forall a. Maybe a -> QueryMap a
QueryFinal ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
v)
  fmap a -> b
f (QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m QueryMap a
d) = QueryString
-> PlaceholderMap QueryString (QueryMap b)
-> QueryMap b
-> QueryMap b
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n ((QueryMap a -> QueryMap b)
-> PlaceholderMap QueryString (QueryMap a)
-> PlaceholderMap QueryString (QueryMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> QueryMap a -> QueryMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) PlaceholderMap QueryString (QueryMap a)
m) ((a -> b) -> QueryMap a -> QueryMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f QueryMap a
d)

instance Semigroup a => Semigroup (QueryMap a) where
  QueryFinal Maybe a
a <> :: QueryMap a -> QueryMap a -> QueryMap a
<> QueryFinal Maybe a
b = Maybe a -> QueryMap a
forall a. Maybe a -> QueryMap a
QueryFinal (Maybe a
a Maybe a -> Maybe a -> Maybe a
forall a. Semigroup a => a -> a -> a
<> Maybe a
b)
  q :: QueryMap a
q@(QueryFinal Maybe a
_) <> (QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m QueryMap a
d) = QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m (QueryMap a
q QueryMap a -> QueryMap a -> QueryMap a
forall a. Semigroup a => a -> a -> a
<> QueryMap a
d)
  (QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m QueryMap a
d) <> q :: QueryMap a
q@(QueryFinal Maybe a
_) = QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m (QueryMap a
d QueryMap a -> QueryMap a -> QueryMap a
forall a. Semigroup a => a -> a -> a
<> QueryMap a
q)
  q1 :: QueryMap a
q1@(QueryMap QueryString
n1 PlaceholderMap QueryString (QueryMap a)
m1 QueryMap a
d1) <> q2 :: QueryMap a
q2@(QueryMap QueryString
n2 PlaceholderMap QueryString (QueryMap a)
m2 QueryMap a
d2) = case QueryString -> QueryString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare QueryString
n1 QueryString
n2 of
    Ordering
LT -> QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n1 PlaceholderMap QueryString (QueryMap a)
m1 (QueryMap a
d1 QueryMap a -> QueryMap a -> QueryMap a
forall a. Semigroup a => a -> a -> a
<> QueryMap a
q2)
    Ordering
EQ -> QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n1 (PlaceholderMap QueryString (QueryMap a)
m1 PlaceholderMap QueryString (QueryMap a)
-> PlaceholderMap QueryString (QueryMap a)
-> PlaceholderMap QueryString (QueryMap a)
forall a. Semigroup a => a -> a -> a
<> PlaceholderMap QueryString (QueryMap a)
m2) (QueryMap a
d1 QueryMap a -> QueryMap a -> QueryMap a
forall a. Semigroup a => a -> a -> a
<> QueryMap a
d2)
    Ordering
GT -> QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n2 PlaceholderMap QueryString (QueryMap a)
m2 (QueryMap a
q1 QueryMap a -> QueryMap a -> QueryMap a
forall a. Semigroup a => a -> a -> a
<> QueryMap a
d2)

instance Monoid a => Monoid (QueryMap a) where
  mempty :: QueryMap a
mempty = Maybe a -> QueryMap a
forall a. Maybe a -> QueryMap a
QueryFinal Maybe a
forall a. Monoid a => a
mempty
  mappend :: QueryMap a -> QueryMap a -> QueryMap a
mappend (QueryFinal Maybe a
a) (QueryFinal Maybe a
b) = Maybe a -> QueryMap a
forall a. Maybe a -> QueryMap a
QueryFinal (Maybe a -> Maybe a -> Maybe a
forall a. Monoid a => a -> a -> a
mappend Maybe a
a Maybe a
b)
  mappend q :: QueryMap a
q@(QueryFinal Maybe a
_) (QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m QueryMap a
d) = QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m (QueryMap a -> QueryMap a -> QueryMap a
forall a. Monoid a => a -> a -> a
mappend QueryMap a
q QueryMap a
d)
  mappend (QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m QueryMap a
d) q :: QueryMap a
q@(QueryFinal Maybe a
_) = QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m (QueryMap a -> QueryMap a -> QueryMap a
forall a. Monoid a => a -> a -> a
mappend QueryMap a
d QueryMap a
q)
  mappend q1 :: QueryMap a
q1@(QueryMap QueryString
n1 PlaceholderMap QueryString (QueryMap a)
m1 QueryMap a
d1) q2 :: QueryMap a
q2@(QueryMap QueryString
n2 PlaceholderMap QueryString (QueryMap a)
m2 QueryMap a
d2) = case QueryString -> QueryString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare QueryString
n1 QueryString
n2 of
    Ordering
LT -> QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n1 PlaceholderMap QueryString (QueryMap a)
m1 (QueryMap a -> QueryMap a -> QueryMap a
forall a. Monoid a => a -> a -> a
mappend QueryMap a
d1 QueryMap a
q2)
    Ordering
EQ -> QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n1 (PlaceholderMap QueryString (QueryMap a)
-> PlaceholderMap QueryString (QueryMap a)
-> PlaceholderMap QueryString (QueryMap a)
forall a. Monoid a => a -> a -> a
mappend PlaceholderMap QueryString (QueryMap a)
m1 PlaceholderMap QueryString (QueryMap a)
m2) (QueryMap a -> QueryMap a -> QueryMap a
forall a. Monoid a => a -> a -> a
mappend QueryMap a
d1 QueryMap a
d2)
    Ordering
GT -> QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n2 PlaceholderMap QueryString (QueryMap a)
m2 (QueryMap a -> QueryMap a -> QueryMap a
forall a. Monoid a => a -> a -> a
mappend QueryMap a
q1 QueryMap a
d2)

-- |The empty query map.
emptyQueryMap :: QueryMap a
emptyQueryMap :: QueryMap a
emptyQueryMap = Maybe a -> QueryMap a
forall a. Maybe a -> QueryMap a
QueryFinal Maybe a
forall a. Maybe a
Nothing

-- |The constant query map, always returning the same value.
defaultQueryMap :: a -> QueryMap a
defaultQueryMap :: a -> QueryMap a
defaultQueryMap = Maybe a -> QueryMap a
forall a. Maybe a -> QueryMap a
QueryFinal (Maybe a -> QueryMap a) -> (a -> Maybe a) -> a -> QueryMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just

-- |The query map with a single item, which maps queries containing the given query variable matching the placeholder to the specified @a@ value.
singletonQuery :: QueryString -> Placeholder QueryString p -> a -> QueryMap a
singletonQuery :: QueryString -> Placeholder QueryString p -> a -> QueryMap a
singletonQuery QueryString
n Placeholder QueryString p
p a
v = QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n (Placeholder QueryString p
-> QueryMap a -> PlaceholderMap QueryString (QueryMap a)
forall s p a.
RouteString s =>
Placeholder s p -> a -> PlaceholderMap s a
singletonPlaceholder Placeholder QueryString p
p (QueryMap a -> PlaceholderMap QueryString (QueryMap a))
-> QueryMap a -> PlaceholderMap QueryString (QueryMap a)
forall a b. (a -> b) -> a -> b
$ a -> QueryMap a
forall a. a -> QueryMap a
defaultQueryMap a
v) QueryMap a
forall a. QueryMap a
emptyQueryMap

-- |A 'singletonQuery' map with a 'DynamicState' value to parse the placeholder.
singletonQueryState :: QueryString -> Placeholder QueryString p -> QueryMap (DynamicState p)
singletonQueryState :: QueryString
-> Placeholder QueryString p -> QueryMap (DynamicState p)
singletonQueryState QueryString
n Placeholder QueryString p
p = QueryString
-> PlaceholderMap QueryString (QueryMap (DynamicState p))
-> QueryMap (DynamicState p)
-> QueryMap (DynamicState p)
forall a.
QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> QueryMap a
-> QueryMap a
QueryMap QueryString
n (DynamicState p -> QueryMap (DynamicState p)
forall a. a -> QueryMap a
defaultQueryMap (DynamicState p -> QueryMap (DynamicState p))
-> PlaceholderMap QueryString (DynamicState p)
-> PlaceholderMap QueryString (QueryMap (DynamicState p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Placeholder QueryString p
-> PlaceholderMap QueryString (DynamicState p)
forall s a.
RouteString s =>
Placeholder s a -> PlaceholderMap s (DynamicState a)
singletonPlaceholderState Placeholder QueryString p
p) QueryMap (DynamicState p)
forall a. QueryMap a
emptyQueryMap

-- |Lookup a URL query in the query map and return all matching results.
lookupQuery :: QueryParams -> QueryMap a -> [DynamicResult a]
lookupQuery :: QueryParams -> QueryMap a -> [DynamicResult a]
lookupQuery QueryParams
_ (QueryFinal Maybe a
Nothing) = []
lookupQuery QueryParams
_ (QueryFinal (Just a
a)) = [([], a
a)]
lookupQuery QueryParams
q (QueryMap QueryString
n PlaceholderMap QueryString (QueryMap a)
m QueryMap a
d)
  | Just [QueryString]
qv <- QueryString -> QueryParams -> Maybe [QueryString]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup QueryString
n QueryParams
q = do
    QueryString
s <- [QueryString]
qv
    QueryString
-> PlaceholderMap QueryString (QueryMap a)
-> (QueryMap a -> [DynamicResult a])
-> [DynamicResult a]
forall s a b.
RouteString s =>
s
-> PlaceholderMap s a
-> (a -> [DynamicResult b])
-> [DynamicResult b]
lookupPlaceholderWith QueryString
s PlaceholderMap QueryString (QueryMap a)
m ((QueryMap a -> [DynamicResult a]) -> [DynamicResult a])
-> (QueryMap a -> [DynamicResult a]) -> [DynamicResult a]
forall a b. (a -> b) -> a -> b
$ QueryParams -> QueryMap a -> [DynamicResult a]
forall a. QueryParams -> QueryMap a -> [DynamicResult a]
lookupQuery QueryParams
q
  | Bool
otherwise = QueryParams -> QueryMap a -> [DynamicResult a]
forall a. QueryParams -> QueryMap a -> [DynamicResult a]
lookupQuery QueryParams
q QueryMap a
d