{-# LANGUAGE OverloadedStrings #-}

module ERPNext.Client.Filters
  ( Filter (..)
  , FilterOperator (..)
  , FilterValue (..)
  , renderFilters
  ) where

import Data.Text (Text, intercalate)
import Data.Time.Calendar (Day)
import ERPNext.Client.Helper (urlEncode, quote, tshow)

-- TODO: refactor this? rename to filter and parameterize each term with fieldname and value?
data FilterOperator
  = Eq
  | NotEq
  | Greater
  | GreaterOrEq
  | Less
  | LessOrEq
  | Like
  | NotLike
  | In
  | NotIn
  | Between
  | Is
  deriving (Int -> FilterOperator -> ShowS
[FilterOperator] -> ShowS
FilterOperator -> String
(Int -> FilterOperator -> ShowS)
-> (FilterOperator -> String)
-> ([FilterOperator] -> ShowS)
-> Show FilterOperator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilterOperator -> ShowS
showsPrec :: Int -> FilterOperator -> ShowS
$cshow :: FilterOperator -> String
show :: FilterOperator -> String
$cshowList :: [FilterOperator] -> ShowS
showList :: [FilterOperator] -> ShowS
Show, FilterOperator -> FilterOperator -> Bool
(FilterOperator -> FilterOperator -> Bool)
-> (FilterOperator -> FilterOperator -> Bool) -> Eq FilterOperator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilterOperator -> FilterOperator -> Bool
== :: FilterOperator -> FilterOperator -> Bool
$c/= :: FilterOperator -> FilterOperator -> Bool
/= :: FilterOperator -> FilterOperator -> Bool
Eq)

data FilterValue
  = FilterText Text
  | FilterNumber Double
  | FilterBool Bool
  | FilterList [FilterValue]
  | FilterDay Day
  | FilterNull -- Used only with Is
  | FilterNotNull -- Used only with Is
  deriving (Int -> FilterValue -> ShowS
[FilterValue] -> ShowS
FilterValue -> String
(Int -> FilterValue -> ShowS)
-> (FilterValue -> String)
-> ([FilterValue] -> ShowS)
-> Show FilterValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilterValue -> ShowS
showsPrec :: Int -> FilterValue -> ShowS
$cshow :: FilterValue -> String
show :: FilterValue -> String
$cshowList :: [FilterValue] -> ShowS
showList :: [FilterValue] -> ShowS
Show, FilterValue -> FilterValue -> Bool
(FilterValue -> FilterValue -> Bool)
-> (FilterValue -> FilterValue -> Bool) -> Eq FilterValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilterValue -> FilterValue -> Bool
== :: FilterValue -> FilterValue -> Bool
$c/= :: FilterValue -> FilterValue -> Bool
/= :: FilterValue -> FilterValue -> Bool
Eq)

data Filter = Filter
  { Filter -> Text
filterField :: Text
  , Filter -> FilterOperator
filterOperator :: FilterOperator
  , Filter -> FilterValue
filterValue :: FilterValue
  }
  deriving (Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
(Int -> Filter -> ShowS)
-> (Filter -> String) -> ([Filter] -> ShowS) -> Show Filter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Filter -> ShowS
showsPrec :: Int -> Filter -> ShowS
$cshow :: Filter -> String
show :: Filter -> String
$cshowList :: [Filter] -> ShowS
showList :: [Filter] -> ShowS
Show, Filter -> Filter -> Bool
(Filter -> Filter -> Bool)
-> (Filter -> Filter -> Bool) -> Eq Filter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
/= :: Filter -> Filter -> Bool
Eq)

renderFilterOperator :: FilterOperator -> Text
renderFilterOperator :: FilterOperator -> Text
renderFilterOperator FilterOperator
op =
  case FilterOperator
op of
    FilterOperator
Eq -> Text
"="
    FilterOperator
NotEq -> Text
"!="
    FilterOperator
Greater -> Text
">"
    FilterOperator
GreaterOrEq -> Text
">="
    FilterOperator
Less -> Text
"<"
    FilterOperator
LessOrEq -> Text
"<="
    FilterOperator
Like -> Text
"like"
    FilterOperator
NotLike -> Text
"not like"
    FilterOperator
In -> Text
"in"
    FilterOperator
NotIn -> Text
"not in"
    FilterOperator
Between -> Text
"between"
    FilterOperator
Is -> Text
"is"

renderFilterValue :: FilterValue -> Text
renderFilterValue :: FilterValue -> Text
renderFilterValue FilterValue
fv =
  case FilterValue
fv of
    FilterText Text
t -> Text -> Text
quote Text
t
    FilterNumber Double
n -> Double -> Text
forall a. Show a => a -> Text
tshow Double
n
    FilterBool Bool
b -> if Bool
b then Text
"1" else Text
"0"
    FilterList [FilterValue]
vs -> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((FilterValue -> Text) -> [FilterValue] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilterValue -> Text
renderFilterValue [FilterValue]
vs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
    FilterDay Day
d -> Text -> Text
quote (Day -> Text
forall a. Show a => a -> Text
tshow Day
d)
    FilterValue
FilterNull -> Text -> Text
quote Text
"not set"
    FilterValue
FilterNotNull -> Text -> Text
quote Text
"set"

renderFilter :: Filter -> Text
renderFilter :: Filter -> Text
renderFilter Filter
f =
  Text
"["
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote (Filter -> Text
filterField Filter
f)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote (FilterOperator -> Text
renderFilterOperator (Filter -> FilterOperator
filterOperator Filter
f))
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
","
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilterValue -> Text
renderFilterValue (Filter -> FilterValue
filterValue Filter
f)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Render the filter terms for the URL query string.
renderFilters :: Text -> [Filter] -> Text
renderFilters :: Text -> [Filter] -> Text
renderFilters Text
prefix [Filter]
filters =
  let
    encoded :: [Text]
encoded = (Filter -> Text) -> [Filter] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Filter -> Text
renderFilter [Filter]
filters
    str :: Text
str = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " [Text]
encoded Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
  in
    Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
urlEncode Text
str