{-------------------------------------------------------------------------------
 
 Copyright (c) 1999-2021 Ralf Junker, Yunqa
 Internet: https://www.yunqa.de
 E-Mail:   delphi@yunqa.de

-------------------------------------------------------------------------------}

unit DISQLite3Fts5Tokenizer;

{$I DICompilers.inc}
{$I DISQLite3.inc}

interface

uses
  DISystemCompat,
  {$IFDEF HAS_UNITSCOPE}
  System.SysUtils,
  {$ELSE HAS_UNIT_SCOPE}
  SysUtils,
  {$ENDIF HAS_UNIT_SCOPE}
  DISQLite3Types, DISQLite3Api
  {$IFDEF YuStemmer}, YuStemmer{$ENDIF}
  ;

function sqlite3_fts5_simple_tokenizer_init(
  const Fts5Api: fts5_api_ptr;
  const Name: Utf8String = 'simple'): C_int;

{$IFDEF YuStemmer}

type

  sqlite3_fts5_stemmer_option = (

    soFreeStemmer);

  sqlite3_fts5_stemmer_options = set of sqlite3_fts5_stemmer_option;

const

  DEFAULT_SQLITE3_FTS5_STEMMER_OPTION = [soFreeStemmer];

function sqlite3_fts5_stemmer_tokenizer_init(
  const Fts5Api: fts5_api_ptr;
  const Name: Utf8String;
  const Stemmer: TYuStemmer_8;
  const Options: sqlite3_fts5_stemmer_options = DEFAULT_SQLITE3_FTS5_STEMMER_OPTION): C_int;

{$ENDIF YuStemmer}

implementation

procedure fts5SimpleDelete(pTokenizer: Fts5Tokenizer_ptr);
begin

end;

function fts5SimpleCreate(pCtx: C_void_ptr; const azArg: C_char_ptr_array_ptr;
  nArg: C_int; ppOut: Fts5Tokenizer_ptr_ptr): C_int;
begin
  ppOut^ := nil;
  Result := SQLITE_OK;
end;

function fts5SimpleTokenize(
  pTokenizer: Fts5Tokenizer_ptr; pCtx: C_void_ptr; Flags: C_int;
  const pText: C_char_ptr; nText: C_int;
  xToken: fts5_tokenizer_xTokenize_xToken): C_int;
const

  TOKEN_CHARS = ['0'..'9', 'A'..'Z', 'a'..'z'];
var
  p, pStart: C_char_ptr;
begin
  Result := SQLITE_OK;

  p := pText;
  repeat
    while (nText > 0) and (p^ < #$80) and not (p^ in TOKEN_CHARS) do
      begin Inc(p); Dec(nText); end;

    pStart := p;
    while (nText > 0) and ((p^ >= #$80) or (p^ in TOKEN_CHARS)) do
      begin Inc(p); Dec(nText); end;

    if pStart = p then Break;

    Result := xToken(pCtx, 0, pStart, p - pStart, pStart - pText, p - pText);
  until Result <> SQLITE_OK;

  if Result = SQLITE_DONE then
    Result := SQLITE_OK;
end;

function sqlite3_fts5_simple_tokenizer_init(const Fts5Api: fts5_api_ptr;
  const Name: Utf8String = 'simple'): C_int;
const
  SIMPLE_TOKENIZER: fts5_tokenizer = (
    xCreate: fts5SimpleCreate;
    xDelete: fts5SimpleDelete;
    xTokenize: fts5SimpleTokenize);
begin
  Assert(Assigned(Fts5Api));

  Result := Fts5Api^.xCreateTokenizer(Fts5Api, C_char_ptr(Name),
    nil, @SIMPLE_TOKENIZER, nil);
end;

{$IFDEF YuStemmer}

type
  StemmerTokenizer = record
    ParentTok: fts5_tokenizer;
    pParentTok: Fts5Tokenizer_ptr;
    Stemmer: TYuStemmer_8;
  end;
  StemmerTokenizer_ptr = ^StemmerTokenizer;

procedure fts5StemmerDelete(pTokenizer: Fts5Tokenizer_ptr);
var
  StemTok: StemmerTokenizer_ptr;
begin
  StemTok := StemmerTokenizer_ptr(pTokenizer);
  if Assigned(StemTok) then
    begin
      if Assigned(StemTok^.pParentTok) then
        StemTok^.ParentTok.xDelete(StemTok.pParentTok);
      sqlite3_free(StemTok);
    end;
end;

type
  StemmerCreateCtx = record
    Fts5Api: fts5_api_ptr;
    Options: sqlite3_fts5_stemmer_options;
    Stemmer: TYuStemmer_8;
  end;
  StemmerCreateCtx_ptr = ^StemmerCreateCtx;

function fts5StemmerCreate(pCtx: C_void_ptr; const azArg: C_char_ptr_array_ptr;
  nArg: C_int; ppOut: Fts5Tokenizer_ptr_ptr): C_int;
label
  lblFail;
var
  azArg2: C_char_ptr_array_ptr; nArg2: C_int;
  ParentCtx: C_void_ptr;
  StemCreateCtx: StemmerCreateCtx_ptr;
  StemTok: StemmerTokenizer_ptr;
  zBase: C_char_ptr;
begin
  Assert(Assigned(pCtx));
  StemCreateCtx := pCtx;

  zBase := 'unicode61';
  if nArg > 0 then
    zBase := azArg[0];

  StemTok := sqlite3_malloc(SizeOf(StemTok^));
  if not Assigned(StemTok) then
    begin Result := SQLITE_NOMEM; Exit; end;

  FillChar(StemTok^, SizeOf(StemTok^), 0);
  Result := StemCreateCtx^.Fts5Api^.xFindTokenizer(
    StemCreateCtx^.Fts5Api, zBase, @ParentCtx, @StemTok^.ParentTok);
  if Result <> SQLITE_OK then goto lblFail;

  nArg2 := nArg;
  if nArg2 > 0 then Dec(nArg2);
  if nArg2 > 0 then azArg2 := C_char_ptr_array_ptr(@azArg[1]) else azArg2 := nil;

  Result := StemTok^.ParentTok.xCreate(
    ParentCtx, azArg2, nArg2, @StemTok^.pParentTok);
  if Result <> SQLITE_OK then
    begin lblFail: fts5StemmerDelete(Fts5Tokenizer_ptr(StemTok)); Exit; end;

  StemTok^.Stemmer := StemCreateCtx^.Stemmer;

  ppOut^ := Fts5Tokenizer_ptr(StemTok);
end;

type
  StemmerCbCtx = record
    OrigCtx: C_void_ptr;
    Stemmer: TYuStemmer_8;
    xToken: fts5_tokenizer_xTokenize_xToken;
  end;
  StemmerCbCtx_ptr = ^StemmerCbCtx;

function fts5StemmerCb(
  pCtx: C_void_ptr; tflags: C_int;
  const pToken: C_char_ptr; nToken: C_int;
  iStart: C_int; iEnd: C_int): C_int;
var
  StemCbCtx: StemmerCbCtx_ptr;
  pTokenCopy: PUtf8Char; nTokenCopy: Integer;
begin
  StemCbCtx := StemmerCbCtx_ptr(pCtx);
  pTokenCopy := pToken; nTokenCopy := nToken;
  StemCbCtx^.Stemmer.Stem(pTokenCopy, nTokenCopy);
  Result := StemCbCtx^.xToken(StemCbCtx^.OrigCtx, 0,
    pTokenCopy, nTokenCopy, iStart, iEnd);
end;

function fts5StemmerTokenize(
  pTokenizer: Fts5Tokenizer_ptr; pCtx: C_void_ptr; Flags: C_int;
  const pText: C_char_ptr; nText: C_int;
  xToken: fts5_tokenizer_xTokenize_xToken): C_int;
var
  StemTok: StemmerTokenizer_ptr;
  StemCbCtx: StemmerCbCtx;
begin
  StemTok := StemmerTokenizer_ptr(pTokenizer);

  StemCbCtx.OrigCtx := pCtx;
  StemCbCtx.Stemmer := StemTok^.Stemmer;
  StemCbCtx.xToken := xToken;
  Result := StemTok^.ParentTok.xTokenize(
    StemTok^.pParentTok, @StemCbCtx, 0, pText, nText, fts5StemmerCb);
end;

procedure fts5StemmerDestroy(p: C_void_ptr);
var
  StemCreateCtx: StemmerCreateCtx_ptr;
begin
  StemCreateCtx := p;
  if soFreeStemmer in StemCreateCtx^.Options then
    StemCreateCtx^.Stemmer.Free;
  sqlite3_free(StemCreateCtx);
end;

function sqlite3_fts5_stemmer_tokenizer_init(const Fts5Api: fts5_api_ptr;
  const Name: Utf8String; const Stemmer: TYuStemmer_8;
  const Options: sqlite3_fts5_stemmer_options = DEFAULT_SQLITE3_FTS5_STEMMER_OPTION): C_int;
const
  STEMMER_TOKENIZER: fts5_tokenizer = (
    xCreate: fts5StemmerCreate;
    xDelete: fts5StemmerDelete;
    xTokenize: fts5StemmerTokenize);
var
  StemCreateCtx: StemmerCreateCtx_ptr;
begin
  Assert(Assigned(Fts5Api));

  StemCreateCtx := sqlite3_malloc(SizeOf(StemCreateCtx^));
  StemCreateCtx^.Fts5Api := Fts5Api;
  StemCreateCtx.Stemmer := Stemmer;
  StemCreateCtx.Options := Options;

  Result := Fts5Api^.xCreateTokenizer(Fts5Api, C_char_ptr(Name),
    StemCreateCtx, @STEMMER_TOKENIZER, fts5StemmerDestroy);
end;

{$ENDIF YuStemmer}

end.

