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, []).   74
   75
   76/** <module> Single-file GIT like version system
   77
   78This library provides a first implementation  of a lightweight versioned
   79file store with dynamic meta-data. The   store  is partly modelled after
   80GIT. Like GIT, it uses  a  content-based   store.  In  fact,  the stored
   81objects are compatible  with  GIT.  Unlike   GIT  though,  there  are no
   82_trees_.  Each  entry  (file)  has  its  own  history.  Each  commit  is
   83associated  with  a  dict  that  can  carry  aribitrary  meta-data.  The
   84following fields are reserved for gitties bookkeeping:
   85
   86  - name:Name
   87  Name of the entry (file)
   88  - time:TimeStamp
   89  Float representing when the object was added to the store
   90  - data:Hash
   91  Object hash of the contents
   92  - previous:Hash
   93  Hash of the previous commit.
   94
   95The key =commit= is reserved and returned   as  part of the meta-data of
   96the newly created (gitty_create/5) or updated object (gitty_update/5).
   97*/
   98
   99:- dynamic
  100	gitty_store_type/2.		% +Store, -Module
  101
  102%%	gitty_open(+Store, +Options) is det.
  103%
  104%	Open a gitty store according to Options.  Defined
  105%	options are:
  106%
  107%	  - driver(+Driver)
  108%	  Backend driver to use.  One of =files= or =bdb=.  When
  109%	  omitted and the store exists, the current store is
  110%	  examined.  If the store does not exist, the default
  111%	  is =files=.
  112
  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).
  148
  149%!	gitty_driver(+Store, -Driver)
  150%
  151%	Get the current gitty driver
  152
  153gitty_driver(Store, Driver) :-
  154	store_driver_module(Store, Module),
  155	driver_module(Driver, Module), !.
  156
  157%%	gitty_close(+Store) is det.
  158%
  159%	Close access to the Store.
  160
  161gitty_close(Store) :-
  162	store_driver_module(Store, M),
  163	M:gitty_close(Store).
  164
  165%%	gitty_file(+Store, ?Head, ?Hash) is nondet.
  166%%	gitty_file(+Store, ?Head, ?Ext, ?Hash) is nondet.
  167%
  168%	True when Hash is an entry in the gitty Store and Head is the
  169%	HEAD revision.
  170
  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).
  176
  177%%	gitty_create(+Store, +Name, +Data, +Meta, -Commit) is det.
  178%
  179%	Create a new object Name from Data and meta information.
  180%
  181%	@arg Commit is a dit describing the new Commit
  182
  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))).
  200
  201%%	gitty_update(+Store, +Name, +Data, +Meta, -Commit) is det.
  202%
  203%	Update document Name using Data and the given meta information
  204
  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))).
  229
  230%!	filter_identity(+Meta0, -Meta)
  231%
  232%	Remove identification information  from   the  previous  commit.
  233%
  234%	@tbd: the identity properties should not be hardcoded here.
  235
  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).
  248
  249
  250%%	gitty_update_head(+Store, +Name, +OldCommit, +NewCommit) is det.
  251%
  252%	Update the head of a gitty  store   for  Name.  OldCommit is the
  253%	current head and NewCommit is the new  head. If Name is created,
  254%	and thus there is no head, OldCommit must be `-`.
  255%
  256%	This operation can fail because another   writer has updated the
  257%	head.  This can both be in-process or another process.
  258%
  259%	@error gitty(file_exists(Name) if the file already exists
  260%	@error gitty(not_at_head(Name, OldCommit) if the head was moved
  261%	       by someone else.
  262
  263gitty_update_head(Store, Name, OldCommit, NewCommit) :-
  264	store_driver_module(Store, Module),
  265	Module:gitty_update_head(Store, Name, OldCommit, NewCommit).
  266
  267%%	gitty_data(+Store, +NameOrHash, -Data, -Meta) is semidet.
  268%
  269%	Get the data in object Name and its meta-data
  270
  271gitty_data(Store, Name, Data, Meta) :-
  272	gitty_commit(Store, Name, Meta),
  273	load_object(Store, Meta.data, Data).
  274
  275%%	gitty_commit(+Store, +NameOrHash, -Meta) is semidet.
  276%
  277%	True if Meta holds the commit data of NameOrHash. A key =commit=
  278%	is added to the meta-data to specify the commit hash.
  279
  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).
  298
  299%%	gitty_history(+Store, +NameOrHash, -History, +Options) is det.
  300%
  301%	History is a dict holding a key   `history` with a list of dicts
  302%	representating the history of Name in   Store. The toplevel dict
  303%	also contains `skipped`, indicating the  number of skipped items
  304%	from the HEAD. Options:
  305%
  306%	  - depth(+Depth)
  307%	  Number of entries in the history.  If not present, defaults
  308%	  to 5.
  309%	  - includes(+HASH)
  310%	  Ensure Hash is included in the history.  This means that the
  311%	  history includes the entry with HASH an (depth+1)//2 entries
  312%	  after the requested HASH.
  313
  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(_, _, _, []).
  348
  349%%	read_history_to_hash(+Store, +Start, +Upto, -History)
  350%
  351%	Read the history upto, but NOT including Upto.
  352
  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).
  367
  368
  369%%	save_object(+Store, +Data:string, +Type, -Hash) is det.
  370%
  371%	Save an object in a git compatible   way. Data provides the data
  372%	as a string.
  373%
  374%	@see http://www.gitguys.com/topics/what-is-the-format-of-a-git-blob/
  375%	@bug We currently delete objects if the head cannot be moved.
  376%	This can lead to a race condition.   We need to leave that
  377%	to GC.
  378
  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)).
  399
  400
  401%!	gitty_fsck(+Store) is det.
  402%
  403%	Check the integrity of store.
  404
  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)))).
  415
  416%%	fsck_object(+Store, +Hash) is semidet.
  417%
  418%	Test the integrity of object Hash in Store.
  419
  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).
  434
  435
  436
  437
  438%%	load_object(+Store, +Hash, -Data) is det.
  439%%	load_object(+Store, +Hash, -Data, -Type, -Size) is det.
  440%
  441%	Load the given object.
  442
  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).
  448
  449%!	gitty_save(+Store, +Data, +Type, -Hash) is det.
  450%!	gitty_load(+Store, +Hash, -Data, -Type) is det.
  451%
  452%	Low level objects store. These predicate   allows  for using the
  453%	store as an arbitrary content store.
  454%
  455%	@arg Data is a string
  456%	@arg Type is an atom denoting the object type.
  457
  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).
  462
  463%%	gitty_hash(+Store, ?Hash) is nondet.
  464%
  465%	True when Hash is an object in the store.
  466
  467gitty_hash(Store, Hash) :-
  468	store_driver_module(Store, Module),
  469	Module:gitty_hash(Store, Hash).
  470
  471%%	delete_object(+Store, +Hash)
  472%
  473%	Delete an existing object
  474
  475delete_object(Store, Hash) :-
  476	store_driver_module(Store, Module),
  477	Module:delete_object(Store, Hash).
  478
  479%%	gitty_reserved_meta(?Key) is nondet.
  480%
  481%	True when Key is a gitty reserved key for the commit meta-data
  482
  483gitty_reserved_meta(name).
  484gitty_reserved_meta(time).
  485gitty_reserved_meta(data).
  486gitty_reserved_meta(previous).
  487
  488
  489%%	is_gitty_hash(@Term) is semidet.
  490%
  491%	True if Term is a possible gitty (SHA1) hash
  492
  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.  511
  512%%	delete_head(+Store, +Head) is det.
  513%
  514%	Delete Head from the administration.  Used if the head is
  515%	inconsistent.
  516
  517delete_head(Store, Head) :-
  518	store_driver_module(Store, Module),
  519	Module:delete_head(Store, Head).
  520
  521%%	set_head(+Store, +File, +Head) is det.
  522%
  523%	Register Head as the Head hash for File, removing possible
  524%	old head.
  525
  526set_head(Store, File, Head) :-
  527	store_driver_module(Store, Module),
  528	Module:set_head(Store, File, Head).
  529
  530
  531		 /*******************************
  532		 *	       DIFF		*
  533		 *******************************/
  534
  535%%	gitty_diff(+Store, ?Hash1, +FileOrHash2OrData, -Dict) is det.
  536%
  537%	True if Dict representeds the changes   in Hash1 to FileOrHash2.
  538%	If Hash1 is unbound,  it  is   unified  with  the  `previous` of
  539%	FileOrHash2. Returns _{initial:true} if  Hash1   is  unbound and
  540%	FileOrHash2 is the initial commit.  Dict contains:
  541%
  542%	  - from:Meta1
  543%	  - to:Meta2
  544%	  Meta-data for the two diffed versions
  545%	  - data:UDiff
  546%	  String holding unified diff representation of changes to the
  547%	  data.  Only present of data has changed
  548%	  - tags:_{added:AddedTags, deleted:DeletedTags}
  549%	  If tags have changed, the added and deleted ones.
  550%
  551%	@arg	FileOrHash2OrData is a file name, hash or a term
  552%		data(String) to compare a given string with a
  553%		gitty version.
  554
  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(_, []).
  593
  594%%	udiff_string(+Data1, +Data2, -UDIFF) is det.
  595%
  596%	Produce a unified difference between two   strings. Note that we
  597%	can avoid one temporary file using diff's `-` arg and the second
  598%	by    passing    =/dev/fd/NNN=    on    Linux    systems.    See
  599%	http://stackoverflow.com/questions/3800202
  600
  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- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  673
  674
  675%%	data_diff(+Data1, +Data2, -UDiff) is det.
  676%
  677%	Diff two data strings line-by-line. UDiff is  a list of terms of
  678%	the form below, where `L1` and `L2` provide the starting line in
  679%	Data1 and Data2 and `S1` and `S2` provide the number of affected
  680%	lines.
  681%
  682%	  ==
  683%	  udiff(L1,S1,L2,S2,Diff)
  684%	  ==
  685%
  686%	`Diff` is a list holding
  687%
  688%	  - +(Line)
  689%	  Line was added to Data1 to get Data2
  690%	  - -(Line)
  691%	  Line was deleted from Data1 to get Data2
  692%	  - -(Line1,Line2)
  693%	  Line was replaced
  694%	  - =(Line)
  695%	  Line is identical (context line).
  696
  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).
  708
  709%%	make_diff(+List1, +List2, +Lcs, +Context0, +Line1, +Line2, -Diff)
  710
  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)).
  746
  747%%	join_diff(+Diff, -UDiff) is det.
  748
  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).
  781
  782%%	udiff_string(+UDiff, -String) is det.
  783%
  784%	True when String is the string representation of UDiff.
  785
  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).
  821
  822%%	list_lcs(+List1, +List2, -Lcs) is det.
  823%
  824%	@tbd	Too slow.  See http://wordaligned.org/articles/longest-common-subsequence
  825
  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] ]