{-# LANGUAGE OverloadedStrings #-}

module ERPNext.Client.QueryStringParams
  ( QueryStringParam (..)
  , renderQueryStringParams
  ) where

import ERPNext.Client.Filters
import ERPNext.Client.Helper (urlEncode, quote, tshow)
import Data.Text hiding (map)

-- https://docs.frappe.io/framework/user/en/api/rest

-- TODO: Maybe change type or make opaque type to prevent invalid combinations?
-- TODO: add variants for limit, offset, etc.?
data QueryStringParam
  = Debug Bool -- ^ If 'True', makes API returning query analysis info instead of data
  | AsDict Bool -- ^ If 'False', makes API returning the data records as mixed-type arrays which cannot be parsed by this library (default: 'True')
  | LimitStart Int -- ^ Page offset (starts at 0)
  | LimitPageLength Int -- ^ Page size
  | Asc Text -- ^ Ascending order by given field
  | Desc Text -- ^ Descending order by given field
  | Fields [Text] -- ^ Select fields
  | AndFilter [Filter] -- ^ Filter terms combined with logical AND
  | OrFilter [Filter] -- ^ Filter terms combined with logical OR

renderQueryStringParam :: QueryStringParam -> Text
renderQueryStringParam :: QueryStringParam -> Text
renderQueryStringParam QueryStringParam
qsParam =
  case QueryStringParam
qsParam of
    Debug Bool
b -> Text
"debug=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall a. Show a => a -> Text
tshow Bool
b
    AsDict Bool
b -> Text
"as_dict=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Text
forall a. Show a => a -> Text
tshow Bool
b
    LimitStart Int
offset -> Text
"limit_start=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
offset)
    LimitPageLength Int
n -> Text
"limit=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n -- it was limit_page_length up to v13

    Asc Text
field ->
      Text -> Text -> Text
renderOrderBy Text
field Text
"asc"

    Desc Text
field ->
      Text -> Text -> Text
renderOrderBy Text
field Text
"desc"

    Fields [Text]
fields ->
      [Text] -> Text
renderFields [Text]
fields

    AndFilter [Filter]
filters ->
      Text -> [Filter] -> Text
renderFilters Text
"filters" [Filter]
filters

    OrFilter [Filter]
filters ->
      Text -> [Filter] -> Text
renderFilters Text
"or_filters" [Filter]
filters

renderFields :: [Text] -> Text
renderFields :: [Text] -> Text
renderFields [Text]
fields =
  Text
"fields=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEncode (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
quote [Text]
fields) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")

renderOrderBy :: Text -> Text -> Text
renderOrderBy :: Text -> Text -> Text
renderOrderBy Text
field Text
order =
  Text
"order_by=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEncode (Text
field Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
order)

-- | Render the query string for the URL.
renderQueryStringParams :: [QueryStringParam] -> Text
renderQueryStringParams :: [QueryStringParam] -> Text
renderQueryStringParams [QueryStringParam]
params = Text -> [Text] -> Text
intercalate Text
"&" ((QueryStringParam -> Text) -> [QueryStringParam] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map QueryStringParam -> Text
renderQueryStringParam [QueryStringParam]
params)