unit derror;
//
//  How to use this library:
//    1. Declare integer consts with possible error starting at 1
//    2. Declare some var Error of TError in "state" object
//    3. Call Exit(SetupError(@Error, ERROR_CONST_NAME, 'error description'))
//

{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH RESULT}

interface

const
  OK = 0;

type
PError = ^TError;
TError = object
  Id: LongInt;
  Msg: AnsiString;
  constructor Init;
  destructor Done; virtual;
  procedure Reset;
  function Setup(_Id: LongInt; const _Msg: AnsiString; InternalError: PError = nil): Boolean;
end;

function SetupError(Error: PError; _Id: LongInt; const _Msg: AnsiString; InternalError: PError = nil): Boolean;
function SetupOK(Error: PError): Boolean;
procedure HaltIfError(Error: PError);

implementation

constructor TError.Init;
begin
  Reset;
end;

destructor TError.Done;
begin
  Msg := '';
end;

procedure TError.Reset;
begin
  Setup(OK, 'No error', nil);
end;

function TError.Setup(_Id: LongInt; const _Msg: AnsiString; InternalError: PError = nil): Boolean;
begin
  Id := _Id;
  if InternalError <> nil then begin
    Msg := _Msg + ': ' + InternalError^.Msg;
  end else
    Msg := _Msg;
  Result := Id = OK;
end;

function SetupError(Error: PError; _Id: LongInt; const _Msg: AnsiString; InternalError: PError = nil): Boolean;
begin
  if Error <> nil then begin
    Result := Error^.Setup(_Id, _Msg, InternalError);
  end else
    Result := _Id = OK;
end;

function SetupOK(Error: PError): Boolean;
begin
  if Error <> nil then begin
    Result := True;
    Error^.Id := OK;
    Error^.Msg := '';
  end;
  Exit(True);
end;

procedure HaltIfError(Error: PError);
begin
  if (Error <> nil) and (Error^.Id <> OK) then begin
    Writeln(stderr, Error^.Msg);
    Halt(Error^.Id);
  end;
end;

end.
