module Reddit.Routes.Search where

import Reddit.Types.Options
import Reddit.Types.Post
import Reddit.Types.Subreddit
import qualified Reddit.Types.SearchOptions as Search

import Data.Maybe
import Data.Text (Text)
import Network.API.Builder.Routes

searchRoute :: Maybe SubredditName -> Options PostID -> Search.Order -> Maybe Text -> Text -> Route
searchRoute :: Maybe SubredditName
-> Options PostID -> Order -> Maybe Text -> Text -> Route
searchRoute Maybe SubredditName
r Options PostID
opts Order
sorder Maybe Text
engine Text
q =
  [Text] -> [URLParam] -> Method -> Route
Route (Maybe SubredditName -> [Text]
path Maybe SubredditName
r)
        [ Text
"after" Text -> Maybe PostID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options PostID -> Maybe PostID
forall a. Options a -> Maybe a
after Options PostID
opts
        , Text
"before" Text -> Maybe PostID -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options PostID -> Maybe PostID
forall a. Options a -> Maybe a
before Options PostID
opts
        , Text
"restrict_sr" Text -> Bool -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Maybe SubredditName -> Bool
forall a. Maybe a -> Bool
isJust Maybe SubredditName
r
        , Text
"sort" Text -> Order -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Order
sorder
        , Text
"syntax" Text -> Maybe Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Maybe Text
engine
        , Text
"limit" Text -> Maybe Int -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Options PostID -> Maybe Int
forall a. Options a -> Maybe Int
limit Options PostID
opts
        , Text
"q" Text -> Maybe Text -> URLParam
forall a. ToQuery a => Text -> a -> URLParam
=. Text -> Maybe Text
forall a. a -> Maybe a
Just Text
q ]
        Method
"GET"
  where
    path :: Maybe SubredditName -> [Text]
path (Just (R Text
sub)) = [ Text
"r", Text
sub, Text
"search" ]
    path Maybe SubredditName
Nothing = [ Text
"search" ]