Experimental prolog records-handling library.

records.prolog

:- use_module(library(lists)).

construct(Fields, Record)
    :- Record =.. [record | Fields]
    .

% synonym
%
make --> construct.
build --> destruct.

% for use in DCG notation to get fields from a record
%
destruct(Record, Fields)
    :- construct(Fields, Record)
    .

is_assignment(_ = _).

% unifies wildcards in Query with values from Record
%
% inst:
%  - make([x = 1, y = 2], Point), query([x = X], Point), write(X).
%   will write 1.
%
%  - make([x = 1, y = 2], Point), query([z = Z], Point), write(Z).
%   will fail.
%
query(Single, Record)
    :-  is_assignment(Single)

    ,   query([Single], Record)
    .

query(Query, Record)
    :- construct(Fields, Record)
    ,  zip_with_unify(Query, Fields)
    .

% for use in DCG notation to unify some query before continuing
%
query(Query, Record, Record) 
    :- query(Query, Record)
    .
% inst:
%  - make([x = 1, y = 2], P), update([y = 3, z = 7], P, NewP), write(NewP).
%   will write record(z=7,y=3,x=1).
%
update(Single)
    --> { is_assignment(Single) }
        
    ,   update([Single])
    .

update(Query)
    --> destruct
    ,   zip_with_update(Query)
    ,   construct
    .

% will fill wildcards in query and remove it from record
%
% inst:
%  - make([x = 1, y = 2], P), split([y = Y], P, NewP), write((Y, NewP)).
%   will write 2,record(x=1).
%
split(Single)
    --> { is_assignment(Single) }

    ,   split([Single])
    .

split(Query)
    --> query(Query)
    ,   remove(Query)
    .

remove(Single) 
    --> { is_assignment(Single) }

    ,   remove([Single])
    .

remove(Query)
    --> destruct
    ,   flip_subtract(Query)
    ,   construct
    .

remove_existing(Query)
    --> query(Query)
    ,   remove(Query)
    .

merge(Record)
    --> { destruct(Record, Fields) }
    ,   update(Fields)
    .

flip_subtract(A, B, C) 
    :- subtract(B, A, C)
    .

zip_with_update(List) 
    --> { maplist(forget, List, Cleaned) }

    ,   foldl(flip_delete, Cleaned)
    ,   foldl(flip_append, List)
    .

forget(Name = _, Name = _).

flip_delete(A, B, C) :- delete(B, A, C).
flip_append(A, B, C) :- C = [A | B].

zip_with_unify([], _).

zip_with_unify([X | Xs], Ys) 
    :- member(X, Ys)
    ,  zip_with_unify(Xs, Ys)
    .

die(Message) 
    :- format(Message)
    , !
    , fail
    .

%%%%

chain(List) --> foldl(run, List).

run(Action, I, O)
    :-  apply(Action, [I, O])
    .

is_transformation(_ -> _).

check(Any) 
    --> modify(Any)
    ,   the_same
    .

modify(Single)
    --> { is_transformation(Single) } 
    ,   modify([Single])
    .

modify(List) 
    --> foldl(single_modify, List)
    ,   !
    .

single_modify((I, O) -> (Action))
    --> query(I)
    ,   { !, apply(Action, []) }
    ,   update(O)
    .

single_modify(Names -> Action)
    --> { apply(Action, []) }
    ,   !
    ,   update(Names)
    .

zip_into_query(As, Bs, Cs)
    :- maplist(is_equation, As, Bs, Cs)
    .

is_equation(A, B, A = B).

do_shit
    --> modify([
            ( [x = X, y = Y]
            , [distance = D, huistance = H]
            ) 
            ->  ( D is sqrt(X * X + Y * Y)
                , H is      X + Y
                )
        ])
    .

% gabarite_box: Figure -> (Point -> GabariteBox)
%
gabarite_box(Figure)
    --> { query(
            [ type   = circle
            , radius = R
            ]
            , Figure) 
        }
    ,   split([x = X, y = Y])
    ,   modify([
        ([left = Left, top = Top, right = Right, down = Down]) ->
            ( Left  is X - R
            , Right is X + R
            , Top   is Y - R
            , Down  is Y + R
            )
    ])
    .

gabarite_box(Figure)
    --> { query(
            [ type   = rect
            , width  = W
            , height = H
            ]
            , Figure) 
        }
    ,   split([x = X, y = Y])
    ,   modify([
        ([left = Left, top = Top, right = Right, down = Down]) ->
            ( Left  is X - W
            , Right is X + W
            , Top   is Y - H
            , Down  is Y + H
            )
    ])
    .

test_gabarite_box
    :-  build(Pivot,  [x = 5, y = 9])
    ,   build(Circle, [type = circle, radius = 5])
    ,   build(Rect,   [type = rect,   width  = 10, height = 4])

    ,   gabarite_box(Circle, Pivot, CircleBox)
    ,   gabarite_box(Rect,   Pivot, RectBox)

    ,   format("~w~n~w~n", [CircleBox, RectBox])
    .

test_shit
    :- Actions = [make, do_shit]
    ,  chain(Actions, [x = 3, y = 4], Result)
    ,  write(Result)
    .

dump(Msg, X, X)
    :-  format("~s: ~w~n", [Msg, X])
    .

the_same(R1, R2)
    :-  destruct(R1, Fs1)
    ,   destruct(R2, Fs2)

    ,   msort(Fs1, Sorted)
    ,   msort(Fs2, Sorted)
    .