Friday, June 26, 2015

Anonymous method overloading

A few weeks ago I learned about Knockout.js which is a very lightweight JavaScript MVVM library. It contains of some basic features which you can read about on their home page if you are interested.

I quickly was amazed how great their concept of observables works (I love design patterns on steroids). However JS is very different from Delphi code so my first version had them declared like this:
type
  IObservable<T> = interface
    function GetValue: T;
    procedure SetValue(const value: T);
    property Value: T read GetValue write SetValue;
  end;
So working with them looked like this:
var
  o: IObservable<Integer>;
begin
  ...
  Writeln(o.Value);
  o.Value := 42;
That worked quite well but especially with more and more of these observables in my viewmodel that .Value all the time became annoying.

Because in JS functions are first class citizens you can treat them differently so in knockout if you call o() it retuns the value of the observable and if you call o(42) is sets the value of the observable.

Could Delphi do the same? We know anonymous methods so we could make our IObservable<T> an anonymous method. But we can make it either a function or a procedure - not both. Yes, we can!

Anonymous methods are implemented as interface. So in fact TFunc<T> is the same as an interface with a method returning T. And that method is called Invoke. We can even inherit interfaces from an anonymous method type making them an anonymous method themselves. However the compiler prevents you from calling a method on them because in Delphi the parentheses are not required for a call. So what if we inherit from TFunc<T> and add an overload to Invoke?

We now have a type that looks like this:
type
  IObservable<T> = interface(TFunc<T>)
    procedure Invoke(const value: T); overload;
  end;
Now we can write code like this:
var
  o: IObservable<Integer>;
begin
  ...
  Writeln(o);
  o(42);
Now that might look a bit strange at first but once you understand the concept this is really amazing.
For more information on my KnockoutJS inspired prototype check out the Knockoff project on Bitbucket. It contains some basic examples and tests to show how the observable dependency tracking works and how they can be used to do binding on UI controls. Though keep in mind that it is only a research project so far - but showing much potential.

Please let me know what you think.

Thursday, May 7, 2015

Extending the Spring4D DI container - lifetime managers

Today we got the request to support TInterfacedPersistent in the DI container.

As you may know TInterfacedPersistence does not do reference counting like TInterfacedObject does - or to be more precise it delegates it to its possible owner. Usually the owner will be nil so it does not do reference counting through its _AddRef and _Release method and often is used for classes that should not do reference counting if you don't want to write your own class (or use Spring.TInterfaceBase for that purpose).

When working with DI your life will be much easier when using interfaces. But if the implementing class is of TInterfacedPersistence you might have a problem - in form of a memory leak. The container will create the instance and unless you have registered it as singleton (which means the container will only ever create one instance and return this whenever asking for it) not hold a reference to this instance. Because of the missing reference counting it will never destroyed if the interface reference goes out of scope.

"Then he needs to implement reference counting into that class" my coworker said, when I told him about that request. Good idea but there are a few problems with that. The _AddRef and _Release methods in TInterfacedPersistence are not virtual so you can only "override" them by implementing IInterface again. "Easy enough!" you might say. Yes, but that will only cause reference counting when you query IInterface from the instance but not any other interface that you implemented (and which you more likely will use than IInterface). So you had to re-implement all the other interfaces as well. This will not only add to the instance size (every implemented interface causes the size of each instance to grow by SizeOf(Pointer) - did you know that?) but might not be possible because some implemented methods could be private which would cause the compiler to complain about a missing implementation of the interface.

So, long story short. If you want to make a class that inherits from TInterfacedPersistent reference counted you have to take another approach - we are talking about a class that you cannot modify for whatever reason: provide an owner that does the reference counting and takes care of destroying it. Usually TInterfacedPersistent looks for the owner in its AfterConstruction method. So what we do is look if FOwnerInterface is not already set and then assign an owner to it - but how, it is private? Fortunately there is a trick using a class helper (also could have used RTTI because that has access to private fields by default) - here is the code:

type
  TInterfacedPersistentHelper = class helper for TInterfacedPersistent
  private type
    TOwner = class(TInterfacedObject)
    private
      FOwnedInstance: TObject;
    protected
      procedure AfterConstruction; override;
    public
      constructor Create(const instance: TInterfacedPersistent);
      destructor Destroy; override;
    end;
  public
    procedure EnableRefCount;
  end;

procedure TInterfacedPersistentHelper.EnableRefCount;
begin
  Assert(not Assigned(Self.FOwnerInterface));
  Self.FOwnerInterface := TOwner.Create(Self);
end;

constructor TInterfacedPersistentHelper.TOwner.Create(
  const instance: TInterfacedPersistent);
begin
  inherited Create;
  FOwnedInstance := instance;
end;

destructor TInterfacedPersistentHelper.TOwner.Destroy;
begin
  FOwnedInstance.Free;
  inherited;
end;

procedure TInterfacedPersistentHelper.TOwner.AfterConstruction;
begin
  // assigning to FOwnerInterface will increment this to 0
  FRefCount := -1;
end;

Now how do we get that into our container? The easiest way would be to use the DelegateTo method in the registration:

container.RegisterType<IFoo, TFoo>.DelegateTo(
  function: TFoo
  begin
    Result := TFoo.Create;
    Result.EnsureRefCount;
  end);

But what if TFoo would require arguments in its constructor? We would need to Resolve them from the container and inject them. But don't we use the container to get rid of all the construction work?

So with a minor refactoring - isn't it great when things are easy to change without breaking the entire thing - I added support for custom lifetime managers - I assume I don't have to explain what they do. Let's write our own for handling our TInterfacedPersistent classes - we inherit from the TTransientLifetimeManager from Spring.Container.LifetimeManager:

type
  TInterfacedPersistentLifetimeManager = class(TTransientLifetimeManager)
  protected
    procedure DoAfterConstruction(const instance: TValue); override;
  end;

procedure TInterfacedPersistentLifetimeManager.DoAfterConstruction(
  const instance: TValue);
begin
  inherited;
  instance.AsType<TInterfacedPersistent>.EnableRefCount;
end;

And now we register our type with it (the API is not yet final the method name might change to something more explicit):

container.RegisterType<IFoo, TFoo>.AsCustom<TInterfacedPersistentLifetimeManager>

Now that is nice already. But what if the container could figure out when a class inherits from TInterfacedPersistent and register this lifetime manager? No problem - we need to add an IBuilderInspector to the container for that purpose. What these do is inspect the registered type for certain aspects (there are built-in ones looking for things like what interfaces does a class implement and register them as services if not already explicitly specified or look for members with special attributes). Ours looks like this:

type
  TInterfacedPersistentBuilderInspector = class(TInterfacedObject, IBuilderInspector)
  protected
    procedure ProcessModel(const kernel: IKernel; const model: TComponentModel);
  end;

procedure TInterfacedPersistentBuilderInspector.ProcessModel(const kernel: IKernel;
  const model: TComponentModel);
begin
  if model.ComponentType.IsInstance
    and model.ComponentType.AsInstance.MetaclassType.InheritsFrom(TInterfacedPersistent)
    and (model.LifetimeType = TLifetimeType.Transient) then
    model.LifetimeManager := TInterfacedPersistentLifetimeManager.Create(model);
end;

And we need to attach that to the container before calling Build (I suggest doing that as the first thing when setting up the container):

container.Kernel.Builder.AddInspector(TInterfacedPersistentBuilderInspector.Create);

But wait, there is more - the container supports so called extensions. These extensions can be attached to the container to add certain behaviors or features (like adding support for decorator detection or changing the way the container selects constructors to create instances). In our case it is really simple as it just adds one component to the container.

type
  TInterfacedPersistentLifetimeExtension = class(TContainerExtension)
  protected
    procedure Initialize; override;
  end;

procedure TInterfacedPersistentLifetimeExtension.Initialize;
begin
  Kernel.Builder.AddInspector(TInterfacedPersistentBuilderInspector.Create);
end;

And attaching the extension is also a one liner.

container.AddExtension<TInterfacedPersistentLifetimeExtension>;

So in the end with one line we can add support for making TInterfacedPersistent classes reference counted for using them in our DI container powered application.

"I love it when a plan comes together" ;)

P.S. with the same technique you can add reference counting to TComponent, by attaching an IVCLComObject interface to it.

Saturday, February 21, 2015

Type less - how to use GExperts macro templates

With all these articles and presentations about the PPL you might have seen this often. Calling TThread.Queue (or TThread.Synchronize if you are doing it wrong ;)) to execute your VCL or FMX related code in the main thread.

Are you still typing this code wasting precious time? Well then this article is for you!

I see this so often in presentations by people that should know better given their many years of Delphi experience. And to be honest - I am guilty of that too. I could spend way less time writing stupid code (with stupid code I usually refer to boilerplate code like this).

Disclaimer: I tried using live templates also but man that sucked and invoking the macro always killed the selection in the code editor.

Open the GExperts macro templates (default shortcut is Shift+Alt+T) and click on configuration.


After you click OK you enter the following code into the editor (with a trailing line break):

TThread.Queue(nil,
  procedure
  begin
    %SELECTION%|
  end);

So it looks like this:


The %SELECTION% tells the macro to insert the selected text here and the pipe tells it to set the cursor to this position after.

Click on OK now and select some source you want to invoke in the main thread.
Press the shortcut for macro templates, type queue and press enter, boom, done.

More time for awesome code or creating more of these templates!
(or to watch funny clips on the internet ...) ;)

Extending the parallel programming library

Recently Robert Love blogged about Exception Management in the PPL (let's please stick to this abbreviation since that is what Embarcadero calls it).

What I was missing though was handling exceptions in fire and forget tasks since you usually don't have some place that calls wait on them just to get the exception being raised.

So I quickly hacked together some stuff to show how to use a feature from the TLP (that's the .NET one): ContinueWith. From its documentation:

Creates a continuation that executes asynchronously when the target Task completes.

Easy enough. We got all the pieces to create this - how this can be done has been shown previously. Too bad he did not make a method of it but hacked it all into a button click event. :(

Did I just hear anyone say: "Hey, that would have been a use-case for an interface helper, right!?" back there? Well, you are right...

Enough talk - let's look at the code. Keep in mind this is just some quick and dirty example to show how to extend TTask in a clean way to add new features. Let's hope they will come out of the box with the next version because continuations on tasks are a must have imho.

unit ThreadingEx;

interface

uses
  SysUtils,
  Threading;

type
  TAction<T> = reference to procedure(const arg: T);

  TTaskContinuationOptions = (
    NotOnCompleted,
    NotOnFaulted,
    NotOnCanceled,
    OnlyOnCompleted,
    OnlyOnFaulted,
    OnlyOnCanceled
  );

  ITaskEx = interface(ITask)
    ['{3AE1A614-27AA-4B5A-BC50-42483650E20D}']
    function GetExceptObj: Exception;
    function GetStatus: TTaskStatus;
    function ContinueWith(const continuationAction: TAction<ITaskEx>;
      continuationOptions: TTaskContinuationOptions): ITaskEx;

    property ExceptObj: Exception read GetExceptObj;
    property Status: TTaskStatus read GetStatus;
  end;

  TTaskEx = class(TTask, ITaskEx)
  private
    fExceptObj: Exception;
    function GetExceptObj: Exception;
  protected
    function ContinueWith(const continuationAction: TAction<ITaskEx>;
      continuationOptions: TTaskContinuationOptions): ITaskEx;
  public
    destructor Destroy; override;

    class function Run(const action: TProc): ITaskEx; static;
  end;

implementation

uses
  Classes;

{ TTaskEx }

function TTaskEx.ContinueWith(const continuationAction: TAction<ITaskEx>;
  continuationOptions: TTaskContinuationOptions): ITaskEx;
begin
  Result := TTaskEx.Run(
    procedure
    var
      task: ITaskEx;
      doContinue: Boolean;
    begin
      task := Self;
      if not IsComplete then
        DoneEvent.WaitFor;
      fExceptObj := GetExceptionObject;
      case continuationOptions of
        NotOnCompleted:  doContinue := GetStatus <> TTaskStatus.Completed;
        NotOnFaulted:    doContinue := GetStatus <> TTaskStatus.Exception;
        NotOnCanceled:   doContinue := GetStatus <> TTaskStatus.Canceled;
        OnlyOnCompleted: doContinue := GetStatus = TTaskStatus.Completed;
        OnlyOnFaulted:   doContinue := GetStatus = TTaskStatus.Exception;
        OnlyOnCanceled:  doContinue := GetStatus = TTaskStatus.Canceled;
      else
        doContinue := False;
      end;
      if doContinue then
        continuationAction(task);
    end);
end;

destructor TTaskEx.Destroy;
begin
  fExceptObj.Free;
  inherited;
end;

function TTaskEx.GetExceptObj: Exception;
begin
  Result := fExceptObj;
end;

class function TTaskEx.Run(const action: TProc): ITaskEx;
var
  task: TTaskEx;
begin
  task := TTaskEx.Create(nil, TNotifyEvent(nil), action, TThreadPool.Default, nil);
  Result := task.Start as ITaskEx;
end;

end.

So what I did is add the ContinueWith method here that takes the delegate that gets executed when the previous task finished with a certain state. I also added properties for the Status and the Exception that might have been raised.

How can this be used?

  TTaskEx.Run(
    procedure
    begin
      Sleep(2000);
      raise EProgrammerNotFound.Create('whoops')
    end)
    .ContinueWith(
    procedure(const t: ITaskEx)
    begin
      TThread.Queue(nil,
        procedure
        begin
          ShowMessage(t.ExceptObj.Message);
        end);
    end, OnlyOnFaulted);

This executes the first task which Sleeps 2 seconds and then raises an exception. This would not only leak memory (!) but also there is no possibility to handle this exception unless you keep a reference to this task and then call Wait somewhere. But this would limit its use very much. Instead we call ContinueWith now passing the error reporting delegate and OnlyOnFaulted in order to execute this only if the previous task had an error.

Easy enough, isn't it?

Saturday, February 7, 2015

TestInsight - unit testing like a pro

The time of teasing is finally over - today I want to show you what I have been working on over the past few weeks:

TestInsight is an IDE plugin for Delphi (supporting XE and up) that will improve your unit test experience. It integrates nicely into your IDE removing the necessity to deal with some external test runner. It runs and presents the results on demand, when saving or continuously whenever you change the code.

Navigating to any test is just a matter of double clicking the test in the results overview.

As I would like you to experience it yourself here is a quick introduction:

After you downloaded and installed TestInsight you can access it from the Delphi main menu ("View -> TestInsight Explorer").

To get your test project running with TestInsight you have to add the TESTINSIGHT define to your project - you can do that by context menu in the project manager:


The second step will be to add the TestInsight client unit to your project. Currently supported frameworks are DUnit, DUnit2 and DUnitX. So let's say you have a project that is using DUnit you have to add the unit TestInsight.DUnit to your project. Calling RunRegisteredTests (as you know from DUnit) of that unit will execute your tests using TestInsight.

So a very basic project file will then look like this:

program MyTests;

uses
  TestInsight.DUnit,
  MyTestCase in 'MyTestCase.pas';

begin
  RunRegisteredTests;
end.

After building your project and hitting run it will report the results to the plugin. That will enable you to run your tests on remote machines or even mobile devices.


Hopefully you don't have errors or warnings in your results. ;) But if you do navigating to the source is just a double click (if you are using madExcept, JclDebug or similar libraries you can even navigate right to the line that caused the error - look into the TestInsight.Client unit on how to enable that)

For an even better TDD experience you can select the clock or disk icon to execute the tests whenever you change the code (after a small configurable idle time) or save it. You can completely focus on the TDD cycle without being interrupted by running the tests manually.


Download the setup here (your browser might complain - "not commonly downloaded..." - but it has been scanned). For more information or reporting issues please visit the official project page.

And also many thanks to my closed beta testers and coworkers that helped me finding many bugs during development.

Thursday, January 29, 2015

New dynamic array type in Spring4D 1.2

Today I want to talk about dynamic arrays. Often you might prefer them over a full blown generic list because it avoids creating an instance just to store a couple of elements (which are backed by a dynamic array inside the list anyway - at least for a regular TList<T> regardless if you use those from the RTL or the Spring4D ones).

But they are tedious to use even with the additional syntax support in Delphi XE7. There are other implementations that improve dynamic array usage that work even for older versions.

Spring4D will introduce the new DynamicArray<T> type which is a record type with several methods and operator overloads (take a look at it in our develop branch on Bitbucket where we are busy implementing a lot of awesome things for Spring4D 1.2 release this spring).

Let's take a quick look at some of the code you can write using the new DynamicArray<T>.

var
  arr, arr2: DynamicArray<Integer>;
  i: Integer;
begin
{$IFDEF DELPHIXE7_UP}
  arr := [1, 2, 3];
  arr := arr + arr;
  arr := arr + [4, 5];
{$ELSE}
  arr.Assign([1, 2, 3]);
  arr.Add(arr);
  arr.Add([4, 5]);
{$ENDIF}
  for i in arr do
    Write(i, ' '); // 1 2 3 1 2 3 4 5
  Writeln;

  arr2.Assign([2, 4]);
  if arr2 in arr then
  begin
    arr := arr - arr2;
    for i in arr do
      Write(i, ' '); // 1 3 1 2 3 5
    Writeln;
  end;

  arr.Assign([1, 2, 3, 4, 5, 6]);
  arr2 := arr.Splice(2, 2, [7, 8, 9]);
  for i in arr2 do
    Write(i, ' '); // 3 4
  Writeln;
  for i in arr do
    Write(i, ' '); // 1 2 7 8 9 5 6
  Writeln;

It will be available in all versions supported (Delphi 2010 and higher) - only the new syntax to initialize a dynamic array (with the square brackets) is limited to XE7 and higher. But DynamicArray<T> has the add operator and even some more that you don't have with native XE7 dynamic arrays. All methods are continuously optimized for performance as far as possible using pure pascal. DynamicArray<T> does not perform any worse than using the native operations - in some situations even better. Of course it is assignment compatible to TArray<T> by implicit operator overload and will run on all platforms.

Until next time with more about Spring4D 1.2 or something different but not any less interesting!

Edit (01.02.2015): renamed TDynArray to DynamicArray<T>

Sunday, January 25, 2015

The Either type for Delphi

In a previous post I talked about the Maybe type that similar to the Nullable type allows you to handle values or the state of having no value in a functional approach.

Today I show you another type that is common in functional programming - the Either type. It allows you to return 2 different types from one function. This could be for example the content of a web request or an error message. In our example we are using similar code as in the previous post and return the result of a division or an error message.

Here is how the function would look like:

function Divide(x, y: Integer): Either<string,Integer>;
begin
  if y = 0 then
    Result := 'Division by zero!'
  else
    Result := x div y;
end;

As you already can imagine Either is a record type with implicit operator overloading making this code look nice and clean. It allows assigning either a string or an integer value. It then sets a flag that says if it's a left or a right. In cases where you use it for returning errors of the action it is common practice to use the right for the correct result and left for some exception/error message.

There are different ways to call this  - and I am afraid I will shock quite some people - one of them involves our beloved with. I know that people went on some crusade against that thing but in this code I find it very convenient.

with Divide(42, 0) do
  case Match of
    IsRight: Writeln(Right);
    IsLeft: ShowError(Left);
  end;

// or

with Divide(42, 0) do
  if Match then
    Writeln(Right)
  else
    ShowError(Left);

// or

Divide(42, 0).Fold(
  procedure(i: integer)
  begin
    Writeln(i);
  end,
  ShowError);

Either has the members Left, Right and Match which is a Boolean. IsRight and IsLeft are just aliases for True and False to make the code clearer. The Fold method takes two anonymous methods of which it calls one depending on if it's a left or right. ShowError is just a small routine I wrote taking a string and writing it to the console to make the code shorter for this example.

Wait a second - don't we have something like that in Delphi already? Yes, its called variant records and it allows something like that. Having a flag field and a dynamic part to store values depending on the flag field. Unfortunately that only works for non nullable value types which renders it pretty useless for this approach.
So finally here is the code for the Either type:

const
  IsLeft = False;
  IsRight = True;

type
  Either<TLeft,TRight> = record
  strict private
    fMatch: Boolean;
    fRight: TRight;
    fLeft: TLeft;
    function GetRight: TRight; inline;
    function GetLeft: TLeft; inline;
  public
    constructor FromLeft(const value: TLeft);
    constructor FromRight(const value: TRight);

    procedure Fold(const right: TProc<TRight>; const left: TProc<TLeft>); overload;
    function Fold<TResult>(const right: TFunc<TRight,TResult>;
      const left: TFunc<TLeft,TResult>): TResult; overload;

    property Match: Boolean read fMatch;
    property Right: TRight read GetRight;
    property Left: TLeft read GetLeft;

    class operator Implicit(const value: TRight): Either<TLeft,TRight>;
    class operator Implicit(const value: TLeft): Either<TLeft,TRight>;
  end;

constructor Either<TLeft, TRight>.FromRight(const value: TRight);
begin
  fRight := value;
  fLeft := Default(TLeft);
  fMatch := IsRight;
end;

constructor Either<TLeft, TRight>.FromLeft(const value: TLeft);
begin
  fLeft := value;
  fRight := Default(TRight);
  fMatch := IsLeft;
end;

procedure Either<TLeft, TRight>.Fold(const right: TProc<TRight>;
  const left: TProc<TLeft>);
begin
  case Match of
    IsRight: right(fRight);
    IsLeft: left(fLeft);
  end;
end;

function Either<TLeft, TRight>.Fold<TResult>(
  const right: TFunc<TRight, TResult>;
  const left: TFunc<TLeft, TResult>): TResult;
begin
  case Match of
    IsRight: Result := right(fRight);
    IsLeft: Result := left(fLeft);
  end;
end;

function Either<TLeft, TRight>.GetRight: TRight;
begin
  case fMatch of
    IsRight: Result := fRight;
    IsLeft: raise EInvalidOpException.Create('Either type has no right value.');
  end;
end;

function Either<TLeft, TRight>.GetLeft: TLeft;
begin
  case fMatch of
    IsRight: raise EInvalidOpException.Create('Either type has no left value.');
    IsLeft: Result := fLeft;
  end;
end;

class operator Either<TLeft, TRight>.Implicit(
  const value: TRight): Either<TLeft, TRight>;
begin
  Result.fRight := value;
  Result.fLeft := Default(TLeft);
  Result.fMatch := IsRight;
end;

class operator Either<TLeft, TRight>.Implicit(
  const value: TLeft): Either<TLeft, TRight>;
begin
  Result.fLeft := value;
  Result.fRight := Default(TRight);
  Result.fMatch := IsLeft;
end;

And finally here is a little teaser of something else I am working on:

Writeln(Divide(42, 3).Fold<string>(
  'Result: ' + i.ToString,
  'Error: ' + s));