1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%    Authors:       Nicos Angelopoulos
    3%    E-mail:        Nicos Angelopoulos http://stoics.org.uk/~nicos/sware/contact.html
    4%    Copyright (C): Nicos Angelopoulos, 2015-2024
    5%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    6/*
    7   This program is free software; you can redistribute it and/or
    8    modify it under the terms of the MIT license
    9
   10    This program is distributed in the hope that it will be useful,
   11    but WITHOUT ANY WARRANTY; without even the implied warranty of
   12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
   13
   14*/
   15:- module( bio_db, [
   16                % This interface has now being split according to 
   17                % biological organisms, see files in cell/
   18                % 1. housekeeping:
   19                % bio_db/0,
   20                bio_db_close/1,
   21                bio_db_db_predicate/1,
   22                bio_db_data_predicate/4,
   23                bio_db_info/2,
   24                bio_db_info/3,
   25                bio_db_info/4,
   26                bio_db_interface/1,
   27                bio_db_interface/2,
   28                bio_db_install/2, bio_db_install/3,
   29                bio_db_organism/1, bio_db_organism/2, bio_db_organism/3,
   30                bio_db_organism_alias/2,
   31                bio_db_org_in_opts/2,
   32                bio_db_paths/0,
   33                bio_db_source/2,
   34                bio_db_version/2,
   35                bio_db_citation/2,
   36                bio_db_close_connections/0,
   37                % 2 derived
   38                % A.symbols
   39                is_symbol/2,
   40                ncbi_symb/3,
   41                % B. gene ontology
   42                go_id/2,          % +/-Go, -/+Int
   43                go_id/3,          % +GoOrInt, -Go, -Int
   44                % C. string edges
   45                org_edge_strg_symb/4  % ?Org, ?Symb1, ?Symb2, -W
   46             ] ).   47
   48:- dynamic( bio_db_handle/5 ).   49
   50:- dynamic( '$bio_db_handle'/2 ). % this is needed for the asserted server preds 
   51
   52
   53% auto-load (& other system) libraries
   54:- use_module(library(lists)).   55:- use_module(library(apply)).   56:- use_module(library(debug)).     % /1,3.
   57:- use_module(library(archive)).   % archive_extract/3.
   58:- use_module(library(filesex)).   59
   60:- use_module(library(lib)).   61
   62:- ensure_loaded('../src/bio_db_data_predicate').   63
   64:- lib(source(bio_db), homonyms(true)).   65
   66:- lib(stoics_lib:date_two_digit_dotted/1).   67:- lib(go_id/2).   68:- lib(is_symbol/2).   69:- lib(ncbi_symb/3).   70:- lib(org_edge_strg_symb/4).   71:- lib(bio_db_org_in_opts/2).   72:- lib(end(bio_db)).   73
   74% :- initialization( lib(& bio_db, load_main(false)), after_load ).
   75:- initialization( lib(@(bio_db)), after_load ).
 bio_db_organism(?Org)
Colloquial name for organisms supported by bio_db.

Human is considered the default organism and returned first.

?- bio_db_organism(Org).
Org = human ;
Org = chicken ;
Org = mouse ;
Org = multi ;
Org = pig.
author
- nicos angelopoulos
version
- 0:2 2019/4/8
- 0:3 2022/12/29, changed to colloquials and added chicken, were hs and mouse.
- 0:4 2023/6/3, added pig

*/

   99bio_db_organism(human).      % defaulty
  100bio_db_organism(chicken).    % 2022/12/21
  101bio_db_organism(mouse).
  102bio_db_organism(multi).      % 2023/9/15
  103bio_db_organism(pig).        % 2023/6/2
 bio_db_organism(?KnownAs, ?Canon)
 bio_db_organism(?KnownAs, ?Token, ?Canon)
Canon is the canonical, colloquial, representation of organism KnownAs and Token is a 4 letter bio_db representation of that organism.

KnownAs is either a known colloquial name tabled in bio_db_organism/1, an alias to an organism or an organism token. Token is the token used in bio_db predicate, file and directory names for this organism.

?- bio_db_organism(KnownAs,Org), write(KnownAs:Org), nl, fail.
hs:human
gallus:chicken
gallus_gallus:chicken
gg6a:chicken
human:human
chicken:chicken
mouse:mouse
galg:chicken
homs:human
musm:mouse
suss:pig
mult:multi

?- bio_db_organism(hs, Org).
Org = human.

?- bio_db_organism(KnownAs, Token, human).
KnownAs = hs,
Token = homs ;
KnownAs = human,
Token = homs ;
KnownAs = Token, Token = homs.

?- hgnc_homs_symb_hgnc( 'LMTK3', Hgnc ).
Hgnc = 19295.
author
- nicos angelopoulos
version
- 0.2 2019/5/2
- 0.3 2022/12/25, added /3 version, and added many aliases

*/

  148bio_db_organism( Alias, Org ) :-
  149     bio_db_organism( Alias, _Token, Org ).
  150
  151bio_db_organism( Alias, Token, Org ) :-
  152    ( ground(Alias) -> Backtrack = false; Backtrack = true ),
  153    bio_db_organism_alias( Alias, Org ),
  154    ( Backtrack == false -> !; true ),
  155    bio_db_organism_token( Org, Token ).
  156bio_db_organism( Org, Token, Canon ) :-
  157    ( ground(Org) -> Backtrack = false; Backtrack = true ),
  158    bio_db_organism( Org ),
  159    bio_db_organism_token( Org, Token ),
  160    ( Backtrack == false -> !; true ),
  161    Canon = Org.
  162bio_db_organism( TokenIs, Token, Canon ) :-
  163    ( ground(TokenIs) -> Backtrack = false; Backtrack = true ),
  164    bio_db_organism_token( Canon, TokenIs ),
  165    ( Backtrack == false -> !; true ),
  166    Token = TokenIs.
  167
  168bio_db_organism_known( A, T, O ) :-
  169     bio_db_organism( A, T, O ),
  170     !.
  171bio_db_organism_known( A, T, O ) :-
  172     throw( un_known(bio_db_organism(A,T,O)) ).
  173     
  174
  175bio_db_organism_token(chicken, galg).
  176bio_db_organism_token(  human, homs).
  177bio_db_organism_token(  mouse, musm).
  178bio_db_organism_token(  multi, mult).
  179bio_db_organism_token(    pig, suss).
 bio_db_organism_alias(?Alias, -Org)
Alias is a known and supported alternative name for the canonical Org name for an organism.
?- bio_db_organism_alias( human, hs ).
true.

Note this used to be bio_db_organism/2 which has now (19.05.02) changed.

author
- nicos angelopoulos
version
- 0:1 2019/5/2
- 0:2 2022/12/20, gallus also known as chicken and gallus_gallus */
  197bio_db_organism_alias( hs, human ).
  198bio_db_organism_alias( gallus, chicken ).
  199bio_db_organism_alias( gallus_gallus, chicken ).
  200bio_db_organism_alias( gg6a, chicken ).
  201
  202% this search path can be added to requires
  203% bio_db_map/2,
  204% ncbi_homs_ensp_unip/2,
  205% ncbi_homs_ensp_ensg/2,
  206
  207/* was:
  208bio_db_interface_atom( prolog ).
  209bio_db_interface_atom( prosqlite ).
  210bio_db_interface_atom( berkeley ).
  211*/
  212bio_db_interface_atom( Iface ) :-
  213    bio_db_interface_extensions( Iface, _ ).
  214
  215bio_db_interface_initialisation( null ). % so it exists, fixme: should nt this be prolog ?
  216bio_db_interface_initialisation( prosqlite ) :-
  217    use_module( library(prosqlite) ).
  218bio_db_interface_initialisation( berkeley ) :-
  219    use_module( library(bdb) ).
  220bio_db_interface_initialisation( rocks ) :-
  221    use_module( library(rocksdb) ).
  222
  223bio_db_default_interface( prolog ).
  224
  225:- Opts = [access(read_write),type(atom),keep(true)],
  226   bio_db_default_interface( Def ),
  227   create_prolog_flag( bio_db_interface, Def, Opts ).  228
  229:- Opts = [access(read_write),type(atom),keep(true)],
  230   create_prolog_flag( bio_db_pl_from_zip, user, Opts ).  % true/false/user
  231
  232:- Opts = [access(read_write),type(atom),keep(true)],
  233   create_prolog_flag( bio_db_del_zip, user, Opts ).  % true/false/user, only asked for pl files
  234
  235:- use_module( library(lib) ).  236:- lib( source(bio_db), homonyms(true) ).  237
  238:- lib(options).  239:- lib(pack_errors).  240
  241:- lib(stoics_lib:at_con/3).  242:- lib(stoics_lib:portray_clauses/2).  243:- lib(stoics_lib:url_file/3).  244:- lib(stoics_lib:message_report/3).  245
  246:- lib(ui_yes_no/5).  247:- lib(bio_db_map/2).  248:- ensure_loaded('../auxil/build_repo/lib/bio_db_pl_info').   % /2.
  249:- lib(end(bio_db)).  250
  251stoics( 'https://stoics.org.uk/~nicos/sware/packs/bio_db_repo/data' ).

Access, use and manage big, biological datasets.

Bio_db gives access to pre-packed biological databases and simplifies management and translation of biological data to Prolog friendly formats.

There are currently 2 major types of data supported: maps, and graphs. Maps define product mappings, translations and memberships, while graphs define interactions which can be visualised as weighed graphs (see bio_db_data_predicate/4 for a full list of statically generated list of bio_db data predicates).

There are 2 prolog flags (see current_prolog_flag/2) that can control the behaviour of the library: bio_db_qcompile (def: true) and bio_db_interface (def: prolog). When the first one is set to false, it can disable the compilation to

Bio_db itself does include any of the datasets. You can either download the separate pack(bio_db_repo) which contains all of the Prolog datasets or let pack(bio_db) download the data file one at the time- as needed. As of version v4.4 there are 144 associated data predicates serving 76398976 records.

This pack can be installed as per usual via

?- pack(bio_db_repo).

However, please note this will download all available tables (zipped) with a total download of 477Mb (v4.4). The first time a table is interrogated it is unzipped ot the .pl version and the interpreter automatically also create a .qlf. When the all the tables have been access at least once, the pack will take around 6.3Gb (v4.4).

If you do not want to install all datasets, you should not install the pack as above. Instead pack(bio_db) will download individual data tables the first time you try to access some of its data. Auto-downloading works transparently to the user, where a data set is downloaded by simply calling the predicate.

For example

?- hgnc_homs_symb_hgnc( 'LMTK3', Hgnc ).
% prolog DB:table hgnc:hgnc_homs_symb_hgnc/2 is not installed, do you want to download (Y/n) ?
% Trying to get: url_file(http://www.stoics.org.uk/bio_db_repo/data/maps/hgnc/hgnc_homs_symb_hgnc.pl,/usr/local/users/nicos/local/git/test_bio_db/data/maps/hgnc/hgnc_homs_symb_hgnc.pl)
% Loading prolog db: /usr/local/users/nicos/local/git/test_bio_db/data/maps/hgnc/hgnc_homs_symb_hgnc.pl
Hgnc = 19295.

?- bio_db_interface( prosqlite ).
% Setting bio_db_interface prolog_flag, to: prosqlite
true.

?- hgnc_homs_prev_symb( Prv, Symb ).
% prosqlite DB:table hgnc:hgnc_homs_prev_symb/2 is not installed, do you want to download (Y/n) ?
% Trying to get: url_file(http://www.stoics.org.uk/bio_db_repo/data/maps/hgnc/hgnc_homs_prev_symb.sqlite,/usr/local/users/nicos/local/git/test_bio_db/data/maps/hgnc/hgnc_homs_prev_symb.sqlite)
false.

?- hgnc_homs_prev_symb( Prv, Symb ).
% prosqlite DB:table hgnc:hgnc_homs_prev_symb/2 is not installed, do you want to download (Y/n) ?
% Trying to get: url_file(http://www.stoics.org.uk/bio_db_repo/data/maps/hgnc/hgnc_homs_prev_symb.sqlite,/usr/local/users/nicos/local/git/test_bio_db/data/maps/hgnc/hgnc_homs_prev_symb.sqlite)
% Loading prosqlite db: /usr/local/users/nicos/local/git/test_bio_db/data/maps/hgnc/hgnc_homs_prev_symb.sqlite
Prv = 'A1BG-AS',
Symb = 'A1BG-AS1' .

See bio_db_data_predicate/4 for a way to enumerate all data predicates. The source of which is in src/bio_db_data_predicate.pl which also includes in the comments the cell structure.

As of version 2.0 bio_db is formed of a number of hierarchically organised cells that can be loaded independently. This is because there now too many predicates and is also a devise for better supporting organism specific data. There are currently two main cells, hs (human) and mouse. Each sub-celled by data source of origin.

?- use_module(library(bio_db)).

Loads the whole interface (all cells), without the user needing to be aware of anything. The only difference is that the user will not be able to see all the module predicates at the first line of file pack(bio_db/prolog/bio_db.pl)).

?- lib(bio_db).

Also loads everything.

?- lib(& bio_db).

Loads the skeleton of the module (cells usually laod the module dependencies like this).

?- lib(& bio_db(hs)).

Loads hs cell (and skeleton). hs comprises of a number of sub-cells.

?- lib(& bio_db(hs(hgnc))).

Loads the hs/hgnc primary cell (and the skeleton).

In both the above loads, the following becomes available, however, the former load also loads additional predicates for human, but non hgnc based.

?- hgnc_homs_hgnc_symb( Hgnc, 'LMTK3' ).
Hgnc = 19295.

The following

?- use_module( pack('bio_db/cell/hs/hgnc') ).

also loads just the HGNC part of the human section of bio_db, but it is not a recommended way to do so.

Organisms

galg
Gallus gallus (red junglefowl), colloquial: chicken
homs
Homo sapiens, colloquial: human
mult
covers multiple organisms, longer form: multi
musm
Mus musculus, colloquial: mouse
suss
Sus scrofa (wild boar or Eurasian boar) colloquial: pig

Databases

Ensembl=ense
Homo sapiens genes and proteins. Genes and trascripts mappings along with mapping to genomic location (latter not included in release yet)
HGNC=hgnc
Hugo Gene Nomenclature Committee, http://www.genenames.org/
NCBI=ncbi
NCBI
Uniprot=unip
Protein database.
String=strg
Protein-Protein interactions data base
MGI=mgim
Mouse Genome Informatics, mouse specific datasets (last M for marker, their identifier)
Reactome=reac
Pathway database

For each database, a relation token with the same name, maps the field is the unique identifier of that database.

Other relation tokens

symb
HGNC gene symbol (short, unique name for genes)
name
(HGNC) gene name (long, less standarised version of gene name)
prev
HGNC previous gene symbol
syno
HGNC gene symbol synonym
ensg
ensembl gene
enst
ensembl transcript
ensp
ensembl protein
gonm
GO name of a term
pros
Prosite protein family information
rnuc
RNA nucleic sequence ID to HGNC symbol.
unig
uniprotein gene id
sprt
Swiss-Prot part of Uniprot (high quality, curated)
trem
TrEMBL part of Uniprot (non curated)
mgim
MGI Marker (identifier for Mouse Genome Informatics Markers)
cgnc
Chicken gene nomenclature committee
taxo
taxonomy id (NCBI)
scnm
scientific names for species (NCBI)
gbnm
genbank common name (NCBI)

The name convention for map predicates is

   ?- hgnc_homs_hgnc_symb( Hgnc, Symb ).
   Hgnc = 1,
   Symb = 'A12M1~withdrawn' ;
   Hgnc = 2,
   Symb = 'A12M2~withdrawn' .

   ?- hgnc_homs_hgnc_symb( 19295, Symb ).
   Symb = 'LMTK3'.

   ?- hgnc_homs_symb_hgnc( 'LMTK3', Hgnc ).
  Hgnc = 19295.

Where the first hgnc corresponds to the source database, the second token, homs, identifies the organism, the third and fourth tokens are the fields of the map. Above, the second hgnc

The last part of the predicate name corresponds to the second (or all other) argument(s), which here is the unique Symbol assigned to a gene by HGNC. In the current version of bio_db, all tokens in map filenames are 4 characters long. Map data for predicate Pname from database DB are looked for in DB(Pname.Ext) (see bio_db_paths/0). Extension, Ext, depends on the current bio_db database interface (see bio_db_interface/1), and it is sqlite if the interface is prosqlite and pl otherwise.

The name convention for graphs is

  ?- strg_homs_edge_symb( Symb1, Symb2, W ).
  S1 = 'A1BG',
  S2 = 'ABAT',
  W = 360 ;
  S1 = 'A1BG',
  S2 = 'ABCC6',
  W = 158 .

The first part indicates the database and the second one the organism/species. Graph data for predicate Pname from database DB are looked for in bio_db_data(graphs/DB/Pname.Ext) (see bio_db_paths/1). Extension, Ext, depends on the current bio_db database interface (see bio_db_interface/1), and it is sqlite if the interface is prosqlite and pl otherwise.

Bio_db supports four db interfaces: prolog, prosqlite, berkeley and rocks. The first one is via Prolog fact bases, which is the default. The second is an interface to SQLite via pack(prosqlite) while the third and fourth work with the SWI-Prolog packs bdb and rocksdb. The underlying mechanisms are entirely transparent to the user. In order to use the sqlite data sources pack(prosqlite) needs to be installed via the pack manager

 ?- pack_install( prosqlite ).

The user can control which interface is in use with the bio_db_interface/1 predicate.

 ?- bio_db_interface( Curr ).
 Curr = prolog.

 ?- bio_db_interface( prosqlite ).

 ?- bio_db_interface( Curr ).
 Curr = prosqlite.

The type of the interface of a bio_db data predicate is determined by the interface at the time of first call.

Once the user has initiated the serving of a predicate via calling a goal to it, it is then possible to have access to information about the dataset such as download date and sourle url.

?- hgnc_homs_hgnc_symb( Hgnc, Symb ).
Hgnc = 1,
Symb = 'A12M1~withdrawn' .

?- bio_db_info( hgnc_homs_hgnc_symb/2, Key, Value ), write( Key-Value ), nl, fail.
interface-prolog
source_url-ftp://ftp.ebi.ac.uk/pub/databases/genenames/hgnc_complete_set.txt.gz
datetime-datetime(2018,11,27,12,32,11)
data_types-data_types(integer,atom)
unique_lengths-unique_lengths(46023,46023,46023)
relation_type-relation_type(1,1)
header-row(HGNC ID,Approved Symbol)
false

As of version 2.0 there are two flags that can automate some of the interactions.

:- set_prolog_flag(bio_db_pl_from_zip, user).
:- set_prolog_flag(bio_db_del_zip, user).

In both cases the recognised values for the flags are: [user,true,false]. User is for prompting the user and true is progressing with an implicit yes answer. The first flag automates conversion from .pl.zip to .pl (which will be the case for the first time you access any dataset if you have installed bio_db_repo), and the second controls the deletion of the zip file once the .pl file has been created.

As of version 4.0 there are 91 associated data predicates serving 55444729 records.

Thanks to Jan Wielemaker for a retractall fix and for code for fast loading of precompiled fact bases (and indeed for the changes in SWI that made this possible).

author
- nicos angelopoulos
version
- 0.5 2016/09/11
- 0.7 2016/10/21, experimenting with distros in github
- 0.9 2017/03/10, small changes for pack(requires) -> pack(lib) v1.1
- 1.0 2017/10/09, to coincide with ppdp paper presentation
- 2.1 2018/11/27, introduces cells and mouse data (and fixed dependency of 2.0)
- 2.4 2019/04/02, test: bio_db_stats, new mouse db predicates, iface: bio_db_data_predicate/4
- 2.5 2019/04/22, edge_strg_symb/4; bio_db_organism/1,2; go_id/2,3
- 2.6 2019/05/08, changed to organism alias interface; evidence in gont maps
- 2.7 2019/05/12, edge_strg_symb/4 -> org_edge_strg_symb/4
- 3.0 2019/05/15, paper submission
- 3.1 2020/03/09, fixed lib; no unigene
- 3.2 2020/09/18, include mouse ense + fixes/updates on building scripts
- 3:4 2021/05/10, removed edge_gont_includes/2 (reciprocal of is_a), and edge_gont_consists_of/2 (reciprocal of part_of/2)
- 3:6 2021/12/04, fixed pack_errors and map_ense_mouse_enst_chrl/5; bio_db_stats.pl version 0.2
- 4:1 2022/12/29, huge re-config of data predicate names + reac-tome (maps) + chicken
- 4:2 2023/06/06, support for pig
- 4:3 2023/10/05, mult for multi organisms; vgnc database; ncbi taxonomy db; build-reorganisation
- 4:4 2024/04/05, db(ncbi) preds were complete rehaul, better and more complete db(reactome) support, fixed pig cells
- 4:5 2024/04/05, fixed certificate issue when downloading individual files of bio_db_repo
See also
- doc/Releases.txt for version details
- bio_db_data_predicate/4 for a way to enumerate all data predicates
- cell/ for the definitions of the data predicates

*/

 bio_db_paths
Initialisation call- setting up path aliases.

There are two main directory repositories the predicate deals with: (a) the bio_db installed databases root (alias bio_db_data), and (b) the root of downloaded databases (alias bio_db_downloads). Optionally a top directory of which both (a) and (b) are subdirs can be defined (alias bio_db). The default value for alias bio_db is a made-up pack directory pack(bio_db_repo). The default for bio_db_data is sub directory data of alias bio_db, while bio_db_downloads defaults to sub directory downloads of the alias bio_db. The canonical subdirectory name for (a) is data and for (b) is downloads.

pack(bio_db_repo) can also be installed as a complete package from SWI's manager.

?- pack_install( bio_db_repo ).

This will install all the Prolog database files. The single tar and gzipped file is 246 Mb in size and the fully expanded version of a Prolog installation can take up to 3.1Gb. The precise size depends on how many tables are accessed at least once (each producing an expanded .pl and a .qlf file).

Directory locations for (a) and (b) above can be given as either prolog flags with key bio_db_root and bio_dn_root respectively or via environment variables BioDbRoot and BioDnRoot.

Installed root alias(bio_db_data) contains sub-dirs

graphs
for graphs; string and reactome
maps
for all the supported maps

The above are mapped to aliases bio_graphs and bio_maps respectively. Within each of these sub-directories there is further structure based on the database the set was originated.

Downloaded root alias(bio_db_downloads) may contain sub-dirs

hgnc
data from HGNC database
ncbi
data from NCBI database
reactome
data from Reactome database
string
data from string database
uniprot
protein data from EBI
ense
ensembl database

Alias bio_db_downloads is only useful if you are downloading data files directly from the supported databases.

See

?- absolute_file_name( packs(bio_db(auxil)), Auxil ), ls( Auxil ).

for examples of how these can be used.

For most users these aliases are not needed as the library manages them automatically.

To be done
- transfer datasets and downloads to new pack location when running on newly installed SWI version upgrade.

*/

  657bio_db_paths :-
  658    bio_db_paths_root,
  659    bio_db_paths_installed,
  660    bio_db_paths_installed_sub,
  661    bio_db_paths_downloaded.
  662
  663bio_db_paths_root :-
  664    bio_db_setting( bio_db_root, Root ),
  665    !,
  666    bio_db_path_new( bio_db, Root ).
  667bio_db_paths_root.
  668
  669bio_db_paths_installed :-
  670    bio_db_setting( bio_db_data_root, DbRoot ),
  671    !,
  672    bio_db_path_new( bio_db_data, DbRoot ).
  673bio_db_paths_installed :-
  674    user:file_search_path( bio_db, BioDb ),
  675    os_path_1( BioDb, data, BioDbData ),
  676    % exists_directory( DbRoot ),
  677    !,
  678    bio_db_path_new( bio_db_data, BioDbData ).
  679bio_db_paths_installed :-
  680    throw( missing_setting(bio_db_data_root) ).
  681
  682bio_db_paths_downloaded :-
  683    bio_db_setting( bio_db_downloads_root, DnRoot ),
  684    !,
  685    bio_db_path_new( bio_db_downloads, DnRoot ).
  686bio_db_paths_downloaded :-
  687    user:file_search_path( bio_db_downloads_root, BioRoot ),
  688    os_path_1( BioRoot, downloads, DnRoot ),
  689    exists_directory( DnRoot ),
  690    !,
  691    bio_db_path_new( bio_db_downloads, DnRoot ).
  692
  693bio_db_paths_installed_sub :-
  694    user:file_search_path( bio_db_data, DbRoot ),
  695    findall( Sub, bio_db_sub(Sub), Subs ),
  696    maplist( bio_db_paths_installed_sub(DbRoot), Subs ),
  697    !.
  698
  699bio_db_paths_installed_sub( DbRoot, Sub ) :-
  700    os_path_1( DbRoot, Sub, AbsSub ),
  701    % exists_directory( Abs ),
  702    % directory_files( Abs, DbSubs ), % os_dirs
  703    ( atom_concat(SubSingular,'s',Sub) -> true; SubSingular = Sub ),
  704    atom_concat( bio_, SubSingular, BioDbSub ),
  705    bio_db_path_new( BioDbSub, AbsSub ),
  706    % os_path_1( AbsSub, Db, AbsDb )
  707    % bio_db_path_new( Db, AbsDb ),
  708    % bio_db_source( Sub, Db ),
  709    findall( DbSub, bio_db_source(Sub,DbSub), DbSubs ),
  710    maplist( bio_db_paths_installed_sub_dbs(AbsSub,Sub), DbSubs ),
  711    !.
  712bio_db_paths_installed_sub( _DbRoot, _Sub ).
  713
  714bio_db_paths_installed_sub_dbs( Abs, Sub, Db ) :-
  715    bio_db_source( Sub, Db ),
  716    os_path_1( Abs, Db, Full ),
  717    bio_db_path_new( Db, Full ).
  718% bio_db_paths_installed_sub_dbs( _Abs, _Sub ).
  719
  720bio_db_setting( PlSet, Value ) :-
  721    current_prolog_flag( PlSet, Value ),
  722    debug( bio_db, 'bio_db setting via flag: ~w, set to: ~w', [PlSet,Value] ),
  723    !.
  724bio_db_setting( PlSet, Value ) :-
  725    atomic_list_concat( Parts, '_', PlSet ),
  726    maplist( upcase_first, Parts, Arts ),
  727    atomic_list_concat( Arts, EnvVar ),
  728    getenv( EnvVar, Value ),
  729    debug( bio_db, 'bio_db setting via env: ~w, setting: ~w, set to: ~w', [EnvVar,PlSet,Value] ),
  730    !.
  731bio_db_setting( PlSet, Value ) :-
  732    bio_db_setting_default( PlSet, Value ).
  733
  734bio_db_path_new( Alias, New ) :-
  735    user:file_search_path( Alias, Old ),
  736    bio_db_path_new_exists( Alias, Old, New ),
  737    !.
  738bio_db_path_new( Alias, Path ) :-
  739    debug( bio_db, 'Asserting search alias: ~w, to ~p', [Alias,Path] ),
  740    assert( user:file_search_path(Alias,Path) ).
  741
  742bio_db_path_new_exists( _Alias, Old, Old ) :-
  743    !.
  744bio_db_path_new_exists( Alias, Old, New ) :-
  745    throw( fixme(alias_exists(Alias,Old,New)) ).
  746
  747bio_db_path_exists( Alias ) :- % fixme: is this called from anywhere ?
  748    throw( fixme(bio_db_paths_installed/0,search_path_exists(Alias)) ).
  749
  750upcase_first( Atom, Upped ) :-
  751    sub_atom( Atom, 0, 1, _, Flw ), 
  752    upcase_atom( Flw, Fup ),
  753    atom_length( Atom, Len ),
  754    Ken is Len - 1,
  755    sub_atom( atom, 1, Ken, 0, Tail ),
  756    atom_concat( Fup, Tail, Upped ).
 bio_db_version(-Vers, -Date)
Version Mj:Mn:Fx, and release date date(Y,M,D).
?- bio_db_version( V, D ).
V = 4:5:0,
D = date(2024, 4, 5).
author
- Nicos Angelopoulos
version
- 4:5 2024/4/5, fixed broken download of individual repo data preds
See also
- bio_db_data_predicate/4 (which should be generated for each new version)
- doc/Releases.txt for more detail on change log
- module documentation for brief comments on versioning history of this pack

*/

  775bio_db_version(4:5:0, date(2024,4,5)).
 bio_db_citation(-Atom, -Bibterm)
This predicate succeeds once for each publication related to this library. Atom is the atom representation suitable for printing while Bibterm is a bibtex(Type,Key,Pairs) term of the same publication. Produces all related publications on backtracking.
  785bio_db_citation( Atom, bibtex(Type,Key,Pairs) ) :-
  786  Atom = 'Accessing biological data as Prolog facts.\nNicos Angelopoulos and Jan Wielemaker. In Proceedings of 19th International Symposium on Principles and Practice of Declarative Programming, Namur, Belgium, October, 2017 (PPDP\'17), 10 pages.',
  787  Type = inproceedings,
  788  Key  = 'AngelopoulosN_GiamasG_2015',
  789  Pairs = [
  790               title  = 'Accessing biological data as Prolog facts',
  791               author = 'Nicos Angelopoulos and Jan Wielemaker',
  792               booktitle= '19th International Symposium on Principles and Practice of Declarative Programming',
  793               year = 2017,
  794               month = 'October',
  795               address= 'Namur, Belgium'
  796               % url     = 'http://ceur-ws.org/Vol-1433/tc_74.pdf'
  797     ].
  798
  799bio_db_citation( Atom, bibtex(Type,Key,Pairs) ) :-
  800  Atom = 'A logical approach to working with biological databases.\nNicos Angelopoulos and Georgios Giamas.\nProceedings of the 31st International Conference on Logic Programming (ICLP 2015) Accepted as a technical communication.\nCork, Ireland. September 2015.',
  801  Type = inproceedings,
  802  Key  = 'AngelopoulosN_GiamasG_2015',
  803  Pairs = [
  804               author = 'Nicos Angelopoulos and Georgios Giamas',
  805               title  = 'A logical approach to working with biological databases',
  806               booktitle= 'Technical Communication in Proceedings of the 31st International Conference on Logic Programming (ICLP 2015)',
  807               year = 2015,
  808               month = 'September',
  809            address= 'Cork, Ireland',
  810               url     = 'http://ceur-ws.org/Vol-1433/tc_74.pdf'
  811     ].
  812
  813bio_db_citation( Atom, bibtex(Type,Key,Pairs) ) :-
  814    Atom = 'Working with biological databases.\nNicos Angelopoulos and Georgios Giamas.\n1th Workshop on Constraint Based Methods for Bioinformatics (2015)\nCork, Ireland. September 2015',
  815    Type    = inproceedings,
  816    Key  = 'AngelopoulosN_GiamasG_2015a',
  817    Pairs = [
  818               author = 'Nicos Angelopoulos and Georgios Giamas',
  819            title  = 'Working with biological databases',
  820            booktitle = '11th Workshop on Constraint Based Methods for Bioinformatics (2015)',
  821            year = 2015,
  822            month = 'September',
  823            address = 'Cork, Ireland',
  824            url = 'http://clp.dimi.uniud.it/wp/wp-content/uploads/2015/08/WCB_2015_paper_1.pdf'
  825    ].
 bio_db_source(?Type, ?Db)
True if Db is a source database for bio_db serving predicate of type Type. Type is either maps or graphs.

The databases are

To be done
- fixme: this gets out of synch for new dbs, maybe have it in other location or throw a message if it fails ? */
  841bio_db_source(maps, hgnc).
  842bio_db_source(maps, gont).
  843bio_db_source(maps, ncbi).
  844bio_db_source(maps, unip).
  845bio_db_source(maps, vgnc).
  846bio_db_source(graphs, string ).
  847% bio_db_source( graphs, gont ). % these are used for aliases, so gont already exists
  848bio_db_source( graphs, reactome ).
  849
  850bio_db_sub(graphs).
  851bio_db_sub(maps).
  852
  853bio_db_setting_default( 'bio_db_root', BioDbRoot ) :-
  854    absolute_file_name( pack(bio_db), BioDb ),
  855    directory_file_path( Dir, bio_db, BioDb ),
  856    directory_file_path( Dir, bio_db_repo, BioDbRoot ).
  857bio_db_setting_default( 'bio_db_data_root', BioDbData ) :-
  858    absolute_file_name( bio_db(data), BioDbData ).
  859bio_db_setting_default( 'bio_db_downloads_root', BioDbDnloads ) :-
  860    absolute_file_name( bio_db(downloads), BioDbDnloads ).
 bio_db_interface(?Iface, -Status)
Interrogate the installation status (true or false) of bio_db's known interfaces. true if the interface dependencies are installed and the interface can be used, and =|false=| otherwise.

Can be used to enumerate all known or installed interfaces.

 ?- findall( Iface, bio_db_interface(Iface,_), Ifaces ).
 Ifaces = [prolog, berkeley, prosqlite, rocks].
  875bio_db_interface( prolog, true ).
  876bio_db_interface( berkeley, Bool ) :-
  877    ( catch( use_module( library(bdb) ), _, fail ) -> Bool = true; Bool = false ).
  878bio_db_interface( prosqlite, Bool ) :-
  879    ( catch( use_module( library(prosqlite) ), _, fail ) -> Bool = true; Bool = false ).
  880bio_db_interface( rocks, Bool ) :-
  881    ( catch( use_module( library(rocksdb) ), _, fail ) -> Bool = true; Bool = false ).
 bio_db_interface(?Iface)
Interrogate or set the current interface for bio_db database predicates. By default Iface = prolog. Also supported: prosqlite (needs pack proSQLite), berkley (needs SWI's own library(bdb) and rocks (needs pack(rocskdb).
?- bio_db_interface( Iface ).
Iface = prolog.

?- debug( bio_db ).
true.

?- bio_db_interface( wrong ).
% Could not set bio_db_interface prolog_flag, to: wrong, which in not one of: [prolog,prosqlite,berkeley,rocks]
false.

?- bio_db_interface( Iface ).
Iface = prolog.

?- hgnc_homs_symb_hgnc( 'LMTK3', Hgnc ).
% Loading prolog db: /usr/local/users/nicos/local/git/lib/swipl-7.1.32/pack/bio_db_repo/data/maps/hgnc/hgnc_homs_symb_hgnc.pl
Hgnc = 19295.

?- bio_db_interface( prosqlite ).
% Setting bio_db_interface prolog_flag, to: prosqlite
true.

?- hgnc_homs_prev_symb( Prev, Symb ).
% prosqlite DB:table hgnc:hgnc_homs_prev_symb/2 is not installed, do you want to download (Y/n) ?
% Execution Aborted
?- hgnc_homs_prev_symb( Prev, Symb ).
% Loading prosqlite db: /usr/local/users/nicos/local/git/lib/swipl-7.1.32/pack/bio_db_repo/data/maps/hgnc/hgnc_homs_prev_symb.sqlite
Prev = 'A1BG-AS',
Symb = 'A1BG-AS1' ;

In which case Iface is prosqlite.

  923bio_db_interface( Iface ) :-
  924    var( Iface ),
  925    !,
  926    current_prolog_flag( bio_db_interface, IfacePrv ),
  927    bio_db_interface_known( IfacePrv, Iface ).
  928bio_db_interface( Iface ) :-
  929    ground( Iface ),
  930    bio_db_interface_set( Iface ).
  931
  932bio_db_info( Iface, Pid, Key, Value ) :-
  933    var( Iface ),
  934    !,
  935    bio_db_info_gen( Iface, Pid, Key, Value ).
  936bio_db_info( Iface, Pid, Key, Value ) :-
  937    atom( Iface ),
  938    bio_db_info_source( Iface, Pid, Key, Value ).
  939
  940bio_db_info_gen( Iface, Pid, Key, Value ) :-
  941    bio_db_interface_extensions( Iface, _ ),
  942    bio_db_info( Iface, Pid, Key, Value ).
  943
  944bio_db_install_defaults( [org(hs),interactive(true)] ).
 bio_db_install(+PidOrPname, +Iface)
 bio_db_install(+PidOrPname, +Iface, +Opts)
Install the interface (Iface) for bio_db database that corresponds to predicate identifier (Pid) or a predicate name (Pname). Note that this is not necessary to do in advance as the library will auto load missing Iface and Pid combinations when first interrogated.

Opts

interactive(Ictive=true)
set false to accept default interactions
org(Org=hs)
organism

*/

  960bio_db_install( PorP, Iface ) :-
  961    bio_db_install( PorP, Iface, [] ).
  962bio_db_install( PorP, Iface, OptS ) :-
  963    options_append( bio_db_install, OptS, Opts ),
  964    options( interactive(Ictive), Opts ),
  965    options( org(Org), Opts ),
  966    bio_db_porp_call( PorP, bio_db_install/2, Call ),
  967    bio_db_map_call_db_pname( Call, Db, Pname, Arity ),
  968    ( bio_db_info(Iface,PorP,_,_) -> 
  969        Mess = '~a DB:table ~w is already installed. It will be overwritten. Continue',
  970        Args = [Iface,PorP],
  971        ui_yes_no( Ictive, Mess, Args, y, Reply ), 
  972        ( Reply == true ->
  973            bio_db_interface_extensions( Iface, [Ext|_] ),
  974            ( bio_db_pname_source(Org,Db,Pname,read,Ext,File) ->
  975                delete_installed( Ext, File )
  976                ;
  977                true
  978            ),
  979            bio_db_serve_pname( false, false, Org, Db, Pname, Arity, Iface, Call )
  980            ;
  981            % ensure qlf is also installed, before failing
  982            ( Iface == prolog ->
  983                ( bio_db_pname_source(Org,Db,Pname,read,qlf,_ExistFile) ->
  984                    Mess1 = 'Qlf is also istalled.',
  985                    phrase('$messages':translate_message(debug(Mess1,[])), Lines1),
  986                    print_message_lines(current_output, kind(informational), Lines1)
  987                    ;
  988                    bio_db_pname_source( Org, Db, Pname, read, pl, File ),
  989                    bio_db_load_call( false, Pname, Arity, Iface, File, true )
  990                )
  991                ;
  992                true
  993            )
  994        )
  995        ;
  996        bio_db_serve_pname( false, false, Db, Pname, Arity, Iface, Call )
  997    ).
  998
  999delete_installed( rocks, Dir ) :-
 1000    delete_installed_db_dir_and_info( Dir ).
 1001delete_installed( db, File ) :-
 1002    delete_installed_db_file_and_info( File ).
 1003delete_installed( sqlite, File ) :-
 1004    delete_installed_db_file_and_info( File ).
 1005delete_installed( pl, File ) :-
 1006    delete_installed_db_file_and_info( File ),
 1007    file_name_extension( Stem, _Ext, File ),
 1008    file_name_extension( Stem,  qlf, Qile ),
 1009    ( exists_file(Qile) ->
 1010        debug( bio_db, 'Deleting file: ~p', Qile ),
 1011        delete_file(Qile)
 1012        ;
 1013        true
 1014    ).
 1015
 1016delete_installed_db_file_and_info( File ) :-
 1017    ( exists_file(File) ->
 1018        debug( bio_db, 'Deleting file: ~p', File ),
 1019        delete_file( File )
 1020        ;
 1021        true
 1022    ),
 1023    file_name_extension( Stem, Ext, File ),
 1024    atom_concat( Stem, '_info', InfoStem ),
 1025    file_name_extension( InfoStem, Ext, InfoFile ),
 1026    ( exists_file(InfoFile) ->
 1027        debug( bio_db, 'Deleting file: ~p', InfoFile ),
 1028        delete_file( InfoFile )
 1029        ;
 1030        true
 1031    ).
 1032
 1033delete_installed_db_dir_and_info( Dir ) :-
 1034    ( exists_directory(Dir) ->
 1035        debug( bio_db, 'Deleting directory: ~p', Dir ),
 1036        delete_directory_contents( Dir )
 1037        ;
 1038        true
 1039    ),
 1040    file_name_extension( Stem, Ext, Dir ),
 1041    atom_concat( Stem, '_info', InfoStem ),
 1042    file_name_extension( InfoStem, Ext, InfoDir ),
 1043    ( exists_directory(InfoDir) ->
 1044        debug( bio_db, 'Deleting directory: ~p', InfoDir ),
 1045        delete_directory_contents( InfoDir )
 1046        ;
 1047        true
 1048    ).
 bio_db_porp_call(PorP, CallerId, Call)
Constract a generic call from predicate id or predicate name (Porp).

*/

 1055bio_db_porp_call( Porp, Cid, Call ) :-
 1056    ground( Porp ),
 1057    bio_db_porp_call_ground( Porp, Cid, Call ).
 1058
 1059bio_db_porp_call_ground( Pname/Arity, _Cid, Call ) :- !,
 1060    functor( Call, Pname, Arity ).
 1061bio_db_porp_call_ground( Pname, Cid, Call ) :-
 1062    % find the name from the module def of bio_db. A bit hackish.
 1063    atom( Pname ),
 1064    absolute_file_name( pack('bio_db/prolog/bio_db.pl'), BioDbF, [access(exist)] ),
 1065    open( BioDbF, read, In ),
 1066    read( In, ModuleDef ), 
 1067    close( In ),
 1068    ModuleDef = (:- module( bio_db, Pids ) ),
 1069    ( memberchk(Pname/Arity,Pids) ->
 1070        true
 1071        ;
 1072        throw( not_a_db_pred(Pname), [pack(bio_db),pred(Cid)] )
 1073    ),
 1074    functor( Call, Pname, Arity ).
 bio_db_predicate_name(+PidOrPname, -Pname)
Auxiliary predicate that strips the Pname of Pid or assumes atomic PidOrPname to be a Pname.
To be done
- check it looks like a db name. this is only useful for db_preds.

*/

 1084bio_db_predicate_name( Pid, Pname ) :-
 1085    ground( Pid ),
 1086    bio_db_predicate_name_ground( Pid, Pname ).
 1087
 1088bio_db_predicate_name_ground( Pname/_, Pname ) :- !.
 1089bio_db_predicate_name_ground( Pname, Pname ) :-
 1090    atom( Pname ).
 1091
 1092bio_db_predicate_db( Pid, Db ) :-
 1093    bio_db_predicate_name( Pid, Pname ),
 1094    atomic_list_concat( [_,Db|_], '_', Pname ).
 1095
 1096bio_db_info_source( Iface, Pid, Key, Value ) :-
 1097    bio_db_predicate_name( Pid, Pname ),
 1098    bio_db_predicate_db( Pname, Db ),
 1099    bio_db_pname_source( Db, Pname, read, Iface, DbF ),
 1100    ( bio_db_interface_initialisation(Iface) -> true; true ),
 1101    bio_db_info_db_file( Iface, Pid, DbF, Key, Value ).
 1102
 1103bio_db_info_db_file( prolog, _Pid, DbF, Key, Value ) :-
 1104    bio_db_pl_info( DbF, Infos ),
 1105    member( Info, Infos ),
 1106    arg( 1, Info, Key ),
 1107    arg( 2, Info, Value ).
 1108bio_db_info_db_file( prosqlite, Pid, DbF, Key, Value ) :-
 1109    bio_db_predicate_info( Pid, Info ),
 1110    % bio_db_source_info( DbF, InfoF ),
 1111    sqlite_connect( DbF, Info ),
 1112    atom_concat( 'Select * from ', Info, Query ),
 1113    findall( Row, sqlite_query(Info,Query,Row), Rows ),
 1114    sqlite_disconnect( Info ),
 1115    member( row(Key,ValueAtom), Rows ),
 1116    ( catch(atom_to_term(ValueAtom,Value,_),_,fail) ->
 1117        true
 1118        ;
 1119        Value = ValueAtom
 1120    ).
 1121bio_db_info_db_file( berkeley, Pid, DbF, Key, Value ) :-
 1122    bio_db_info_interface_infos( berkeley, Pid, DbF, _,  KVs ),
 1123    member( Key-Value, KVs ).
 1124bio_db_info_db_file( rocks, Pid, DbF, Key, Value ) :-
 1125    bio_db_info_interface_infos( rocks, Pid, DbF, _,  KVs ),
 1126    member( Key-Value, KVs ).
 bio_db_info(+Pid, ?Iface)
 bio_db_info(+Pid, ?Key, -Value)
 bio_db_info(+Iface, +Pid, ?Key, -Value)
Retrieve information about bio_db database predicates.

When Iface is not given, Key and Value are those of the interface under which Pid is currently open for access. The predicate errors if Pid is not open for serving yet.

The bio_db_info/2 version succeeds for all interfaces Pid is installed- it is simply a shortcut to: bio_db_info( Iface, Pid, _, _ ).

The Key-Value information returned are about the particular data predicate as saved in the specific backend.

Key

source_url
an atomic value of the URL
datetime
datetime/6 term
data_types
data_types/n given the primary type for each argyument in the data table
header
row/n term, where n is the number of columns in the data table
unique_lengths
unique_lengths/3 term, lengths for the ordered sets of: Ks, Vs and KVs
relation_type(From, TO)
where From and To take values in 1 and m
?- bio_db_info( Iface, hgnc_homs_hgnc_symb/2, Key, Value), write( Iface:Key:Value ), nl, fail.
prolog:source_url:ftp://ftp.ebi.ac.uk/pub/databases/genenames/hgnc_complete_set.txt.gz
prolog:datetime:datetime(2016,9,10,0,2,14)
prolog:data_types:data_types(integer,atom)
prolog:unique_lengths:unique_lengths(44266,44266,44266)
prolog:relation_type:relation_type(1,1)
prolog:header:row(HGNC ID,Approved Symbol)
prosqlite:source_url:ftp://ftp.ebi.ac.uk/pub/databases/genenames/hgnc_complete_set.txt.gz
prosqlite:datetime:datetime(2016,9,10,0,2,14)
prosqlite:data_types:data_types(integer,atom)
prosqlite:unique_lengths:unique_lengths(44266,44266,44266)
prosqlite:relation_type:relation_type(1,1)
prosqlite:header:row(HGNC ID,Approved Symbol)

*/

 1180bio_db_info( PorP, Iface ) :-
 1181    bio_db_info( Iface, PorP, _, _ ),
 1182    !.
 1183
 1184bio_db_info( Pid, Key, Value ) :-
 1185    bio_db_db_predicate( Pid ),
 1186    !,
 1187    bio_db_info_pred( Pid, Key, Value ).
 1188bio_db_info( Pid, _Key, _Value ) :-
 1189    throw( not_a_db_pred(Pid), [pack(bio_db),pred(bio_db_info/3)] ).
 1190
 1191bio_db_info_pred( Pid, Key, Value ) :-
 1192    bio_db_handle( Pid, Iface, File, Handle, _Mod ),
 1193    !,
 1194    bio_db_info_interface( Iface, Pid, File, Handle, Key, Value ).
 1195
 1196bio_db_info_pred( Pid, _Key, _Value ) :-
 1197    throw( close_to_info(Pid), [pack(bio_db),pred(bio_db_info/3)] ).
 1198
 1199bio_db_info_interface_kvs( Iface, Pid, File, Handle, KVs ) :-
 1200    bio_db_info_interface_infos( Iface, Pid, File, Handle, Pairs ),
 1201    \+ var( KVs ),
 1202    bio_db_info_interface_kvs( KVs, Pairs ).
 1203    
 1204bio_db_info_interface_kvs( [], _ ).
 1205bio_db_info_interface_kvs( [K-V|T], Pairs ) :-
 1206    memberchk( K-V, Pairs ),
 1207    bio_db_info_interface_kvs( T, Pairs ).
 1208    
 1209bio_db_info_interface( Iface, Pid, File, Handle, Key, Value ) :-
 1210    bio_db_info_interface_infos( Iface, Pid, File, Handle, KVs ),
 1211    member( Key-Value, KVs ).
 1212    
 1213bio_db_info_interface_infos( Callable, Pid, _File, _Handle, Pairs ) :-
 1214    memberchk( Callable, [prolog,prosqlite] ),
 1215    !,
 1216    bio_db_predicate_info( Pid, InfoName ),
 1217    Goal =.. [InfoName,Key,Value],
 1218    findall( Key-Value, ( (Key = interface, Value = Callable) ;  bio_db:Goal ), Pairs ).
 1219bio_db_info_interface_infos( berkeley, _Pid, File, _Handle, KVs ) :-
 1220    % fixme add key = Berkley interface
 1221    % ( ((Key=interface, Value=berkeley); bdb_enum( Handle, info+Key , Value)) ).
 1222    bio_db_source_info( File, InfoF ),
 1223
 1224    bdb_open( InfoF, read, InfoHandle, [key(atom),value(term)] ),
 1225    findall( AKey-AValue, bdb_enum(InfoHandle,AKey,AValue), Pairs ),
 1226    bdb_close( InfoHandle ),
 1227    KVs = [interface-berkeley|Pairs].
 1228bio_db_info_interface_infos( rocks, _Pid, File, _Handle, KVs ) :-
 1229    % fixme add key = Berkley interface
 1230    file_name_extension( Stem, Ext, File ),
 1231    atom_concat( Stem, '_info', InfoStem ),
 1232    file_name_extension( InfoStem, Ext, InfoFile ),
 1233    rocks_open( InfoFile, InfoHandle, [key(atom),value(term)] ),
 1234    findall( AKey-AValue, rocks_enum(InfoHandle,AKey,AValue), Pairs ),
 1235    rocks_close( InfoHandle ),
 1236    KVs = [interface-rocks|Pairs].
 bio_db_close(+Pid)
Close the current serving of predicate Pid. Next time a Pid Goal is called the current interface (bio_db_interface/1) will be used to establish a new server and resolve the query.

Predicate throws an error if the Pid does not correspond to a db_predicate or if it is not currently servered by any of the backends.

?- bio_db_interface(prosqlite).
?- hgnc_homs_hgnc_symb( Hgnc, Symb ).
Hgnc = 506,
Symb = 'ANT3~withdrawn' .

?- bio_db_close( hgnc_homs_hgnc_symb/2 ).
?- bio_db_interface( prolog ).
?- hgnc_homs_hgnc_symb( Hgnc, Symb ).
Hgnc = 1,
Symb = 'A12M1~withdrawn' .
?- bio_db_close(hgnc_homs_hgnc_symb/2).

*/

 1262bio_db_close( Pid ) :-
 1263    bio_db_db_predicate( Pid ),
 1264    !,
 1265    bio_db_close_pred( Pid ).
 1266bio_db_close( Pid ) :-
 1267    throw( not_a_db_pred(Pid), [pack(bio_db),pred(bio_db_close/1)] ).
 1268
 1269bio_db_close_pred( Pid ) :-
 1270    bio_db_handle( Pid, Iface, File, Handle, Mod ),
 1271    !,
 1272    bio_db_close_connection( Iface, Handle ),
 1273    Pid = Pname/Arity,
 1274    functor( Head, Pname, Arity ),
 1275    retractall( Head ),
 1276    atom_concat( Pname, '_info', InfoPname ),
 1277    functor( InfoHead, InfoPname, 2 ),
 1278    retractall( InfoHead ),
 1279    retractall( bio_db_handle(Pid,Iface,File,Handle,Mod) ),
 1280    assert( (Head :- bio_db_serve(Head)) ).
 1281bio_db_close_pred( Pid ) :-
 1282    throw( not_served(Pid), [pack(bio_db),pred(db_close/1)] ),
 1283    fail.
 1284
 1285bio_db_close_connection( prosqlite, Handle ) :-
 1286    sqlite_disconnect( Handle ).
 1287bio_db_close_connection( prolog, _Handle ).
 1288bio_db_close_connection( berkeley, Handle ) :- 
 1289    bdb_close( Handle ).
 1290bio_db_close_connection( rocks, Handle ) :- 
 1291    rocks_close( Handle ).
 bio_db_close_connections
Close all currently open bio_db backend connections.

This is called by bio_db at halt.

*/

 1300bio_db_close_connections:-
 1301    findall( Pid, bio_db:bio_db_handle(Pid,_B,_C,_D,_Mod), Pids ),
 1302    member( Pid, Pids ),
 1303    bio_db_close( Pid ),
 1304    fail.
 1305bio_db_close_connections.
 bio_db_db_predicate(?Pid)
True if Pid is a predicate identifier which is defined in current bio_db session, and contains 4 _ sep tokens, each of length 4. When Pid is a free variable all such predicate identifiers are returned on backtracking.

For a statically produced list of all data predicates in bio_db see, bio_db_data_predicate/4.

  ?- bio_db_db_predicate( hgnc_homs_hgnc_symb/2 ).
  true.

  ?- bio_db_db_predicate( X ).
  X = hgnc_homs_symb_ncbi/2 ;
  X = ense_homs_enst_ensg/2 ;
  ...

*/

 1327bio_db_db_predicate( Pname/Arity) :-
 1328    ground(Pname/Arity), !,
 1329    functor(Head,Pname,Arity),
 1330    bio_db_data_predicate_name(Pname),
 1331    % predicate_property(bio_db:Head, exported), !.
 1332    predicate_property(bio_db:Head, defined), !.  
 1333    % fixme: when called from closing,  maybe do a bit of checking ? \+ (rule=:=1,clauses=:=1)
 1334bio_db_db_predicate( Pname/Arity) :-
 1335    % module_property(bio_db, exports(List)),
 1336    % member(Pname/Arity, List),
 1337    current_predicate( bio_db:Pname/Arity ),
 1338    bio_db_data_predicate_name(Pname).
 1339
 1340bio_db_data_predicate_name( Pname ) :-
 1341     atomic_list_concat( Parts, '_', Pname ),
 1342     maplist( atom_length, Parts, [4,4,4,4] ),
 1343     !.
 1344bio_db_data_predicate_name( _Db, _Parts, Pname, Arity ) :-
 1345    throw( not_a_db_pred(Pname/Arity), [pack(bio_db),pred(bio_db_close/1)] ).
 1346
 1347% map stubs, 
 1348% these are in memory iff the map is to be loaded as prolog 
 1349% and this is the first call to the pred, they get replaced
 1350% by the map data after that.
 1351% 
 1352bio_db_serve( Call ) :-
 1353    functor( Call, Pn, _ ),
 1354    ( atomic_list_concat([_,OrgPredTkn,_,_],'_',Pn) ->
 1355          ( bio_db_organism(OrgPredTkn,OrgTkn,_Org) ->
 1356               true
 1357               ; 
 1358               ( bio_db_organism(_,OrgPredTkn,_) ->
 1359                    OrgTkn = OrgPredTkn
 1360                    ;
 1361                    throw( cannot_get_org_token_for_bio_db_served(Call) )
 1362               )
 1363          )
 1364    ),
 1365    bio_db_serve( OrgTkn, Call, true ).
 1366
 1367bio_db_serve( Org, Call ) :-
 1368    bio_db_serve( Org, Call, true ).
 1369
 1370bio_db_serve( Org, Call, Load ) :-
 1371    bio_db_interface( Iface ),
 1372    bio_db_map_call_db_pname( Call, Db, Pname, Arity ),
 1373    bio_db_serve_pname( Load, true, Org, Db, Pname, Arity, Iface, Call ).
 1374
 1375bio_db_interface_set( Iface ) :-
 1376    bio_db_interface_atom( Iface ),
 1377    !,
 1378    M = 'Setting bio_db_interface prolog_flag, to: ~a',
 1379    debug( bio_db, M, Iface ),
 1380    ( bio_db_interface_initialisation(Iface) -> true; true ),
 1381    set_prolog_flag( bio_db_interface, Iface ).
 1382bio_db_interface_set( Iface ) :-
 1383    findall( Aface, bio_db_interface_atom(Aface), AllFaces ),
 1384    throw( arg_enumerate(1,AllFaces,Iface), [pack(bio_db),pred(bio_db_interface/2)] ).
 1385    
 1386bio_db_interface_extensions( prolog, [pl,''] ).
 1387bio_db_interface_extensions( prosqlite, [sqlite,''] ).
 1388bio_db_interface_extensions( berkeley, [db,''] ).
 1389bio_db_interface_extensions( rocks, [rocks,''] ).
 1390
 1391bio_db_interface_known( Prov, Iface ) :-
 1392    atomic( Prov ),
 1393    bio_db_interface_atom( Prov ),
 1394    !,
 1395    Iface = Prov.
 1396bio_db_interface_known( Prov, Def ) :-
 1397    bio_db_default_interface( Def ),
 1398    M = 'Resetting bogus bio_db_interface prolog_flag, from: ~w, to default: ~a',
 1399    debug( bio_db, M, [Prov,Def] ), % fixme: this is informational rather than debug
 1400    set_prolog_flag( bio_db_interface, Def ).
 1401
 1402% prosqlite here
 1403/*
 1404bio_db_serve_pname( load, Db, Pname, Arity, Call ) :-
 1405    current_prolog_flag( bio_db_interface, prosqlite ),
 1406    !,
 1407    Term =.. [Db,Pname],
 1408    absolute_file_name( Term, Src, [access(Mode),file_type(prolog),file_errors(fail)] ).
 1409    sqlite_connect( phones, phones_db, as_predicates(true) )
 1410    */
 bio_db_serve_pname(+LoadFlag, +Ictive, Org, Db, Pname, Arity, Iface, _Call)
LoadFlag can be one of check, true (for loading) and false for ensuring the db is installed but does not actually hot-swap it in. Ictive is a boolean with true for interactively questioning user whereas false accepts the defaults with no interupptions.

*/

 1420bio_db_serve_pname( check, _Ictive, Org, Db, Pname, _Arity, Iface, _Call ) :-
 1421    !,
 1422    % bio_db_interface_extensions( Iface, Exts ),
 1423    bio_db_interface_extensions( Iface, [Ext|_] ),
 1424    % new implementation, untested:
 1425    bio_db_pname_source( Org, Db, Pname, read, Ext, _Abs ).
 1426    % % bio_db_db_pname_source( Db, Pname, exist, Ext, Abs ),
 1427    % Rel =.. [Db|Pname],
 1428    % absolute_file_name( Rel, Abs, [extensions(Exts),access(exist)] ),
 1429    % exists_file( Abs ),
 1430
 1431bio_db_serve_pname( Load, _Ictive, Org, Db, Pname, Arity, Iface, Call ) :-
 1432    bio_db_interface_extensions( Iface, [Ext|_] ),
 1433    bio_db_pname_source( Org, Db, Pname, read, Ext, File ),
 1434    % bio_db_db_pname_source( Db, Pname, exist, Ext, Load ),
 1435    % user:file_search_path( Db, _DbPath ),
 1436    !,
 1437    bio_db_load_call( Load, Pname, Arity, Iface, File, Call ).
 1438bio_db_serve_pname( Load, Ictive, Org, Db, Pname, Arity, Iface, Call ) :-
 1439    Iface \== prolog,
 1440    bio_db_interface_extensions( prolog, [Ext|_] ),
 1441    bio_db_pname_source( Org, Db, Pname, read, Ext, File ),
 1442    Mess = '~a DB:table ~w:~w is not installed, but the Prolog db exists. Shall it be created from Prolog',
 1443    Args = [Iface,Db,Pname/Arity],
 1444    ui_yes_no( Ictive, Mess, Args, y, Reply ),
 1445    Reply == true,
 1446    % bio_db_serve_pname_from_local( Reply, Db, Pname, Arity, Iface, Load, Call ),
 1447    bio_db_pl_nonpl_interface( Iface, File, NonPlLoad ),
 1448    !,
 1449    % fixme: add logic for deleting prolog interface of downloaded db
 1450    bio_db_load_call( Load, Pname, Arity, Iface, NonPlLoad, Call ).
 1451bio_db_serve_pname( Load, Ictive, Org, Db, Pname, Arity, Iface, Call ) :-
 1452    % bio_db_pname_source( Db, Pname, read, prolog+zip, ZLoad ),
 1453    % bio_db_pname_source( Db, Pname, read, 'pl.zip', ZLoad ),
 1454    bio_db_pname_source( Org, Db, Pname, read, prolog+zip, ZLoad ),
 1455    !,
 1456    file_name_extension( PlLoad, zip, ZLoad ),
 1457    current_prolog_flag( bio_db_pl_from_zip, PlFromZipFlag ),
 1458    ( PlFromZipFlag == user ->
 1459        Mess = '~a DB:table ~w:~w is not installed, but the zipped prolog db exists. Shall it be created from this',
 1460        Args = [Iface,Db,Pname/Arity],
 1461        ui_yes_no( Ictive, Mess, Args, y, Reply )
 1462        ;
 1463        MessFg = '~a DB:table ~w:~w is not installed, but the zipped prolog db exists. Flag bio_db_pl_from_zip says: ~w',
 1464        message_report( MessFg, [Iface,Db,Pname/Arity,PlFromZipFlag], informational ),
 1465        Reply = PlFromZipFlag
 1466    ),
 1467    ( Reply == true ->
 1468        file_directory_name( ZLoad, Dir ),
 1469        archive_extract( ZLoad, Dir, [] ),
 1470        ( Iface \== prolog ->
 1471            bio_db_pl_nonpl_interface( Iface, PlLoad, NonPlLoad ),
 1472            bio_db_reply_delete_file( true, PlLoad )
 1473            ;
 1474            current_prolog_flag(bio_db_del_zip,DelZipFlag),
 1475            ( DelZipFlag == user ->
 1476                ZipDelMess = 'Delete the zip file: ~p',
 1477                ui_yes_no( Ictive, ZipDelMess, [ZLoad], n, ZipDelReply )
 1478                ;
 1479                MessDelFg = 'Zip file will be deleted depending on value of flag bio_db_del_zip, which is: ~w',
 1480                message_report( MessDelFg, [DelZipFlag], informational ),
 1481                ZipDelReply = DelZipFlag
 1482            ),
 1483            bio_db_reply_delete_file( ZipDelReply, ZLoad ),
 1484            NonPlLoad = PlLoad
 1485        ),
 1486        !,
 1487        bio_db_load_call( Load, Pname, Arity, Iface, NonPlLoad, Call )
 1488        ;
 1489        % fixme: do fresh download
 1490        debug( bio_db, 'Downloading fresh zip file for: ~w', Pname/Arity ),
 1491        delete_file( ZLoad ),
 1492        file_directory_name( ZLoad, DataDir ),
 1493        directory_files( DataDir, DataFiles ),
 1494        findall( Delable-FullDel, ( member(Delable,DataFiles), 
 1495                                file_name_extension(Pname,_DelExt,Delable), 
 1496                                directory_file_path(DataDir,Delable,FullDel)
 1497                            ),
 1498                                Delables ),
 1499        maplist( bio_db_conflict_file, Delables ),
 1500        bio_db_serve_pname_reply( true, Ictive, Load, Org, Db, Pname, Arity, Iface, Call )
 1501    ).
 1502% here  fixem: 
 1503% add logic that warns if other interfaces will be 
 1504bio_db_serve_pname( Load, Ictive, Org, Db, Pname, Arity, Iface, Call ) :-
 1505    ( Iface == prolog -> 
 1506        Mess = '~a DB:table ~w:~w is not installed, do you want to download it'
 1507        ;
 1508        Mess = '~a DB:table ~w:~w is not installed, do you want to download the prolog db and then generate this interface'
 1509    ),
 1510    Args = [Iface,Db,Pname/Arity],
 1511    ui_yes_no( Ictive, Mess, Args, y, Reply ),
 1512    bio_db_serve_pname_reply( Reply, Ictive, Load, Org, Db, Pname, Arity, Iface, Call ).
 1513
 1514bio_db_serve_pname_reply( false, _Ictive, _Load, _Org, _Db, _Pname, _Arity, _Iface, _Call ) :-
 1515    abort.
 1516bio_db_serve_pname_reply( true, Ictive, Load, Org, Db, Pname, Arity, Iface, Call ) :-
 1517    stoics( Stoics ),
 1518    Mess = 'Downloading dataset from server: ~w',
 1519    phrase('$messages':translate_message(debug(Mess,[Stoics])), Lines),
 1520    print_message_lines(current_output, kind(informational), Lines),
 1521    atomic_list_concat( [_,_,Comp3|_], '_', Pname ), 
 1522    bio_db_predicate_type_sub_dir( Comp3, Sub ),
 1523    atomic_list_concat( [Stoics,Org,Sub,Db,Pname], '/', StoicsStem ),
 1524    atomic_list_concat( [StoicsStem,pl,zip], '.', StoicsFile ),
 1525    bio_db_pname_source( Org, Db, Pname, none, 'pl.zip', Local ),
 1526    debug( bio_db, 'Trying to get: ~w', url_file(StoicsFile,Local,insecure(true)) ),
 1527    % directory_file_path( LocDir, _, Local ),
 1528    file_directory_name( Local, LocalDir ),
 1529    % here
 1530    bio_db_repo_skeleton_pack,
 1531    make_directory_path( LocalDir ),
 1532    url_file( StoicsFile, Local, insecure(true) ),  % 2024.04.05 you needed latest stoics_lib; fixme: temp
 1533    % fixme: delete the .pl file here if it exists before unpacking ?  % although this is inconsistent with calling logic
 1534    archive_extract( Local, LocalDir, [] ),
 1535    % here( 'Unzip the pl, create the Iface and if not Iface==Prolog, suggest deleting the .pl db' ),
 1536    file_name_extension( LocalPlF, zip, Local ),
 1537    directory_files( LocalDir, LocalFiles ),
 1538    bio_db_interface_extensions( Iface, [Ext|_] ),
 1539    findall( Delable-FullDel, ( member(Delable,LocalFiles), 
 1540                            file_name_extension(Pname,DelExt,Delable), 
 1541                            \+ memberchk(DelExt,['pl.zip',pl,Ext]),
 1542                            directory_file_path(LocalDir,Delable,FullDel)
 1543                            ),
 1544                                Delables ),
 1545    debug( bio_db, 'Candidates for deletion: ~w', [Delables] ),
 1546
 1547    ( \+ exists_file(LocalPlF) -> 
 1548        throw( decompression_didnot_produce(LocalPlF) )
 1549        ; 
 1550        % here: ask to delete .zip file
 1551        ZipDelMess = 'Delete the zip file: ~p',
 1552        ui_yes_no( Ictive, ZipDelMess, [Local], n, ZipDelReply ),
 1553        bio_db_reply_delete_file( ZipDelReply, Local )
 1554    ),
 1555    ( Iface == prolog ->
 1556        NonPlLoad = LocalPlF
 1557        ;
 1558        bio_db_pl_nonpl_interface( Iface, LocalPlF, NonPlLoad ),
 1559        PlDelMess = 'Delete the Prolog file: ~p',
 1560        ui_yes_no( Ictive, PlDelMess, [LocalPlF], y, PlDelReply ),
 1561        bio_db_reply_delete_file( PlDelReply, LocalPlF )
 1562    ),
 1563    maplist( bio_db_conflict_file, Delables ),
 1564    % then( 'go back and make sure you deal with existing other interfaces (delete them)' ),
 1565    !,
 1566    bio_db_load_call( Load, Pname, Arity, Iface, NonPlLoad, Call ).
 1567    % we probably (now need something lighter than:
 1568    % bio_db_serve_pname( load, Db, Pname, Arity, Iface, Call ).
 1569
 1570bio_db_repo_skeleton_pack :-
 1571    absolute_file_name( pack(bio_db), BioDbD, [file_type(directory)] ),
 1572    directory_file_path( PackD, _, BioDbD ),
 1573    directory_file_path( PackD, bio_db_repo, RepoD ),
 1574    directory_file_path( RepoD, 'pack.pl', RepoPackPl ),
 1575    ( exists_file(RepoPackPl) ->
 1576        true
 1577        ;
 1578        make_directory_path( RepoD ),
 1579        ensure_loaded( pack('bio_db/auxil/lib/bio_db_repo_info') ),
 1580        findall( InfTerm, bio_db_repo_info(InfTerm), [InfNm,InfTi|Infs] ),
 1581        date_two_digit_dotted( Dotted ),
 1582        atomic_list_concat( [YrA,MnA,DyA], '.', Dotted ),
 1583        % atomic_list_concat( [Dotted,skeleton], '-', PlPackVers ),
 1584        Clauses = [InfNm,InfTi,version(Dotted)|Infs],
 1585        portray_clauses( Clauses, file(RepoPackPl) ),
 1586        atomic_list_concat( [20,YrA], FullYA ),
 1587        maplist( atom_number, [YrA,FullYA,MnA,DyA], [Yr,FullY,Mn,Dy] ), % the day gets a -skeleton suffix
 1588        atomic_list_concat( [DyA,skeleton], '-', DyPsfx ),
 1589        directory_file_path( RepoD, prolog, RepoPlD ),
 1590        make_directory_path( RepoPlD ),
 1591        directory_file_path( RepoPlD, 'bio_db_repo_version.pl', ModVersF ),
 1592        portray_clauses( [bio_db_repo_version(Yr:Mn:DyPsfx,date(FullY,Mn,Dy))], file(ModVersF) ),
 1593        directory_file_path( BioDbD, 'auxil/lib/bio_db_repo.pl', BioDbRepoPlF ),
 1594        directory_file_path( RepoPlD, 'bio_db_repo.pl', DstRepoF ),
 1595        copy_file( BioDbRepoPlF, DstRepoF )
 1596    ).
 1597
 1598bio_db_conflict_file( Delable-Full ) :-
 1599    Mess = 'Current db file might be inconsistent to new zip file. Delete db file: ~p',
 1600    Ictive = false,
 1601    % fixme: should we be passing Ictive from above ?
 1602    ui_yes_no( Ictive, Mess, [Delable], y, Reply ),
 1603    bio_db_reply_delete_file( Reply, Full ).
 1604
 1605/*
 1606bio_db_serve_pname_from_local( false, _Db, _Pname, Arity,Iface, Load, Call ) :-
 1607    ( bio_db_db_pname_source( Db, Pname, read, prolog+zip, ZLoad ) ->
 1608        fail  % .zip will be tried by caller on failure
 1609        ; 
 1610    ).
 1611    fail.
 1612    */
 1613% fixme: this is not called from anywhere? 
 1614bio_db_serve_pname_from_local( true, _Db, Pname, Arity, Iface, Load, Call ) :-
 1615    % fixme: add predicates for interogating and deleting db/interface pairs
 1616    bio_db_pl_nonpl_interface( Iface, Load, NonPlLoad ),
 1617    % fixme: add logic for deleting prolog interface of downloaded db
 1618    !,
 1619    bio_db_load_call( Pname, Arity, Iface, NonPlLoad, Call ).
 1620
 1621bio_db_pl_nonpl_interface( Iface, Load, NonPlLoad ) :-
 1622    debug( bio_db, 'Converting to interface: ~a, from file: ~p', [Iface,Load] ),
 1623    atom_concat( pl_, Iface, Stem ),
 1624    atom_concat( 'bio_db/auxil/backends/', Stem, Backend ),
 1625    ensure_loaded( pack(Backend) ),
 1626    Conv =.. [Stem,Load],
 1627    call( Conv ),
 1628    file_name_extension( LoadStem, _Pl, Load ),
 1629    bio_db_interface_extensions( Iface, [Ext|_] ),
 1630    file_name_extension( LoadStem, Ext, NonPlLoad ).
 1631
 1632bio_db_ensure_loaded( Iface, Pid, Load, Handle, From ) :-
 1633    atom( Iface ),
 1634    bio_db_ensure_loaded_1( Iface, Pid, Load, Handle, From ),
 1635    !.
 1636bio_db_ensure_loaded( Iface, Pid, Load, _Handle, _From ) :-
 1637    % fixme: Goal in error can be supplied ?
 1638    throw( failed_to_load(Iface,Pid,Load), [pack(bio_db),pred(bio_db_ensure_loaded/4)] ).
 1639
 1640bio_db_ensure_loaded_1( prolog, Pid, Load, [], From ) :-
 1641    Pid = Pname/_Arity,
 1642    atomic_list_concat( [Ppfx|_], '_', Pname ),
 1643    bio_db_pl_load( Ppfx, Pid, Load, From ).
 1644bio_db_ensure_loaded_1( prosqlite, Pname/_Arity, Load, Pname, _From ) :-
 1645    sqlite_connect( Load, Pname, [as_predicates(true),at_module(bio_db)] ).
 1646bio_db_ensure_loaded_1( berkeley, Pname/Arity, Load, Berkeley, _From ) :-
 1647    \+ '$bio_db_handle'(Pname,_),
 1648    % fixme: is the option needed ? we are just reading- check
 1649    % bio_db_info_interface( berkeley, _Pid, Load, _Handle, data_types, data_types(Ktype,Vtype) ),
 1650
 1651    Pairs = [data_types-DtTypes,relation_type-RelType],
 1652    bio_db_info_interface_kvs( berkeley, _Pid, Load, _Handle, Pairs ),
 1653    bio_db_info_interface_types( RelType, DtTypes, berkeley, Dup, _DbTypes, KeyType, ValType ),
 1654    % Open = bdb_open( Load, read, Berkeley, [duplicates(Dupl),key(KeyType),value(ValType)] ),
 1655    Open = bdb_open( Load, read, Berkeley, [dup(Dup),key(KeyType),value(ValType)] ),
 1656    debug( bio_db, 'Bdb opening for reading with: ~w' , Open ),
 1657    call( Open ),
 1658    % bdb_open( Load, read, Berkeley, [duplicates(true),key(KeyType),value(ValType)] ),  % 0.5
 1659    % retractall( '$bio_db_handle'(Pname,_) ),  % fixme: we can do some error reporting if something does exist
 1660    % assert( '$bio_db_handle'(Pname,Berkeley) ),
 1661    % atomic_list_concat( [Ppfx|_], '_', Pname ),
 1662    arg( 1, RelType, Krt ),
 1663    arg( 1, RelType, Vrt ),
 1664    ground( Arity ),
 1665    bio_db_berkeley_predicate_assert_arity( Arity, Krt, Vrt, Pname, bdb_get, bdb_enum, Berkeley ).
 1666bio_db_ensure_loaded_1( rocks, Pname/Arity, Load, Handle, _From ) :-
 1667    /*
 1668    bio_db_info_interface( rocks, _Pid, Load, _Handle, data_types, data_types(Ktype,Vtype) ),
 1669    */
 1670    Pairs = [data_types-DtTypes,relation_type-RelType],
 1671    bio_db_info_interface_kvs( rocks, _Pid, Load, _Handle, Pairs ),
 1672    bio_db_info_interface_types( RelType, DtTypes, rocks, Dup, _DbTypes, KeyType, ValType ),
 1673    % maplist( bio_db_info_rocks_singleton_type, [Ktype,Vtype], [Kbype,Vbype] ),
 1674    % ( Dup == false -> KeyType = NoDupKeyType; NoDupKeyType = term ),
 1675    % 2nd take, duplicates are now stored as lists of values
 1676    ( Dup == false -> ValType = DupValType; DupValType = term ),
 1677    Open = rocks_open( Load, Handle, [key(KeyType),value(DupValType)] ),
 1678    debug( bio_db, 'Rocks opening for reading with: ~w' , Open ),
 1679    call( Open ),
 1680
 1681    % atomic_list_concat( [Ppfx|_], '_', Pname ),
 1682    bio_db_rocks_predicate_assert_arity( Arity, Dup, Pname, rocks_get, rocks_enum, Handle ).
 1683    % bio_db_rocks_predicate_assert_arity( Kbype/Vbype, Arity, Pname, rocks_get, rocks_enum, Handle ).
 1684
 1685% bio_db_pl_load( map, Pid, Load, From ).
 1686bio_db_pl_load( _Type, Pid, Load, Mod ) :-
 1687    dynamic( Mod:Pid ),  % fixme: we should be able to remove this? 
 1688    % ensure_loaded( Load ).  % following is an elaboration of code by JW: 16.11.13:
 1689    (   (file_name_extension(Base,pl,Load), \+ current_prolog_flag(bio_db_qcompile,false))
 1690    ->  Mod:load_files( Base, [qcompile(auto),if(not_loaded)] )
 1691    ;   ensure_loaded( Mod:Load )  % fixme: use load_files/2 ?
 1692    ).
 1693
 1694% bio_db_pl_load( edge, Pname/_Arity, Load ) :-
 1695/*
 1696bio_db_pl_load( edge, Pid, Load ) :-
 1697    % os_postfix ... :(
 1698    % % file_name_extension( Base, Ext, Load ),
 1699    % % atomic_list_concat( [Base,ord], '_', OrdBase ),
 1700    % % file_name_extension( OrdBase, Ext, OrdLoad ),
 1701    % % ensure_loaded( OrdLoad ),
 1702    ensure_loaded( Load ),
 1703    % % atomic_list_concat( [Pname,ord], '_', Pord ),
 1704    % % Head =.. [Pname,X,Y,W],
 1705    % % GoalF =.. [Pord,X,Y,W],
 1706    % % GoalB =.. [Pord,Y,X,W],
 1707    % % consult_clause( (Head:-(GoalF;GoalB)) ).
 1708    true.
 1709    */
 1710
 1711    /*
 1712bio_db_kv_db_predicate_assert( _, Pname, Krt, Vrt, Arity, Get, Enum, Handle ) :-
 1713    ground( Arity ),
 1714    bio_db_kv_db_predicate_assert_arity( Arity, Krt, Vrt, Pname, Get, Enum, Handle ).
 1715bio_db_kv_db_predicate_assert( edge, Pname, Arity, Get, Enum, Handle ) :-
 1716    bio_db_kv_db_predicate_assert_edge( Arity, Pname, Get, Enum, Handle ).
 1717    */
 1718
 1719bio_db_berkeley_predicate_assert_arity( 2, 1, 1,  Pname, Get, Enum, Handle ) :-
 1720    !, % maybe this relevat to other modes too  (here mode is 2,1,1
 1721    Head =.. [Pname,Key,Value],
 1722    GetG  =.. [  Get, Handle, Key, Value ],
 1723    EnumG =.. [ Enum, Handle, Key, Value ],
 1724    Conditional =  ( ( ground(Key) -> 
 1725                    GetG
 1726                    ;
 1727                    EnumG
 1728                  )
 1729            ),
 1730    consult_clause( (Head:-(Conditional)) ).
 1731
 1732bio_db_berkeley_predicate_assert_arity( N, _, _,  Pname, Get, Enum, Handle ) :-
 1733    functor( Head, Pname, N ),
 1734    Head =.. [Pname,Key|Args],
 1735    GetG  =.. [  Get, Handle, Key, Value ],
 1736    EnumG =.. [ Enum, Handle, Key, Value ],
 1737    Conditional =  ( ( ground(Key) -> 
 1738                    GetG
 1739                    ;
 1740                    EnumG
 1741                  )
 1742            ),
 1743    Unravel = bio_db_kv_db_value( Args, Value ),
 1744    consult_clause( (Head:-(Conditional,Unravel)) ).
 1745
 1746bio_db_rocks_predicate_assert_arity( 2, false, Pname, Get, Enum, Handle ) :-
 1747    !, % maybe this relevat to other modes too  (here mode is 2, false (=no duplicates)
 1748    Head =.. [Pname,Key,Value],
 1749    GetG  =.. [  Get, Handle, Key, Value ],
 1750    EnumG =.. [ Enum, Handle, Key, Value ],
 1751    Conditional =  ( ( ground(Key) -> 
 1752                    GetG
 1753                    ;
 1754                    EnumG
 1755                  )
 1756            ),
 1757    consult_clause( (Head:-(Conditional)) ).
 1758bio_db_rocks_predicate_assert_arity( N, false, Pname, Get, Enum, Handle ) :-
 1759    N > 2,
 1760    functor( Head, Pname, N ),
 1761    Head =.. [Pname,Key|Args],
 1762    GetG  =.. [  Get, Handle, Key, Value ],
 1763    EnumG =.. [ Enum, Handle, Key, Value ],
 1764    Conditional =  ( ( ground(Key) -> 
 1765                    GetG
 1766                    ;
 1767                    EnumG
 1768                  )
 1769            ),
 1770    Unravel = bio_db_kv_db_value( Args, Value ),
 1771    consult_clause( (Head:-(Conditional,Unravel)) ).
 1772bio_db_rocks_predicate_assert_arity( 2, true, Pname, Get, Enum, Handle ) :-
 1773    !, % maybe this relevat to other modes too  (here mode is 2, false (=no duplicates)
 1774    Head =.. [Pname,Key,Value],
 1775    GetG  =.. [  Get, Handle, Key, Values ],
 1776    EnumG =.. [ Enum, Handle, Key, Values ],
 1777    Conditional =  ( ( ground(Key) -> 
 1778                    (GetG, bio_db_rocks_multi_key_value(Values,Value) )
 1779                    ;
 1780                    (EnumG, bio_db_rocks_multi_key_value(Values,Value) )
 1781                  )
 1782            ),
 1783    consult_clause( (Head:-(Conditional)) ).
 1784bio_db_rocks_predicate_assert_arity( Arity, true, Pname, Get, Enum, Handle ) :-
 1785    Arity > 2,
 1786    functor( Head, Pname, Arity ),
 1787    Head =.. [Pname,Key|Args],
 1788    GetG  =.. [  Get, Handle, Key, ValueTerm ],
 1789    EnumG =.. [ Enum, Handle, Key, ValueTerm ],
 1790    % EnuTG =.. [ Enum, Handle, Key:_X, Value ],
 1791    Conditional =  ( ( ground(Key) -> 
 1792                    ( GetG, bio_db_rocks_multi_key_value(ValueTerm,Value) )
 1793                    ;
 1794                    ( EnumG, bio_db_rocks_multi_key_value(ValueTerm,Value) )
 1795                    % ( EnumG , ( (atomic(ProvKey),ProvKey=Key);ProvKey=Key:_) )
 1796                  )
 1797                ),
 1798    Unravel = bio_db_kv_db_value( Args, Value ),
 1799    consult_clause( (Head:-(Conditional,Unravel)) ).
 1800    
 1801
 1802bio_db_rocks_multi_key_value( [H|T], Value ) :-
 1803    !,
 1804    ( Value = H; member( Value, T ) ).
 1805bio_db_rocks_multi_key_value( Value, Value ).
 1806
 1807bio_db_kv_db_value( [H], Value ) :- !, Value = H.
 1808bio_db_kv_db_value( [H|T], H+Value ) :-
 1809    bio_db_kv_db_value( T, Value ).
 1810consult_clause( Clause ) :-
 1811    assert( Clause ).
 1812
 1813/*
 1814consult_clause( Clause ) :-
 1815    tmp_file_stream(text, File, Stream),
 1816    portray_clause( Stream, Clause ),
 1817    close( Stream ),
 1818    debug( bio_db, 'Consulting from: ~p', File ),
 1819    consult( File ),
 1820    true.
 1821*/
 1822
 1823bio_db_interfaces_ext( A+B, Ext ) :-
 1824    !,
 1825    bio_db_interfaces_ext( A, AExt ),
 1826    bio_db_interfaces_ext( B, BExt ),
 1827    atomic_list_concat( [AExt,BExt], '.', Ext ).
 1828bio_db_interfaces_ext( Iface, Ext ) :-
 1829    bio_db_interface_extensions( Iface, [Ext|_] ),
 1830    !.
 1831bio_db_interfaces_ext( Ext, Ext ).
 1832
 1833bio_db_pname_source( _Org, Db, Pname, Mode, DbFaces, Src ) :-
 1834    % fixme: make it play with Org ?
 1835    bio_db_interfaces_ext( DbFaces, Ext ),
 1836    Term =.. [Db,Pname],
 1837    debug( bio_db, 'Trying DB location: ~p, mode: ~w', [Term,Mode] ),
 1838    ( absolute_file_name( Term, Src, [access(Mode),extensions([Ext]),file_errors(fail)] )
 1839      ;
 1840      (  DbFaces==rocks,
 1841         file_name_extension(Pname,rocks,Rname),
 1842        Rerm =.. [Db,Rname],
 1843        absolute_file_name(Rerm,Src,[access(Mode),file_errors(fail),file_type(directory)])
 1844      )
 1845    ),
 1846    !.
 1847% The above is a short-cut this is the long way.
 1848% Works when single db provides both maps and graphs
 1849%
 1850bio_db_pname_source( Org, Db, Pname, Mode, DbFaces, Src ) :-
 1851    bio_db_interfaces_ext( DbFaces, Ext ),
 1852    % Term =.. [Db,Pname],
 1853    bio_db_pred_name_type( Pname, Type ),
 1854    directory_file_path( Org, Type, Rel ),
 1855    % Term =.. [bio_db_data,Type], % pre Org times
 1856    Term =.. [bio_db_data,Rel],
 1857    absolute_file_name( Term, Dir ),
 1858    file_name_extension( Pname, Ext, Bname ),
 1859    directory_file_path( Dir, Db, DbDir ),
 1860    directory_file_path( DbDir, Bname, Src ),
 1861    debug( bio_db, 'Trying DB location: ~p, mode: ~w', [Src,Mode] ), % fixme: debug_call, with success/failure
 1862    ( absolute_file_name( Src, _, [access(Mode),file_errors(fail)])
 1863       ;
 1864      (  DbFaces==rocks,
 1865        absolute_file_name( Src, _, [access(Mode),file_errors(fail),file_type(directory)] )
 1866      )
 1867    ),
 1868    !.
 1869    % absolute_file_name( Pname, Src, [access(Mode),extensions([Ext]),file_errors(fail)] ).
 bio_db_source_info(+File, -InfoF)
Generate Info filename corresponding to the database filename at File.

*/

 1876bio_db_source_info( File, InfoF ) :-
 1877    file_name_extension( Stem, Ext, File ),
 1878    atom_concat( Stem, '_info', InfoStem ),
 1879    file_name_extension( InfoStem, Ext, InfoF ).
 bio_db_predicate_info(+PidOrPname, -InfoName)
Generate the information predicate name of a Pid or of Db predicate name.

*/

 1886bio_db_predicate_info( Pname/_Arity, InfoName ) :-
 1887    !,
 1888    atom_concat( Pname, '_info', InfoName ).
 1889bio_db_predicate_info( Pname, InfoName ) :-
 1890    atom( Pname ),
 1891    atom_concat( Pname, '_info', InfoName ).
 1892
 1893bio_db_pred_name_type( Pname, Type ) :-
 1894    atomic_list_concat( [_,_,Trd|_], '_', Pname ),
 1895    bio_db_pred_name_prefix_type( Trd, Type ).
 1896
 1897bio_db_pred_name_prefix_type( edge, graphs ) :- !.
 1898bio_db_pred_name_prefix_type( _, maps ).
 1899
 1900bio_db_load_call( false, Pname, Arity, Iface, File, _Call ) :-
 1901    ( Iface == prolog -> 
 1902        % ensure .qlf is created
 1903        file_name_extension( Stem, pl, File ),
 1904        Mess = 'Ensuring .qlf is also installed: ~w',
 1905        phrase('$messages':translate_message(debug(Mess,[Pname/Arity])), Lines),
 1906        print_message_lines(current_output, kind(informational), Lines),
 1907        load_files( scratch:Stem, [qcompile(auto),if(true)] ),
 1908        abolish( scratch:Pname/Arity )
 1909        ;
 1910        true
 1911    ).
 1912bio_db_load_call( true, Pname, Arity, Iface, File, Call ) :-
 1913    debug( bio_db, 'Loading pred: ~w, interface: ~a, file: ~w', [Pname/Arity,Iface,File] ),
 1914    ground( Iface ),
 1915    functor( Phead, Pname, Arity ),
 1916    ( predicate_property(Phead,imported_from(From) ) -> true; From = bio_db ),
 1917    abolish( From:Pname/Arity ),    % fixme: retractall/1 if we have problem with regenerations ?
 1918    % retractall(Phead),
 1919    atom_concat( Pname, '_info', InfoPname ),
 1920    dynamic( From:InfoPname/2 ),
 1921    % functor( Ihead, InfoPname, 2 ),
 1922    ( (From \== bio_db,\+ current_predicate(bio_db:InfoPname/2)) -> 
 1923            % fixme: test again:
 1924            From:export(InfoPname/2),
 1925            bio_db:import(From:InfoPname/2)
 1926            ;
 1927            true
 1928    ),
 1929    functor( InfoHead, InfoPname, 2),
 1930    retractall( From:InfoHead ),
 1931    bio_db_ensure_loaded( Iface, Pname/Arity, File, Handle, From ),
 1932    assert( bio_db_handle(Pname/Arity,Iface,File,Handle,From) ),
 1933    call( Call ).
 1934
 1935bio_db_predicate_type_sub_dir( edge, graphs ) :- !.
 1936bio_db_predicate_type_sub_dir( _, maps ).
 1937
 1938bio_db_map_call_db_pname( Call, Db, Pname, Arity ) :-
 1939    functor( Call, Pname, Arity ),
 1940    at_con( [Db|Parts], '_', Pname ),
 1941    bio_db_map_call_db_pname_check( Db, Parts, Pname, Arity ).
 1942    % bio_db_type_arity_check( Type, Arity ).
 1943
 1944bio_db_map_call_db_pname_check( Db, Parts, _Pname, _Arity ) :-
 1945     maplist( atom_length, [Db|Parts], [4,4,4,4] ),
 1946     !.
 1947bio_db_map_call_db_pname_check( _Db, _Parts, Pname, Arity ) :-
 1948    throw( not_a_db_pred(Pname/Arity), [pack(bio_db),pred(bio_db_serve/3)] ).
 1949
 1950% fixme: delete these 2 preds
 1951bio_db_type_arity_check( Type, Arity ) :-
 1952    bio_db_type_arity_known( Type, Arity ),
 1953    !.
 1954bio_db_type_arity_check( Type, Arity ) :-
 1955    throw( unknown_combination_of_type_arity(Type,Arity) ).
 1956
 1957% fixme: this now a bit outdated... maybe add name for special cases ?
 1958bio_db_type_arity_known( map, 2 ).
 1959bio_db_type_arity_known( map, 3 ).
 1960bio_db_type_arity_known( map, 4 ).
 1961bio_db_type_arity_known( map, 5 ).
 1962bio_db_type_arity_known( map, 7 ).
 1963bio_db_type_arity_known( edge, 3 ).
 1964bio_db_type_arity_known( edge, 2 ).
 1965
 1966bio_db_reply_delete_file( true, Local ) :-
 1967    debug( bio_db, 'Deleting file: ~p', Local ),
 1968    delete_file( Local ).
 1969bio_db_reply_delete_file( false, Local ) :-
 1970    debug( bio_db, 'NOT deleting file: ~p', Local ).
 1971
 1972/*
 1973bio_db_info_db_types( berkeley, RelType, DataTypes, Dup, DbTypes, KeyType, ValType ) :-
 1974    bio_db_info_berkeley_types( RelType, DataTypes, Dup, DbTypes, KeyType, ValType ).
 1975bio_db_info_db_types( rocks, RelType, DataTypes, Dup, DbTypes, KeyType, ValType ) :-
 1976    % bio_db_info_rocks_types( RelType, DataTypes, Dup, DbTypes, KeyType, ValType ).
 1977    bio_db_info_rocks_types( RelType, DataTypes, Dup, DbTypes, KeyType, ValType ).
 1978
 1979bio_db_info_rocks_types( relation_type(1,1), DataTypes, Dup, DbTypes, KeyType, ValType ) :- 
 1980    DataTypes =.. [data_types,PlKeyType,PlValsTypes],
 1981    bio_db_info_rocks_type( PlKeyType, KeyType ),
 1982    bio_db_info_rocks_type( PlValsTypes, ValType ),
 1983    DbTypes = [key(KeyType),value(ValType)].
 1984    */
 1985% fixme: change all the calls and remove this
 1986bio_db_info_db_types( Iface, RelType, DataTypes, Dup, DbTypes, KeyType, ValType ) :-
 1987    bio_db_info_interface_types( RelType, DataTypes, Iface, Dup, DbTypes, KeyType, ValType ).
 1988
 1989% bio_db_info_berkeley_types( relation_type(1,MR), data_types(Kt,Vt), Dup, DbTypes, KeyType, ValType ) :-   
 1990bio_db_info_interface_types( relation_type(1,MR), data_types(Kt,Vt), Iface, Dup, DbTypes, KeyType, ValType ) :- 
 1991    ( MR =:= 1 -> Dup = false; Dup = true ),
 1992    !,  % Arity = 2 (from the form of data_types...
 1993    bio_db_info_interface_type( Kt, Iface, KeyType ),
 1994    bio_db_info_interface_type( Vt, Iface, ValType ),
 1995    DbTypes = [key(KeyType),value(ValType)].
 1996bio_db_info_interface_types( relation_type(1,MR), DtTypes, Iface, Dup, DbTypes, KeyType, ValType ) :-   
 1997    ( MR =:= 1 -> Dup = false; Dup = true ),
 1998    !,  % Arity = 2 (from the form of data_types...
 1999    functor( DtTypes, _, Arity ),
 2000    Arity > 2,
 2001    !,
 2002    arg( 1, DtTypes, Kt ),
 2003    bio_db_info_interface_type( Kt, Iface, KeyType ),
 2004    ValType = term,
 2005    DbTypes = [key(KeyType),value(term)].
 2006bio_db_info_interface_types( RelType, DtTypes, Iface, Dup, DbTypes, KeyType, ValType ) :-
 2007    ( RelType = relation_type(1,1) -> Dup = false; Dup = true ),
 2008    arg( 1, DtTypes, Kt ),
 2009    functor( DtTypes, _, Arity ),
 2010    ( Arity > 2 -> ValType = term
 2011                ; 
 2012
 2013                arg( 2, DtTypes, Vt ),
 2014                    bio_db_info_interface_type( Vt, Iface, ValType )
 2015    ),
 2016    bio_db_info_interface_type( Kt, Iface, KeyType ),
 2017    DbTypes = [key(KeyType),value(term)].
 2018
 2019bio_db_info_interface_type( [Singleton], Iface, Type ) :-  !,
 2020    bio_db_info_interface_unit_type( Iface, Singleton, Type ).
 2021bio_db_info_interface_type( [_,_|_], _Iface, term ) :- !.  % a bit of a shortcut
 2022bio_db_info_interface_type( Singleton, Iface, Type ) :-
 2023    bio_db_info_interface_unit_type( Iface, Singleton, Type ).
 2024
 2025bio_db_info_interface_unit_type( berkeley, Unit, Type ) :-
 2026    bio_db_berkeley_type( Unit, Type ).
 2027bio_db_info_interface_unit_type( rocks, Unit, Type ) :-
 2028    bio_db_rocks_type( Unit, Type ).
 2029
 2030bio_db_rocks_type( term, term ).
 2031bio_db_rocks_type( atom, atom ).
 2032bio_db_rocks_type( integer, int64 ). % rocks also has int32
 2033bio_db_rocks_type( number, atom ).  % rocks has doubles and floats
 2034
 2035bio_db_berkeley_type( term, term ).
 2036bio_db_berkeley_type( atom, atom ).
 2037bio_db_berkeley_type( integer, c_long ).
 2038bio_db_berkeley_type( number, atom ).
 2039
 2040% this is a mock implementation see library(os) or library(os_) 
 2041% for the real one
 2042os_path_( Dir, File, Path ) :-
 2043    ground( Dir ),
 2044    ground( File ),
 2045    !,
 2046    directory_file_path( Dir, File, Path ).
 2047os_path_1( Dir, File, Path ) :-
 2048    ground( Path ),
 2049    directory_file_path( DirSl, File, Path ),
 2050    atom_concat( Dir, '/', DirSl ).
 2051    
 2052pack_errors:message( close_to_info(Pid) ) -->
 2053    ['Predicate: ~w, is not currently served, info depend on the opening interface.'-[Pid]].
 2054pack_errors:message( not_a_db_pred(Pid) ) -->
 2055    ['Predicate identifier: ~w, not of a db predicate.'-[Pid]].
 2056pack_errors:message( not_served(Pid) ) -->
 2057    ['Predicate: ~w, is not currently served.'-[Pid]].
 2058pack_errors:message( failed_to_load(Iface,Pid,File) ) -->
 2059    ['Failed to load predicate: ~w, for backend: ~w, from file: ~p.'-[Pid,Iface,File]].
 2060
 2061% add at_halt, close databases particularly berkeley ones
 2062:- at_halt( bio_db_close_connections ). 2063:- initialization( bio_db_paths, after_load ). 2064
 2065:- multifile sandbox:safe_primitive/1. 2066
 2067bio_sandbox_clause(sandbox:safe_primitive(bio_db:Head)) :-
 2068    module_property(bio_db, exports(PIList)),
 2069    member(Name/Arity, PIList),
 2070    (   sub_atom(Name, 0, _, _, edge_)
 2071    ;   sub_atom(Name, 0, _, _, map_)
 2072    ),
 2073    functor(Head, Name, Arity).
 2074
 2075term_expansion(bio_db_interface, Clauses) :-
 2076    findall(Clause, bio_sandbox_clause(Clause), Clauses).
 2077
 2078bio_db_interface.
 2079sandbox:safe_primitive(bio_db:bio_db_info(_,_,_)).
 2080sandbox:safe_primitive(bio_db:bio_db_info(_,_,_,_))