1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2014-2018, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(gitty,
   36	  [ gitty_open/2,		% +Store, +Options
   37	    gitty_close/1,		% +Store
   38	    gitty_driver/2,		% +Store, -Driver
   39
   40	    gitty_file/3,		% +Store, ?Name, ?Hash
   41	    gitty_file/4,		% +Store, ?Name, ?Ext, ?Hash
   42	    gitty_create/5,		% +Store, +Name, +Data, +Meta, -Commit
   43	    gitty_update/5,		% +Store, +Name, +Data, +Meta, -Commit
   44	    gitty_commit/3,		% +Store, +Name, -Meta
   45	    gitty_data/4,		% +Store, +Name, -Data, -Meta
   46	    gitty_history/4,		% +Store, +Name, -History, +Options
   47	    gitty_hash/2,		% +Store, ?Hash
   48
   49	    gitty_fsck/1,		% +Store
   50	    gitty_save/4,		% +Store, +Data, +Type, -Hash
   51	    gitty_load/4,		% +Store, +Hash, -Data, -Type
   52
   53	    gitty_reserved_meta/1,	% ?Key
   54	    is_gitty_hash/1,		% @Term
   55
   56	    gitty_diff/4,		% +Store, ?Start, +End, -Diff
   57
   58	    data_diff/3,		% +String1, +String2, -Diff
   59	    udiff_string/2		% +Diff, -String
   60	  ]).   61:- use_module(library(sha)).   62:- use_module(library(lists)).   63:- use_module(library(apply)).   64:- use_module(library(option)).   65:- use_module(library(process)).   66:- use_module(library(debug)).   67:- use_module(library(error)).   68:- use_module(library(filesex)).   69
   70:- if(exists_source(library(bdb))).   71:- use_module(gitty_driver_bdb, []).   72:- endif.   73:- use_module(gitty_driver_files, []).

   99:- dynamic
  100	gitty_store_type/2.		% +Store, -Module

 gitty_open(+Store, +Options) is det

Open a gitty store according to Options. Defined options are:

driver(+Driver)

Backend driver to use. One of files or bdb. When omitted and the store exists, the current store is examined. If the store does not exist, the default is files.

  113gitty_open(Store, Options) :-
  114	(   exists_directory(Store)
  115	->  true
  116	;   existence_error(directory, Store)
  117	),
  118	(   option(driver(Driver), Options)
  119	->  true
  120	;   default_driver(Store, Driver)
  121	),
  122	set_driver(Store, Driver).
  123
  124default_driver(Store, Driver) :-
  125	directory_file_path(Store, ref, RefDir),
  126	exists_directory(RefDir), !,
  127	Driver = files.
  128default_driver(Store, Driver) :-
  129	directory_file_path(Store, heads, RefDir),
  130	exists_file(RefDir), !,
  131	Driver = bdb.
  132default_driver(_, files).
  133
  134set_driver(Store, Driver) :-
  135	must_be(atom, Store),
  136	(   driver_module(Driver, Module)
  137	->  retractall(gitty_store_type(Store, _)),
  138	    asserta(gitty_store_type(Store, Module))
  139	;   domain_error(gitty_driver, Driver)
  140	).
  141
  142driver_module(files, gitty_driver_files).
  143driver_module(bdb,   gitty_driver_bdb).
  144
  145store_driver_module(Store, Module) :-
  146	atom(Store), !,
  147	gitty_store_type(Store, Module).

 gitty_driver(+Store, -Driver)

Get the current gitty driver

  153gitty_driver(Store, Driver) :-
  154	store_driver_module(Store, Module),
  155	driver_module(Driver, Module), !.

 gitty_close(+Store) is det

Close access to the Store.

  161gitty_close(Store) :-
  162	store_driver_module(Store, M),
  163	M:gitty_close(Store).

 gitty_file(+Store, ?Head, ?Hash) is nondet

 gitty_file(+Store, ?Head, ?Ext, ?Hash) is nondet

True when Hash is an entry in the gitty Store and Head is the HEAD revision.

  171gitty_file(Store, Head, Hash) :-
  172	gitty_file(Store, Head, _Ext, Hash).
  173gitty_file(Store, Head, Ext, Hash) :-
  174	store_driver_module(Store, M),
  175	M:gitty_file(Store, Head, Ext, Hash).

 gitty_create(+Store, +Name, +Data, +Meta, -Commit) is det

Create a new object Name from Data and meta information.

Arguments:

Commit

- is a dit describing the new Commit

  183gitty_create(Store, Name, _Data, _Meta, _) :-
  184	gitty_file(Store, Name, _Hash), !,
  185	throw(error(gitty(file_exists(Name)),_)).
  186gitty_create(Store, Name, Data, Meta, CommitRet) :-
  187	save_object(Store, Data, blob, Hash),
  188	get_time(Now),
  189	Commit = gitty{time:Now}.put(Meta)
  190		                .put(_{ name:Name,
  191					data:Hash
  192				      }),
  193	format(string(CommitString), '~q.~n', [Commit]),
  194	save_object(Store, CommitString, commit, CommitHash),
  195	CommitRet = Commit.put(commit, CommitHash),
  196	catch(gitty_update_head(Store, Name, -, CommitHash),
  197	      E,
  198	      ( delete_object(Store, CommitHash),
  199		throw(E))).

 gitty_update(+Store, +Name, +Data, +Meta, -Commit) is det

Update document Name using Data and the given meta information

  205gitty_update(Store, Name, Data, Meta, CommitRet) :-
  206	gitty_file(Store, Name, OldHead),
  207	(   _{previous:OldHead} >:< Meta
  208	->  true
  209	;   throw(error(gitty(commit_version(Name, OldHead, Meta.previous)), _))
  210	),
  211	load_plain_commit(Store, OldHead, OldMeta0),
  212	filter_identity(OldMeta0, OldMeta),
  213	get_time(Now),
  214	save_object(Store, Data, blob, Hash),
  215	Commit = gitty{}.put(OldMeta)
  216			.put(_{time:Now})
  217		        .put(Meta)
  218		        .put(_{ name:Name,
  219				data:Hash,
  220				previous:OldHead
  221			      }),
  222	format(string(CommitString), '~q.~n', [Commit]),
  223	save_object(Store, CommitString, commit, CommitHash),
  224	CommitRet = Commit.put(commit, CommitHash),
  225	catch(gitty_update_head(Store, Name, OldHead, CommitHash),
  226	      E,
  227	      ( delete_object(Store, CommitHash),
  228		throw(E))).

 filter_identity(+Meta0, -Meta)

Remove identification information from the previous commit.

To be done

- : the identity properties should not be hardcoded here.

  236filter_identity(Meta0, Meta) :-
  237	delete_keys([ author,user,avatar,identity,peer,
  238		      external_identity, identity_provider, profile_id,
  239		      commit_message
  240		    ], Meta0, Meta).
  241
  242delete_keys([], Dict, Dict).
  243delete_keys([H|T], Dict0, Dict) :-
  244	del_dict(H, Dict0, _, Dict1), !,
  245	delete_keys(T, Dict1, Dict).
  246delete_keys([_|T], Dict0, Dict) :-
  247	delete_keys(T, Dict0, Dict).

 gitty_update_head(+Store, +Name, +OldCommit, +NewCommit) is det

Update the head of a gitty store for Name. OldCommit is the current head and NewCommit is the new head. If Name is created, and thus there is no head, OldCommit must be -.

This operation can fail because another writer has updated the head. This can both be in-process or another process.

Errors

- gitty(file_exists(Name) if the file already exists

- gitty(not_at_head(Name, OldCommit) if the head was moved by someone else.

  263gitty_update_head(Store, Name, OldCommit, NewCommit) :-
  264	store_driver_module(Store, Module),
  265	Module:gitty_update_head(Store, Name, OldCommit, NewCommit).

 gitty_data(+Store, +NameOrHash, -Data, -Meta) is semidet

Get the data in object Name and its meta-data

  271gitty_data(Store, Name, Data, Meta) :-
  272	gitty_commit(Store, Name, Meta),
  273	load_object(Store, Meta.data, Data).

 gitty_commit(+Store, +NameOrHash, -Meta) is semidet

True if Meta holds the commit data of NameOrHash. A key commit is added to the meta-data to specify the commit hash.

  280gitty_commit(Store, Name, Meta) :-
  281	must_be(atom, Name),
  282	gitty_file(Store, Name, Head), !,
  283	load_commit(Store, Head, Meta).
  284gitty_commit(Store, Hash, Meta) :-
  285	load_commit(Store, Hash, Meta).
  286
  287load_commit(Store, Hash, Meta) :-
  288	load_plain_commit(Store, Hash, Meta0),
  289	Meta1 = Meta0.put(commit, Hash),
  290	(   gitty_file(Store, Meta0.name, Hash)
  291	->  Meta = Meta1.put(symbolic, "HEAD")
  292	;   Meta = Meta1
  293	).
  294
  295load_plain_commit(Store, Hash, Meta) :-
  296	store_driver_module(Store, Module),
  297	Module:load_plain_commit(Store, Hash, Meta).

 gitty_history(+Store, +NameOrHash, -History, +Options) is det

History is a dict holding a key history with a list of dicts representating the history of Name in Store. The toplevel dict also contains skipped, indicating the number of skipped items from the HEAD. Options:

depth(+Depth)

Number of entries in the history. If not present, defaults to 5.

includes(+HASH)

Ensure Hash is included in the history. This means that the history includes the entry with HASH an (depth+1)//2 entries after the requested HASH.

  314gitty_history(Store, Name, json{history:History,skipped:Skipped}, Options) :-
  315	history_hash_start(Store, Name, Hash0),
  316	option(depth(Depth), Options, 5),
  317	(   option(includes(Hash), Options)
  318	->  read_history_to_hash(Store, Hash0, Hash, History00),
  319	    length(History00, Before),
  320	    After is max(Depth-Before, (Depth+1)//2),
  321	    read_history_depth(Store, Hash, After, History1),
  322	    length(History1, AfterLen),
  323	    BeforeLen is Depth - AfterLen,
  324	    list_prefix(BeforeLen, History00, History0),
  325	    length(History00, Len00),
  326	    length(History0, Len0),
  327	    Skipped is Len00-Len0,
  328	    append(History0, History1, History)
  329	;   read_history_depth(Store, Hash0, Depth, History),
  330	    Skipped is 0
  331	).
  332
  333history_hash_start(Store, Name, Hash) :-
  334	gitty_file(Store, Name, Head), !,
  335	Hash = Head.
  336history_hash_start(_, Hash, Hash).
  337
  338
  339read_history_depth(_, _, 0, []) :- !.
  340read_history_depth(Store, Hash, Left, [H|T]) :-
  341	load_commit(Store, Hash, H), !,
  342	Left1 is Left-1,
  343	(   read_history_depth(Store, H.get(previous), Left1, T)
  344	->  true
  345	;   T = []
  346	).
  347read_history_depth(_, _, _, []).

 read_history_to_hash(+Store, +Start, +Upto, -History)

Read the history upto, but NOT including Upto.

  353read_history_to_hash(Store, Hash, Upto, [H|T]) :-
  354	Upto \== Hash,
  355	load_commit(Store, Hash, H),
  356	(   read_history_to_hash(Store, H.get(previous), Upto, T)
  357	->  true
  358	;   T = []
  359	).
  360read_history_to_hash(_, _, _, []).
  361
  362list_prefix(0, _, []) :- !.
  363list_prefix(_, [], []) :- !.
  364list_prefix(N, [H|T0], [H|T]) :-
  365	N2 is N - 1,
  366	list_prefix(N2, T0, T).

 save_object(+Store, +Data:string, +Type, -Hash) is det

Save an object in a git compatible way. Data provides the data as a string.

See also

- http://www.gitguys.com/topics/what-is-the-format-of-a-git-blob/

bug

- We currently delete objects if the head cannot be moved. This can lead to a race condition. We need to leave that to GC.

  379save_object(Store, Data, Type, Hash) :-
  380	size_in_bytes(Data, Size),
  381	format(string(Hdr), '~w ~d\u0000', [Type, Size]),
  382	sha_new_ctx(Ctx0, []),
  383	sha_hash_ctx(Ctx0, Hdr, Ctx1, _),
  384	sha_hash_ctx(Ctx1, Data, _, HashBin),
  385	hash_atom(HashBin, Hash),
  386	store_object(Store, Hash, Hdr, Data).
  387
  388store_object(Store, Hash, Hdr, Data) :-
  389	store_driver_module(Store, Module),
  390	Module:store_object(Store, Hash, Hdr, Data).
  391
  392size_in_bytes(Data, Size) :-
  393	setup_call_cleanup(
  394	    open_null_stream(Out),
  395	    ( format(Out, '~s', [Data]),
  396	      byte_count(Out, Size)
  397	    ),
  398	    close(Out)).

 gitty_fsck(+Store) is det

Check the integrity of store.

  405gitty_fsck(Store) :-
  406	forall(gitty_hash(Store, Hash),
  407	       fsck_object_msg(Store, Hash)),
  408	store_driver_module(Store, M),
  409	M:gitty_fsck(Store).
  410
  411fsck_object_msg(Store, Hash) :-
  412	fsck_object(Store, Hash), !.
  413fsck_object_msg(Store, Hash) :-
  414	print_message(error, gitty(Store, fsck(bad_object(Hash)))).

 fsck_object(+Store, +Hash) is semidet

Test the integrity of object Hash in Store.

  420:- public
  421	fsck_object/2,
  422	check_object/4.  423
  424fsck_object(Store, Hash) :-
  425	load_object(Store, Hash, Data, Type, Size),
  426	check_object(Hash, Data, Type, Size).
  427
  428check_object(Hash, Data, Type, Size) :-
  429	format(string(Hdr), '~w ~d\u0000', [Type, Size]),
  430	sha_new_ctx(Ctx0, []),
  431	sha_hash_ctx(Ctx0, Hdr, Ctx1, _),
  432	sha_hash_ctx(Ctx1, Data, _, HashBin),
  433	hash_atom(HashBin, Hash).

 load_object(+Store, +Hash, -Data) is det

 load_object(+Store, +Hash, -Data, -Type, -Size) is det

Load the given object.

  443load_object(Store, Hash, Data) :-
  444	load_object(Store, Hash, Data, _, _).
  445load_object(Store, Hash, Data, Type, Size) :-
  446	store_driver_module(Store, Module),
  447	Module:load_object(Store, Hash, Data, Type, Size).

 gitty_save(+Store, +Data, +Type, -Hash) is det

 gitty_load(+Store, +Hash, -Data, -Type) is det

Low level objects store. These predicate allows for using the store as an arbitrary content store.

Arguments:

Data	- is a string
Type	- is an atom denoting the object type.

  458gitty_save(Store, Data, Type, Hash) :-
  459	save_object(Store, Data, Type, Hash).
  460gitty_load(Store, Hash, Data, Type) :-
  461	load_object(Store, Hash, Data, Type, _Size).

 gitty_hash(+Store, ?Hash) is nondet

True when Hash is an object in the store.

  467gitty_hash(Store, Hash) :-
  468	store_driver_module(Store, Module),
  469	Module:gitty_hash(Store, Hash).

 delete_object(+Store, +Hash)

Delete an existing object

  475delete_object(Store, Hash) :-
  476	store_driver_module(Store, Module),
  477	Module:delete_object(Store, Hash).

 gitty_reserved_meta(?Key) is nondet

True when Key is a gitty reserved key for the commit meta-data

  483gitty_reserved_meta(name).
  484gitty_reserved_meta(time).
  485gitty_reserved_meta(data).
  486gitty_reserved_meta(previous).

 is_gitty_hash(@Term) is semidet

True if Term is a possible gitty (SHA1) hash

  493is_gitty_hash(SHA1) :-
  494	atom(SHA1),
  495	atom_length(SHA1, 40),
  496	atom_codes(SHA1, Codes),
  497	maplist(hex_digit, Codes).
  498
  499hex_digit(C) :- between(0'0, 0'9, C), !.
  500hex_digit(C) :- between(0'a, 0'f, C).
  501
  502
  503		 /*******************************
  504		 *	    FSCK SUPPORT	*
  505		 *******************************/
  506
  507:- public
  508	delete_object/2,
  509	delete_head/2,
  510	set_head/3.

 delete_head(+Store, +Head) is det

Delete Head from the administration. Used if the head is inconsistent.

  517delete_head(Store, Head) :-
  518	store_driver_module(Store, Module),
  519	Module:delete_head(Store, Head).

 set_head(+Store, +File, +Head) is det

Register Head as the Head hash for File, removing possible old head.

  526set_head(Store, File, Head) :-
  527	store_driver_module(Store, Module),
  528	Module:set_head(Store, File, Head).
  529
  530
  531		 /*******************************
  532		 *	       DIFF		*
  533		 *******************************/

 gitty_diff(+Store, ?Hash1, +FileOrHash2OrData, -Dict) is det

True if Dict representeds the changes in Hash1 to FileOrHash2. If Hash1 is unbound, it is unified with the previous of FileOrHash2. Returns _{initial:true} if Hash1 is unbound and FileOrHash2 is the initial commit. Dict contains:

from:Meta1

to:Meta2

Meta-data for the two diffed versions

data:UDiff

String holding unified diff representation of changes to the data. Only present of data has changed

tags:_312874{added:AddedTags, deleted:DeletedTags}

If tags have changed, the added and deleted ones.

Arguments:

FileOrHash2OrData

- is a file name, hash or a term data(String) to compare a given string with a gitty version.

  555gitty_diff(Store, C1, data(Data2), Dict) :- !,
  556	must_be(atom, C1),
  557	gitty_data(Store, C1, Data1, _Meta1),
  558	(   Data1 \== Data2
  559	->  udiff_string(Data1, Data2, UDIFF),
  560	    Dict = json{data:UDIFF}
  561	;   Dict = json{}
  562	).
  563gitty_diff(Store, C1, C2, Dict) :-
  564	gitty_data(Store, C2, Data2, Meta2),
  565	(   var(C1)
  566	->  C1 = Meta2.get(previous)
  567	;   true
  568	), !,
  569	gitty_data(Store, C1, Data1, Meta1),
  570	Pairs = [ from-Meta1, to-Meta2|_],
  571	(   Data1 \== Data2
  572	->  udiff_string(Data1, Data2, UDIFF),
  573	    memberchk(data-UDIFF, Pairs)
  574	;   true
  575	),
  576	meta_tag_set(Meta1, Tags1),
  577	meta_tag_set(Meta2, Tags2),
  578	(   Tags1 \== Tags2
  579	->  ord_subtract(Tags1, Tags2, Deleted),
  580	    ord_subtract(Tags2, Tags1, Added),
  581	    memberchk(tags-_{added:Added, deleted:Deleted}, Pairs)
  582	;   true
  583	),
  584	once(length(Pairs,_)),			% close list
  585	dict_pairs(Dict, json, Pairs).
  586gitty_diff(_Store, '0000000000000000000000000000000000000000', _C2,
  587	   json{initial:true}).
  588
  589
  590meta_tag_set(Meta, Tags) :-
  591	sort(Meta.get(tags), Tags), !.
  592meta_tag_set(_, []).

 udiff_string(+Data1, +Data2, -UDIFF) is det

Produce a unified difference between two strings. Note that we can avoid one temporary file using diff's - arg and the second by passing =/dev/fd/NNN= on Linux systems. See http://stackoverflow.com/questions/3800202

  601:- if(true).  602
  603% Note that cleanup on possible errors is   rather hard. The created tmp
  604% stream must be closed and the file must  be deleted. We also close the
  605% file before running diff (necessary  on   Windows  to  avoid a sharing
  606% violation). Therefore reclaim_tmp_file/2 first uses   close/2 to close
  607% if not already done and then deletes the file.
  608
  609udiff_string(Data1, Data2, UDIFF) :-
  610	setup_call_cleanup(
  611	    tmp_file_stream(utf8, File1, Tmp1),
  612	    ( save_string(Data1, Tmp1),
  613	      setup_call_cleanup(
  614		  tmp_file_stream(utf8, File2, Tmp2),
  615		  ( save_string(Data2, Tmp2),
  616		    process_diff(File1, File2, UDIFF)
  617		  ),
  618		  reclaim_tmp_file(File2, Tmp2))
  619	    ),
  620	    reclaim_tmp_file(File1, Tmp1)).
  621
  622save_string(String, Stream) :-
  623	call_cleanup(
  624	    format(Stream, '~s', [String]),
  625	    close(Stream)).
  626
  627reclaim_tmp_file(File, Stream) :-
  628	close(Stream, [force(true)]),
  629	delete_file(File).
  630
  631process_diff(File1, File2, String) :-
  632	setup_call_cleanup(
  633	    process_create(path(diff),
  634			   ['-u', file(File1), file(File2)],
  635			   [ stdout(pipe(Out)),
  636			     process(PID)
  637			   ]),
  638	    read_string(Out, _, String),
  639	    ( close(Out),
  640	      process_wait(PID, Status)
  641	    )),
  642	assertion(normal_diff_exit(Status)).
  643
  644normal_diff_exit(exit(0)).		% equal
  645normal_diff_exit(exit(1)).		% different
  646
  647:- else.  648
  649udiff_string(Data1, Data2, UDIFF) :-
  650	data_diff(Data1, Data2, Diffs),
  651	maplist(udiff_string, Diffs, Strings),
  652	atomics_to_string(Strings, UDIFF).
  653
  654:- endif.  655
  656
  657		 /*******************************
  658		 *	   PROLOG DIFF		*
  659		 *******************************/
  660
  661/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  662Attempt at a built-in diff utility. Doing   it in Prolog may seem weird,
  663but is good for tasting  ones  own   dog  food.  In  addition, it avoids
  664temporary files and relatively expensive fork()  calls. As it turns out,
  665implementing an efficient LCS (Longest  Common   Sequence)  in Prolog is
  666rather hard. We'll leave the  code  for   reference,  but  might  seek a
  667different solution for the real thing.  Options are:
  668
  669  - Use external diff after all
  670  - Add a proper Prolog implementation of LCS
  671  - Add LCS in C.
  672- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

 data_diff(+Data1, +Data2, -UDiff) is det

Diff two data strings line-by-line. UDiff is a list of terms of the form below, where L1 and L2 provide the starting line in Data1 and Data2 and S1 and S2 provide the number of affected lines.

udiff(L1,S1,L2,S2,Diff)

Diff is a list holding

+ Line

Line was added to Data1 to get Data2

- Line

Line was deleted from Data1 to get Data2

Line1 - Line2

Line was replaced

=(Line)

Line is identical (context line).

  697data_diff(Data, Data, UDiff) :- !,
  698	UDiff = [].
  699data_diff(Data1, Data2, Diff) :-
  700	split_string(Data1, "\n", "", List1),
  701	split_string(Data2, "\n", "", List2),
  702	list_diff(List1, List2, Diff).
  703
  704list_diff(List1, List2, UDiff) :-
  705	list_lcs(List1, List2, Lcs),
  706	make_diff(List1, List2, Lcs, c(), 1, 1, Diff),
  707	join_diff(Diff, UDiff).

 make_diff(+List1, +List2, +Lcs, +Context0, +Line1, +Line2, -Diff)

  711make_diff([], [], [], _, _, _, []) :- !.
  712make_diff([H|T1], [H|T2], [H|C], c(_,C0,C1), L1, L2, Diff) :- !,
  713	L11 is L1+1,
  714	L21 is L2+1,
  715	make_diff(T1, T2, C, c(C0,C1,H), L11, L21, Diff).
  716make_diff([H|T1], [H|T2], [H|C], C0, L1, L2, Diff) :- !,
  717	L11 is L1+1,
  718	L21 is L2+1,
  719	add_context(C0, H, C1),
  720	(   compound_name_arity(C1, _, L1)
  721	->  Diff = Diff1
  722	;   Diff = [=(H)|Diff1]
  723	),
  724	make_diff(T1, T2, C, C1, L11, L21, Diff1).
  725make_diff([H|T1], [H2|T2], [H|C], C0, L1, L2, [d(L1,L2,C0,+H2)|Diff]) :- !,
  726	L21 is L2+1,
  727	make_diff([H|T1], T2, [H|C], c(), L1, L21, Diff).
  728make_diff([], [H2|T2], [], C0, L1, L2, [d(L1,L2,C0,+H2)|Diff]) :- !,
  729	L21 is L2+1,
  730	make_diff([], T2, [], c(), L1, L21, Diff).
  731make_diff([H1|T1], [H|T2], [H|C], C0, L1, L2, [d(L1,L2,C0,-H1)|Diff]) :- !,
  732	L11 is L1+1,
  733	make_diff(T1, [H|T2], [H|C], c(), L11, L2, Diff).
  734make_diff([H1|T1], [], [], C0, L1, L2, [d(L1,L2,C0,-H1)|Diff]) :- !,
  735	L11 is L1+1,
  736	make_diff(T1, [], [], c(), L11, L2, Diff).
  737make_diff([H1|T1], [H2|T2], C, C0, L1, L2, [d(L1,L2,C0,H1-H2)|Diff]) :- !,
  738	L11 is L1+1,
  739	L21 is L2+1,
  740	make_diff(T1, T2, C, c(), L11, L21, Diff).
  741
  742add_context(c(_,B,C),N,c(B,C,N)).
  743add_context(c(A,B),  N,c(A,B,N)).
  744add_context(c(A),    N,c(A,N)).
  745add_context(c(),     N,c(N)).

 join_diff(+Diff, -UDiff) is det

  749join_diff([], []).
  750join_diff([d(L10,L20,C,L)|T0], [udiff(L1,S1,L2,S2,Diff)|T]) :-
  751	pre_context(C, S0, Diff, [L|DiffT]),
  752	L1 is L10-S0,
  753	L2 is L20-S0,
  754	diff_affected(L,S10,S20),
  755	S11 is S10+S0,
  756	S21 is S20+S0,
  757	collect_diff(T0,S11,S21,S1,S2,0,DiffT,T1),
  758	join_diff(T1, T).
  759
  760pre_context(c(),      0, L, L).
  761pre_context(c(A),     1, [=(A)|L], L).
  762pre_context(c(A,B),   2, [=(A),=(B)|L], L).
  763pre_context(c(A,B,C), 3, [=(A),=(B),=(C)|L], L).
  764
  765collect_diff([d(_,_,_,L)|T0], S10,S20,S1,S2,C,[L|Diff],T) :-
  766	C < 3, !,
  767	diff_affected(L,S1x,S2x),
  768	S11 is S10+S1x,
  769	S21 is S20+S2x,
  770	collect_diff(T0,S11,S21,S1,S2,0,Diff,T).
  771collect_diff([=(L)|T0], S10,S20,S1,S2,C0,[=(L)|Diff],T) :- !,
  772	S11 is S10+1,
  773	S21 is S20+1,
  774	C1 is C0+1,
  775	collect_diff(T0,S11,S21,S1,S2,C1,Diff,T).
  776collect_diff(T,S1,S2,S1,S2,_,[],T).
  777
  778diff_affected(+(_),   0, 1).
  779diff_affected(-(_),   0, 1).
  780diff_affected(-(_,_), 1, 1).

 udiff_string(+UDiff, -String) is det

True when String is the string representation of UDiff.

  786udiff_string(udiff(L1,S1,L2,S2,Diff), Final) :-
  787	format(string(Hdr), '@@ -~d,~d +~d,~d @@', [L1,S1,L2,S2]),
  788	udiff_blocks(Diff, Blocks),
  789	maplist(block_lines, Blocks, LineSets),
  790	append(LineSets, Lines),
  791	atomics_to_string([Hdr|Lines], "\n", Final).
  792
  793block_lines(=(U), Lines) :- maplist(string_concat(' '), U, Lines).
  794block_lines(+(U), Lines) :- maplist(string_concat('+'), U, Lines).
  795block_lines(-(U), Lines) :- maplist(string_concat('-'), U, Lines).
  796
  797udiff_blocks([], []) :- !.
  798udiff_blocks([=(H)|T0], [=([H|E])|T]) :- !,
  799	udiff_cp(T0, E, T1),
  800	udiff_blocks(T1, T).
  801udiff_blocks(U, List) :-
  802	udiff_block(U, D, A, T1),
  803	udiff_add(D,A,List,ListT),
  804	udiff_blocks(T1, ListT).
  805
  806udiff_add([],A,[+A|T],T) :- !.
  807udiff_add(D,[],[-D|T],T) :- !.
  808udiff_add(D,A,[-D,+A|T],T).
  809
  810udiff_cp([=(H)|T0], [H|E], T) :- !,
  811	udiff_cp(T0, E, T).
  812udiff_cp(L, [], L).
  813
  814udiff_block([-L|T], [L|D], A, Rest) :- !,
  815	udiff_block(T, D, A, Rest).
  816udiff_block([+L|T], D, [L|A], Rest) :- !,
  817	udiff_block(T, D, A, Rest).
  818udiff_block([L1-L2|T], [L1|D], [L2|A], Rest) :- !,
  819	udiff_block(T, D, A, Rest).
  820udiff_block(T, [], [], T).

 list_lcs(+List1, +List2, -Lcs) is det

To be done

- Too slow. See http://wordaligned.org/articles/longest-common-subsequence

  826:- thread_local lcs_db/2.  827
  828list_lcs([], [], []) :- !.
  829list_lcs([H|L1], [H|L2], [H|Lcs]) :- !,
  830	list_lcs(L1, L2, Lcs).
  831list_lcs(List1, List2, Lcs) :-
  832	reverse(List1, Rev1),
  833	reverse(List2, Rev2),
  834	copy_prefix(Rev1, Rev2, RevDiff1, RevDiff2, RevLcs, RevT),
  835	list_lcs2(RevDiff1, RevDiff2, RevT),
  836	reverse(RevLcs, Lcs).
  837
  838list_lcs2(List1, List2, Lcs) :-
  839	variant_sha1(List1+List2, Hash),
  840	call_cleanup(
  841	    lcs(List1, List2, Hash, Lcs),
  842	    retractall(lcs_db(_,_))).
  843
  844copy_prefix([H|T1], [H|T2], L1, L2, [H|L], LT) :- !,
  845	copy_prefix(T1, T2, L1, L2, L, LT).
  846copy_prefix(R1, R2, R1, R2, L, L).
  847
  848
  849lcs(_,_,Hash,Lcs) :-
  850	lcs_db(Hash,Lcs), !.
  851lcs([H|L1], [H|L2], _, [H|Lcs]) :- !,
  852	variant_sha1(L1+L2,Hash),
  853	lcs(L1, L2, Hash, Lcs).
  854lcs(List1, List2, Hash, Lcs) :-
  855	List1 = [H1|L1],
  856	List2 = [H2|L2],
  857	variant_sha1(L1+[H2|L2],Hash1),
  858	variant_sha1([H1|L1]+L2,Hash2),
  859	lcs(    L1 , [H2|L2], Hash1, Lcs1),
  860	lcs([H1|L1],     L2 , Hash2, Lcs2),
  861	longest(Lcs1, Lcs2, Lcs),!,
  862	asserta(lcs_db(Hash, Lcs)).
  863lcs(_,_,_,[]).
  864
  865longest(L1, L2, Longest) :-
  866	length(L1, Length1),
  867	length(L2, Length2),
  868	(   Length1 > Length2
  869	->  Longest = L1
  870	;   Longest = L2
  871	).
  872
  873		 /*******************************
  874		 *	      MESSAGES		*
  875		 *******************************/
  876:- multifile
  877	prolog:error_message//1.  878
  879prolog:error_message(gitty(not_at_head(Name, _OldCommit))) -->
  880	[ 'Gitty: cannot update head for "~w" because it was \c
  881	   updated by someone else'-[Name] ].
  882prolog:error_message(gitty(file_exists(Name))) -->
  883	[ 'Gitty: File exists: ~p'-[Name] ].
  884prolog:error_message(gitty(commit_version(Name, _Head, _Previous))) -->
  885	[ 'Gitty: ~p: cannot update (modified by someone else)'-[Name] ]