{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Operators which can be used to construct queries for Bugzilla.
--   These operators are intended to be typesafe: you should not be
--   able to construct a query that causes Bugzilla to return an
--   error. If you *are* able to construct an erroneous query, please
--   report a bug.
module Web.Bugzilla.RedHat.Internal.Search
( FieldType
, SearchTerm (..)
, SearchExpression (..)
, evalSearchExpr
) where

import Data.List
import qualified Data.Text as T
import Data.Time.Clock (UTCTime(..))
import Data.Time.ISO8601 (formatISO8601)

import Web.Bugzilla.RedHat.Internal.Network
import Web.Bugzilla.RedHat.Internal.Types

class FieldType a where fvAsText :: a -> T.Text

instance FieldType T.Text where fvAsText :: Text -> Text
fvAsText = Text -> Text
forall a. a -> a
id
instance FieldType Int where fvAsText :: Int -> Text
fvAsText = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
instance FieldType UTCTime where fvAsText :: UTCTime -> Text
fvAsText = String -> Text
T.pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> String
formatISO8601

instance FieldType Bool where
  fvAsText :: Bool -> Text
fvAsText Bool
True  = Text
"true"
  fvAsText Bool
False = Text
"false"

instance FieldType a => FieldType [a] where
  fvAsText :: [a] -> Text
fvAsText = Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. FieldType a => a -> Text
fvAsText

data SearchTerm where
  UnaryOp  :: FieldType a => T.Text -> Field a -> SearchTerm
  BinaryOp :: (FieldType a, FieldType b) => T.Text -> Field a -> b -> SearchTerm
  EqTerm   :: (FieldType a, FieldType b) => Field a -> b -> SearchTerm

-- | A Boolean expression which can be used to query Bugzilla.
data SearchExpression
  = And [SearchExpression]
  | Or [SearchExpression]
  | Not SearchExpression
  | Term SearchTerm

taggedQueryPart :: Int -> Char -> T.Text -> QueryPart
taggedQueryPart :: Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t Char
k Text
v = (Char -> Text -> Text
T.cons Char
k (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int
t, Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v)

termQuery :: FieldType b => Int -> Field a -> T.Text -> b -> [QueryPart]
termQuery :: Int -> Field a -> Text -> b -> [QueryPart]
termQuery Int
t Field a
f Text
o b
v = [Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t Char
'f' (Field a -> Text
forall a. Field a -> Text
searchFieldName Field a
f),
                     Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t Char
'o' Text
o,
                     Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t Char
'v' (b -> Text
forall a. FieldType a => a -> Text
fvAsText b
v)]

evalSearchTerm :: Int -> SearchTerm -> [QueryPart]
evalSearchTerm :: Int -> SearchTerm -> [QueryPart]
evalSearchTerm Int
t (UnaryOp Text
op Field a
field)          = Int -> Field a -> Text -> Text -> [QueryPart]
forall b a.
FieldType b =>
Int -> Field a -> Text -> b -> [QueryPart]
termQuery Int
t Field a
field Text
op (Text
"" :: T.Text)
evalSearchTerm Int
t (BinaryOp Text
op Field a
field b
val)     = Int -> Field a -> Text -> b -> [QueryPart]
forall b a.
FieldType b =>
Int -> Field a -> Text -> b -> [QueryPart]
termQuery Int
t Field a
field Text
op b
val
evalSearchTerm Int
_ (EqTerm Field a
field b
val)          = [(Field a -> Text
forall a. Field a -> Text
searchFieldName Field a
field, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (b -> Text) -> b -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Text
forall a. FieldType a => a -> Text
fvAsText (b -> Maybe Text) -> b -> Maybe Text
forall a b. (a -> b) -> a -> b
$ b
val)]

evalSearchExpr :: SearchExpression -> [QueryPart]
evalSearchExpr :: SearchExpression -> [QueryPart]
evalSearchExpr SearchExpression
e = (Int, [QueryPart]) -> [QueryPart]
forall a b. (a, b) -> b
snd ((Int, [QueryPart]) -> [QueryPart])
-> (Int, [QueryPart]) -> [QueryPart]
forall a b. (a -> b) -> a -> b
$ Int -> SearchExpression -> (Int, [QueryPart])
evalSearchExpr' Int
1 SearchExpression
e
  where
    evalExprGroup :: Int -> [SearchExpression] -> (Int, [QueryPart])
    evalExprGroup :: Int -> [SearchExpression] -> (Int, [QueryPart])
evalExprGroup Int
t [SearchExpression]
es =
      let (Int
subExprT, [QueryPart]
subExprQs) = ((Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart]))
-> (Int, [QueryPart]) -> [SearchExpression] -> (Int, [QueryPart])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart])
evalSubExpr (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, []) [SearchExpression]
es
          qs :: [QueryPart]
qs = Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t Char
'f' Text
"OP" QueryPart -> [QueryPart] -> [QueryPart]
forall a. a -> [a] -> [a]
:
               Int -> Char -> Text -> QueryPart
taggedQueryPart Int
subExprT Char
'f' Text
"CP" QueryPart -> [QueryPart] -> [QueryPart]
forall a. a -> [a] -> [a]
:
               [QueryPart]
subExprQs
      in (Int
subExprT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [QueryPart]
qs)

    evalSubExpr :: (Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart])
    evalSubExpr :: (Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart])
evalSubExpr (Int
t, [QueryPart]
qs) SearchExpression
expr = let (Int
nextT, [QueryPart]
qs') = Int -> SearchExpression -> (Int, [QueryPart])
evalSearchExpr' Int
t SearchExpression
expr
                               in  (Int
nextT, [QueryPart]
qs [QueryPart] -> [QueryPart] -> [QueryPart]
forall a. [a] -> [a] -> [a]
++ [QueryPart]
qs')

    evalSearchExpr' :: Int -> SearchExpression -> (Int, [QueryPart])
    evalSearchExpr' :: Int -> SearchExpression -> (Int, [QueryPart])
evalSearchExpr' Int
t (And [SearchExpression]
es) = Int -> [SearchExpression] -> (Int, [QueryPart])
evalExprGroup Int
t [SearchExpression]
es

    evalSearchExpr' Int
t (Or [SearchExpression]
es) =
      let (Int
groupT, [QueryPart]
groupQs) = Int -> [SearchExpression] -> (Int, [QueryPart])
evalExprGroup Int
t [SearchExpression]
es
          qs :: [QueryPart]
qs = Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t Char
'j' Text
"OR" QueryPart -> [QueryPart] -> [QueryPart]
forall a. a -> [a] -> [a]
: [QueryPart]
groupQs
      in (Int
groupT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [QueryPart]
qs)

    evalSearchExpr' Int
t (Not SearchExpression
es) =
      let (Int
groupT, [QueryPart]
groupQs) = Int -> SearchExpression -> (Int, [QueryPart])
evalSearchExpr' Int
t SearchExpression
es
          qs :: [QueryPart]
qs = Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t Char
'n' Text
"1" QueryPart -> [QueryPart] -> [QueryPart]
forall a. a -> [a] -> [a]
: [QueryPart]
groupQs
      in (Int
groupT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, [QueryPart]
qs)

    evalSearchExpr' Int
t (Term SearchTerm
term) = (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int -> SearchTerm -> [QueryPart]
evalSearchTerm Int
t SearchTerm
term)