(**************************************************************************)
(*  Copyright © 2009 Stéphane Glondu <steph@glondu.net>                   *)
(*                                                                        *)
(*  This program is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Affero General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version, with the additional   *)
(*  exemption that compiling, linking, and/or using OpenSSL is allowed.   *)
(*                                                                        *)
(*  This program is distributed in the hope that it will be useful, but   *)
(*  WITHOUT ANY WARRANTY; without even the implied warranty of            *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU     *)
(*  Affero General Public License for more details.                       *)
(*                                                                        *)
(*  You should have received a copy of the GNU Affero General Public      *)
(*  License along with this program.  If not, see                         *)
(*  <http://www.gnu.org/licenses/>.                                       *)
(**************************************************************************)

open Printf
open Error
open Types
open Core
open Common

type t = Types.expr

let rec simplify query =
  match query with
  | EMatch (field, EString package) ->
      let packages = Core.simple_split '|' package in
      let packages = List.map Re.Pcre.quote packages in
      let r_string = String.concat "|" packages in
      let rex =
        Re.Pcre.regexp (Printf.sprintf "(^| )(%s)\\s*([,(:<]|$)" r_string)
      in
      EMatch (field, ERegexp (package, rex))
  | EMatch (_, (EDep _ | ERegexp _)) -> query
  | Etrue | Efalse | ESource | EVersion _ | EString _ | ERegexp _ | EDep _ ->
      query
  | EMatch (f, e) -> EMatch (f, simplify e)
  | EList l -> (
      match l with
      | [] -> Etrue
      | h :: [] -> simplify h
      | _ :: _ -> EList (List.map simplify l))
  | ENot e -> (
      match simplify e with Etrue -> Efalse | Efalse -> Etrue | e -> ENot e)
  | EOr (e1, e2) -> (
      match (simplify e1, simplify e2) with
      | Efalse, e | e, Efalse -> e
      | Etrue, _ | _, Etrue -> Etrue
      | e1, e2 -> EOr (e1, e2))
  | EAnd (e1, e2) -> (
      match (simplify e1, simplify e2) with
      | Efalse, _ | _, Efalse -> Efalse
      | Etrue, e | e, Etrue -> e
      | e1, e2 -> EAnd (e1, e2))

let of_expr x = simplify x

let of_string s =
  let lexbuf = Lexing.from_string s in
  try simplify (Parser.full_expr Lexer.token lexbuf)
  with Parser.Error ->
    let pos = Lexing.lexeme_start_p lexbuf in
    raise
      (Parsing_error
         ( s,
           false,
           pos.Lexing.pos_lnum,
           pos.Lexing.pos_cnum - pos.Lexing.pos_bol ))

let parens show expr = if show then sprintf "(%s)" expr else expr

let rec to_string_b ?(escape = true) last_op = function
  | EMatch (f, ERegexp r) -> sprintf ".%s ~ %s" f (string_of_regexp r)
  | ENot e -> sprintf "!%s" (to_string_b "!" e)
  | Etrue -> sprintf "true"
  | Efalse -> sprintf "false"
  | EAnd (e1, e2) ->
      parens
        (last_op <> "&" && last_op <> "")
        (sprintf "%s & %s" (to_string_b "&" e1) (to_string_b "&" e2))
  | EOr (e1, e2) ->
      parens
        (last_op <> "|" && last_op <> "")
        (sprintf "%s | %s" (to_string_b "|" e1) (to_string_b "|" e2))
  | EList xs ->
      sprintf "[%s]" (String.concat "; " (List.map (to_string_b "") xs))
  | ESource -> "source"
  | EString x -> string_of_string escape x
  | EVersion (cmp, x) ->
      parens (last_op <> "") (sprintf ".%s \"%s\"" (string_of_cmp cmp) x)
  | EMatch (field, EDep (package, cmp, ref_version)) ->
      parens (last_op <> "")
        (sprintf ".%s ~ \"%s\" %s \"%s\"" field package (string_of_cmp cmp)
           ref_version)
  | EMatch (field, EString package) ->
      parens (last_op <> "") (sprintf ".%s ~ \"%s\"" field package)
  | _ -> raise (Unexpected_expression "<unable to convert to string>")

let to_string ?(escape = true) = to_string_b ~escape ""

let eval (type a) (kind : a Package.kind) (pkg : a Package.t) =
  let rec eval = function
    | EMatch (field, ERegexp (_, rex)) -> (
        try
          let value = Package.get field pkg in
          ignore (Re.Pcre.exec ~rex value);
          true
        with Not_found -> false)
    | Etrue -> true
    | Efalse -> false
    | ESource -> ( match kind with Source -> true | _ -> false)
    | EOr (e1, e2) -> eval e1 || eval e2
    | EAnd (e1, e2) -> eval e1 && eval e2
    | ENot e -> not (eval e)
    | EVersion (cmp, ref_version) ->
        let value = Package.get "version" pkg in
        Debian_version.compare_predicate cmp value ref_version
    | EMatch (field, EDep (package, cmp, refv)) ->
        let deps = Package.dependencies field pkg in
        List.exists
          (fun x ->
            x.Package.dep_name = package
            &&
            match x.Package.dep_version with
            | None -> false
            | Some (rcmp, rrefv) -> (
                match (rcmp, cmp) with
                | Ge, Ge | Gt, Ge | Gt, Gt ->
                    Debian_version.compare rrefv refv >= 0
                | Ge, Gt -> Debian_version.compare rrefv refv > 0
                | _, _ -> false (* FIXME: missing cases *)))
          deps
    | EMatch (field, EString package) -> (
        try
          let deps = Package.dependencies field pkg in
          List.exists (fun x -> x.Package.dep_name = package) deps
        with Not_found -> false)
    | x -> raise (Unexpected_expression (to_string x))
  in
  eval

let eval_source x = eval Source x
let eval_binary x = eval Binary x

let rec fields accu = function
  | EMatch (f, _) -> StringSet.add f accu
  | ENot e -> fields accu e
  | Etrue | Efalse -> accu
  | EAnd (e1, e2) | EOr (e1, e2) -> fields (fields accu e1) e2
  | EList xs -> List.fold_left fields accu xs
  | ESource | EString _ | ERegexp _ | EDep _ -> accu
  | EVersion _ -> StringSet.add "version" accu
