{-# 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.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.Internal.Network
import Web.Bugzilla.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 True  = "true"
  fvAsText False = "false"

instance FieldType a => FieldType [a] where
  fvAsText :: [a] -> Text
fvAsText = Text -> [Text] -> Text
T.intercalate "," ([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

-- | 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 t :: Int
t k :: Char
k v :: 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 t :: Int
t f :: Field a
f o :: Text
o v :: b
v = [Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t 'f' (Field a -> Text
forall a. Field a -> Text
searchFieldName Field a
f),
                     Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t 'o' Text
o,
                     Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t 'v' (b -> Text
forall a. FieldType a => a -> Text
fvAsText b
v)]

evalSearchTerm :: Int -> SearchTerm -> [QueryPart]
evalSearchTerm :: Int -> SearchTerm -> [QueryPart]
evalSearchTerm t :: Int
t (UnaryOp op :: Text
op field :: 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 ("" :: T.Text)
evalSearchTerm t :: Int
t (BinaryOp op :: Text
op field :: Field a
field val :: 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

evalSearchExpr :: SearchExpression -> [QueryPart]
evalSearchExpr :: SearchExpression -> [QueryPart]
evalSearchExpr e :: 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' 1 SearchExpression
e
  where
    evalExprGroup :: Int -> [SearchExpression] -> (Int, [QueryPart])
    evalExprGroup :: Int -> [SearchExpression] -> (Int, [QueryPart])
evalExprGroup t :: Int
t es :: [SearchExpression]
es =
      let (subExprT :: Int
subExprT, subExprQs :: [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
+ 1, []) [SearchExpression]
es
          qs :: [QueryPart]
qs = Int -> Char -> Text -> QueryPart
taggedQueryPart Int
t 'f' "OP" QueryPart -> [QueryPart] -> [QueryPart]
forall a. a -> [a] -> [a]
:
               Int -> Char -> Text -> QueryPart
taggedQueryPart Int
subExprT 'f' "CP" QueryPart -> [QueryPart] -> [QueryPart]
forall a. a -> [a] -> [a]
:
               [QueryPart]
subExprQs
      in (Int
subExprT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, [QueryPart]
qs)

    evalSubExpr :: (Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart])
    evalSubExpr :: (Int, [QueryPart]) -> SearchExpression -> (Int, [QueryPart])
evalSubExpr (t :: Int
t, qs :: [QueryPart]
qs) expr :: SearchExpression
expr = let (nextT :: Int
nextT, qs' :: [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' t :: Int
t (And es :: [SearchExpression]
es) = Int -> [SearchExpression] -> (Int, [QueryPart])
evalExprGroup Int
t [SearchExpression]
es

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

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

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