#!/usr/bin/env /usr/bin/swipl
% lmoo-clif


:- if(use_module(library(logicmoo_utils))). :- endif.

:- in_lm_ws(use_module(library(logicmoo_webui))).
:- webui_load_swish_and_clio.


%:-  webui_start_swish_and_clio.

:- if(use_module(library(logicmoo_clif))).
:- endif.
ensure_logicmoo_arc :- ensure_loaded(library(logicmoo_arc)).


% This file is mostly all inside if/endifs so it doesnt interfere with `module/2`

:- if( \+ current_module(logicmoo_clif)).

% Load Editline/Readline
:- if( \+ current_module(prolog_history)).
:- if(set_prolog_flag(history, 50000)). :- endif.
:- if((ignore(exists_source(library(editline))->use_module(library(editline))
       ;(exists_source(library(readline)),use_module(library(readline)))),
   '$toplevel':setup_history)). :- endif.
:- endif.

% Load SWI Utils
%:- if(( \+ exists_source(library(logicmoo_utils)), 
%   prolog_load_context(directory,X),absolute_file_name('../../../..',O,[relative_to(X),file_type(directory)]), attach_packs(O))).  
%:- endif.
:- if(use_module(library(logicmoo_utils))). :- endif.

% Load PFC
:- if(set_prolog_flag(pfc_version,v(2,0,0))). :- endif.
:- if(ensure_loaded(library(pfc_lib))). :- endif.

% Load CLIF
:- if((use_module(library(logicmoo_clif)))). :- endif.

:- endif. % \+ current_module(logicmoo_clif)

:- if(assert_if_new((clifops:clif_op_decls((
 op(1199,fx,('==>')), op(1190,xfx,('::::')), op(1180,xfx,('==>')), op(1170,xfx,('<==>')), op(1160,xfx,('<-')),
 op(1150,xfx,('=>')), op(1140,xfx,('<=')), op(1130,xfx,'<=>'),
 op(1120,xfx,'<->'),
 op(600,yfx,('&')), op(600,yfx,('v')),op(350,xfx,('xor')), op(300,fx,('-')),
 op(300,fx,('~'))))))).   :- endif.


:- if((prolog_load_context(source,S),format(user_error,'~N~q,~n',[running(S)]))). :- endif.
%:- if(( \+ current_prolog_flag(test_module,_),set_prolog_flag(test_module,baseKB),assert(baseKB:this_is_baseKB))). :- endif.
%:- if(( \+ current_prolog_flag(test_typein_module,_), set_prolog_flag(test_typein_module,baseKB))). :- endif.

:- if(current_prolog_flag(loaded_test_header,_)). 
:- wdmsg(reload_of_test_header).
:- mpred_reset.
:- else.
:- if(( \+ current_prolog_flag(loaded_test_header,_),set_prolog_flag(loaded_test_header,loaded))).  :- endif.

:- if(use_module(library(prolog_pack))). :- endif.

/*
:- if(prolog_load_context(module,user)).
:- if(( current_prolog_flag(test_module,_), \+ current_prolog_flag(test_module,user), \+ current_prolog_flag(test_module,baseKB))).
% writes a temp header file and include/1s it
:- if(( tmp_file(swi, Dir), make_directory(Dir),working_directory(OLD,Dir),asserta(t_l:old_pwd(OLD,Dir)),current_prolog_flag(test_module,Module),open('module_header.pl',write,OS),
  format(OS,'\n:- module(~q,[test_header_include/0]).\n test_header_include. ',[Module]),close(OS))). :- endif.
:- include('module_header.pl').
:- retract(t_l:old_pwd(OLD,Delete)),working_directory(_,OLD),delete_directory_and_contents(Delete).
:- endif.
:- endif. % prolog_load_context(module,user)
*/
:- endif. % current_prolog_flag(loaded_test_header,_)

:- if(use_module(library(logicmoo_nlu))).
:- endif.


:- if((
    %   break,
  use_module(library(logicmoo_ec)),
     %  break,
  !)). :- endif.



:- if((current_prolog_flag(test_module,Module), '$set_source_module'(Module))). :- endif.
:- if((current_prolog_flag(test_module,Module), clifops:clif_op_decls(OPS), call(Module:OPS))). :- endif.

:- if((prolog_load_context(source,File),!,
   ignore((((sub_atom(File,_,_,_,'.pfc')
   -> (sanity(is_pfc_file),set_prolog_flag(is_pfc_file_dialect,true))
   ; nop((sanity( \+ is_pfc_file),set_prolog_flag(is_pfc_file_dialect,false))))))))).  
:- endif.

:- if((
 %set_prolog_flag(debug, true),
 %set_prolog_flag(gc, false),
 %set_prolog_flag(runtime_speed,0), % 0 = dont care
 set_prolog_flag(runtime_speed, 0), % 1 = default
 set_prolog_flag(runtime_debug, 3), % 2 = important but dont sacrifice other features for it
 set_prolog_flag(runtime_safety, 3),  % 3 = very important
 set_prolog_flag(unsafe_speedups, false),
 set_prolog_flag(logicmoo_message_hook,unknown),
 %mpred_trace_exec,
 true)).
:- endif.

% :- if(('$current_source_module'(W), '$set_typein_module'(W))). :- endif.
:- if((current_prolog_flag(test_typein_module,Module), '$set_typein_module'(Module), module(Module))). :- endif.
:- if((current_prolog_flag(test_typein_module,Module), clifops:clif_op_decls(OPS), call(Module:OPS))). :- endif.

:- if((ensure_loaded(library(logicmoo_test)))). :- endif.
/*
:- if((prolog_load_context(source,Src),set_prolog_flag(test_src,Src))). :- endif.
:- if((prolog_load_context(source,Src),add_test_info(testsuite,file,Src))). :- endif.
:- if(at_halt(system:halt_junit)). :- endif.
*/



% :- module(run_mud_server, [qsave_logicmoo/0, start_network_now/0]).

/* * module  MUD server startup script in SWI-Prolog

?tyyyyyyyyyyyy-
 ignore(( \+ exists_source(library(prologmud_sample_games/run_mud_server)),
     attach_packs('/opt/logicmoo_workspace/packs_sys'))),
 consult(library(prologmud_sample_games/run_mud_server)).

%  sudo -u prologmud_server gdb -x gdbinit -return-child-result -ex "set pagination off" -ex run -ex quit --args swipl -l run_mud_server.pl --all --nonet --noworld


C:\Users\logicmoo>rem C:\Windows\System32\runas.exe /savecred /user:remote-user :\Program Files\swipl\bin\swipl.exe\" -f \"C:\Users\remote-user\AppData\Local\swi-prolog\pack\prologmud_samples\prolog\prologmud_sample_games\run_mud_server.pl\""


?- cd(library(prologmud_sample_games)).
?- [run_mud_server].


W:\opt\logicmoo_workspace\packs_sys\logicmoo_utils\prolog;W:\opt\logicmoo_workspace\packs_sys\logicmoo_base\prolog;W:\opt\logicmoo_workspace\packs_sys\pfc\prolog;W:\opt\logicmoo_workspace\packs_sys\logicmoo_nlu\pro
log\logicmoo_nlu;W:\opt\logicmoo_workspace\packs_sys\prologmud\prolog;W:\opt\logicmoo_workspace\packs_sys\logicmoo_nlu\prolog\episodic_memory;W:\opt\logicmoo_workspace\packs_sys\logicmoo_nlu\ext\chat80;W:\opt\logicmoo_workspace\packs_sys\logicmoo_nlu\ext\ape


*/

%:- set_prolog_flag(xpce, false).

%:- reconsult('/opt/logicmoo_workspace/lib/swipl/xpce/prolog/lib/pce.pl').

% :- dynamic(pce_principal:send/2).
%:- lock_predicate(pce_principal:send/2).
% :- use_module(library(jpl)).


%:- pack_list_installed.
%:- make.
%:- listing(autoload_all).
%:- autoload_all.
:- set_prolog_flag(history, 50000).

fix_exported_ops(M):- 
  dynamic(M:'$exported_op'/3),
  dynamic(M:'$autoload'/3),
  dynamic(M:'$pldoc'/4),
  multifile(M:'$exported_op'/3),
  multifile(M:'$autoload'/3),
  multifile(M:'$pldoc'/4),
  discontiguous(M:'$exported_op'/3), 
  discontiguous(M:'$autoload'/3), 
  discontiguous(M:'$pldoc'/4),  
  !.

:-
  fix_exported_ops(rdf11),
  fix_exported_ops(logicmoo_utils),
  fix_exported_ops(phil),
  fix_exported_ops(swish_app),  
  fix_exported_ops(lemur).

pre_run_mud_server:-

 % volatile(http_log:log_stream/1),
 volatile(http_log:log_stream/2),
 %volatile(prolog_listing:opened_Source/3),
  %(current_prolog_flag(xpce, true) -> (noguitracer,tnodebug) ; true),
  fix_exported_ops(rdf11),
  fix_exported_ops(logicmoo_utils),
  fix_exported_ops(phil),
  fix_exported_ops(lemur),
  multifile(swish_help:help_files/1),
  multifile(cp_label:rdf_link/4), 
  dynamic(cp_label:rdf_link/4),
  multifile(swish_render_rdf:rdf_link/4),
  dynamic(swish_render_rdf:rdf_link/4),

  %(getenv('DISPLAY',_)->true;setenv('DISPLAY','10.0.0.78:0.0')),
  %(notrace(gtrace),nodebug),
  %set_prolog_flag(verbose_load,true),
  set_prolog_flag(pfc_version,v(2,0,0)),
  set_prolog_flag(dmsg_level,always),

  multifile(rdf_rewrite:arity/2),
  dynamic(rdf_rewrite:arity/2),!.

:- initialization(pre_run_mud_server, now).
:- initialization(pre_run_mud_server, restore_state).


never_catch:-
   current_prolog_flag(access_level,Was),
   set_prolog_flag(access_level,system),
   redefine_system_predicate(system:catch/3),
   abolish(system:catch,3),
   meta_predicate(system:catch(0,?,0)),
   meta_predicate(system:mycatch(0,?,0)),
   system:asserta((system:mycatch(G,_E,_C):- !, call(G))),
   system:asserta((catch(G,E,C):- !, mycatch(G,E,C))),
   set_prolog_flag(access_level,Was).



:- set_prolog_flag(message_ide,false).

never_notrace:-
   abolish_notrace,
   current_prolog_flag(access_level,Was),
   set_prolog_flag(access_level,system),
   redefine_system_predicate(system:notrace/1),
   abolish(system:notrace,1),
   meta_predicate(system:notrace(0)),
   system:assert((notrace(G):-once(G))),
   set_prolog_flag(access_level,Was).
%:- never_notrace.

abolish_notrace:- redefine_system_predicate(system:notrace/0),abolish(system:notrace/0),asserta(system:notrace).

never_portray:-
   current_prolog_flag(access_level,Was),
   set_prolog_flag(access_level,system),
   %abolish(prolog:portray,1),dynamic(prolog:portray/1),
   abolish(user:portray,1),dynamic(user:portray/1),
   %retractall(prolog:portray(_)),
   retractall(user:portray(_)),
   set_prolog_flag(access_level,Was).

attach_packs_relative(Rel):-
   once(((
    (working_directory(Dir,Dir);prolog_load_context(directory,Dir)),
    (absolute_file_name(Rel,PackDir,[relative_to(Dir),file_type(directory),solutions(all),file_errors(fail)]);
      absolute_file_name(Rel,PackDir,[file_type(directory),solutions(all),file_errors(fail)])),
    writeln(attach_packs(PackDir)),attach_packs(PackDir)));writeln(failed(attach_packs_relative_web(Rel)))).

load_package_dirs_0:-
  ignore(( \+ exists_source(library(logicmoo_common)), attach_packs_relative('../../..'))),
  attach_packs('/opt/logicmoo_workspace/packs_sys',[duplicate(keep)]),
  attach_packs('/opt/logicmoo_workspace/packs_lib',[duplicate(keep)]),
  attach_packs('/opt/logicmoo_workspace/packs_web',[duplicate(keep)]),
  !.

load_package_dirs_1:-
  ignore(catch(make_directory('/tmp/tempDir/pack'),_,true)),
  (user:file_search_path(pack,'/tmp/tempDir/pack') -> true ; asserta(user:file_search_path(pack,'/tmp/tempDir/pack'))),
  attach_packs('/tmp/tempDir/pack'),
  % nop(pack_install(logicmoo_utils,[upgrade(true),interactive(false)])),
  !.

load_package_dirs:-
  findall(PackDir,'$pack':pack(Pack, PackDir),Before),
  load_package_dirs_0,
  load_package_dirs_1,
  findall(PackDir,'$pack':pack(Pack, PackDir),After),
  (Before\==After -> writeln(load_package_dirs(After)) ; true),
  pack_list_installed,
  use_module(library(logicmoo_common)),
  % use_module(library(logicmoo_packs)).
  !.

:- initialization(load_package_dirs, now).
:- initialization(load_package_dirs, restore_state).


set_startup_flags:-
  set_prolog_flag(runtime_speed, 0), % 1 = default
  set_prolog_flag(runtime_debug, 3), % 2 = important but dont sacrifice other features for it
  set_prolog_flag(runtime_safety, 3),  % 3 = very important
  set_prolog_flag(unsafe_speedups, false),
  set_prolog_flag(logicmoo_message_hook,unknown),
  set_prolog_flag(encoding,text),
  set_prolog_flag(lisp_repl_goal,prolog),
  current_prolog_flag('argv',Is),writeq(current_prolog_flag('argv',Is)),!,nl,
  !.

:- initialization(set_startup_flags, now).
:- initialization(set_startup_flags, restore_state).


:- use_module(library(prolog_deps)).
:- use_module(library(logicmoo_common)).

%:- bfly.

check_lmoo_startup_flags:-
   current_prolog_flag(argv,WasArgV),
   ignore((
           \+ ((member(E,WasArgV),
                atom_concat('--',_,E))),
   append(WasArgV,[
   '--',

   '--mud', % Load MUD server
   '--world', % Load MUD server World
   %'--nonet' '--noworld',

   '--clif', % Support for CLIF
   '--sumo', % Support for SUMO
   '--nlkb', % Load CYC NL
   '--cyckb', % Load CYC KB
   '--tinykb', % Support for LarKC

   '--www', % https://logicmoo.org/*
   '--no-fork', '--workers=16', '--port=3020',
   %'--user=www-data',
   '--sigma', % Sigma Inference Engine Server  https://logicmoo.org/swish/lm_xref/
   '--cliop',  % https://logicmoo.org/cliopatria/
   '--irc', % Launch IRC Eggdrop Client
   '--swish', % https://logicmoo.org/swish/
   '--docs', % https://logicmoo.org/pldoc/
   '--plweb',   % https://logicmoo.org/plweb/

   % '--lispsock', % '--wamcl', % is already implied by --lispsock

   '--logtalk', % Support Logtalk
   '--elfinder', % Support Filesystem Browser   https://logicmoo.org/ef/
   '--nopdt', % Prolog Development for Eclipse
   '--planner', % Load any planners

   '--all', % all default options (in case there are new ones!)
   '--defaults'
   ], NewArgV),
   set_prolog_flag('argv',NewArgV))),
   current_prolog_flag(argv,Is),
   asserta(lmconf:saved_app_argv(Is)),
   writeq(set_prolog_flag('argv',Is)),!,nl.

:- initialization(check_lmoo_startup_flags, now).
:- initialization(check_lmoo_startup_flags, restore_state).

system:set_modules(M) :- '$set_typein_module'(M),'$set_source_module'(M),module(M).
system:set_modules_baseKB :-  nop(set_modules(baseKB)).

:- initialization(set_modules_baseKB, restore_state).
:- initialization(set_modules_baseKB, now).


% ==============================================
% WWW Support
% ==============================================

% :- cpack_install([prov,amalgame,skos,cpack_repository,media_cache,'EDM','cloud',trill_on_swish,ecdemo,command,rdf_qa,waisda,jquery,accurator,pirates,cluster_search_ui,skos_browser,tag_matcher,statistics,opmv,vumix]).


load_plweb :-
 % set_prolog_flag(cant_qsave_logicmoo,true),
 %ignore(( \+ exists_source(pack(plweb/pack_info)), attach_packs('/opt/logicmoo_workspace/packs_web'))),
 % :-
 attach_packs('/opt/logicmoo_workspace/packs_web/plweb/packs').
 @((
  %% user:['/opt/logicmoo_workspace/packs_web/plweb/plweb.pl'],
  user:['/opt/logicmoo_workspace/packs_web/plweb/pack.pl']

  % . doc_enable(true),call(call,call(plweb:with_mutex(plweb_init, server_init)))
  ),plweb).



% ==============================================
% ============= MUD SERVER CODE LOADING =============
% ==============================================


remove_undef_srch:- remove_undef_search.

:- before_boot(remove_undef_srch).

add_mud_history:-
  current_input(S),
  ignore(catch(prolog:history(S, load), _, true)),
  logicmoo_startup:((
  maplist(add_history,
[ (mpred_why(mudIsa(iCoffeeCup7, tSpatialThing))),
  (make:make_no_trace),
  (update_changed_files),
  (shell('./PreStartMUD.sh')),
  ([pack(logicmoo_base/t/examples/fol/'einstein_simpler_03.pfc')]),
  ([pack(logicmoo_base/t/examples/fol/'einstein_simpler_04.pfc')]),
  (make:make_no_trace),
  (load_plweb),
  (help(match_regex/2)),
  (list_undefined),
  (listing(lmconf:at_restore_goal/2)),
  (statistics),
  (make),
  (mmake),
  (login_and_run),
  ignore((prolog_load_context(file,File),forall((source_file(Code,File),strip_module(Code,_,Atom),atom(Atom)),(Code)))),
  (loadSumo),
  (loadTinyKB),
  (threads),
  (run_pending_inits),
  % (use_module(library(sexpr_reader))),
  (input_to_forms("( #\\a #\\u0009 . #\\bell )",'$VAR'('O'),'$VAR'('Vs'))),
  (tstl),
  (qconsult_kb7166),
  (qsave_logicmoo),
  (start_all),
  (load_before_compile),
  (adventure),
  (start_all),
  (start_mud_telnet),
  (lar),
  (finish_processing_world),
  (lst)]))).


%:- before_boot(add_mud_history).

zebra00:- reconsult((pack(logicmoo_base/t/examples/fol/'einstein_simpler_03.pfc'))).
% :- kif_compile.
%:- load_library_system(library(logicmoo_nlu)).
:- set_prolog_flag(ec_loader,false).
%:- abolish(system:trace,0).
%:- asserta(system:trace).
%load_lpn :- prolog_load_context(directory,D), cd('/home/prologmud_server/lpn/www'),user:[server],cd(D).
try_zebra:- 
 baseKB:((
  mpred_trace_all, run_mud_server:zebra00,
  forall(trait(P),listing(P)),
  clif_show)),
 add_history(clif_show),
 add_history(listing(person)),!.

load_nomic_mu:-
  % set_prolog_flag(cant_qsave_logicmoo,true),
  mu:ensure_loaded(library(nomic_mu)),
  add_history(srv_mu_main),
  add_history(mu:srv_mu),
  !.


% ==============================================
% =========== LOGICMOO COMPILATION =============
% ==============================================
% :- prolog_load_context(directory,D),cd(D).
dont_export(_,F,_):- atom_concat('$',_,F),!.
dont_export(M,_,_):- atom_concat('$',_,M),!.
dont_export(_,attr_unify_hook,2).
dont_export(_,attribute_goals,3).
dont_export(_,project_attributes,2).
dont_export(_,attr_portray_hook,2).
dont_export(_,portray,1).
dont_export(_,term_expansion,_).
dont_export(_,rdf_rewrite,_).
dont_export(rdf_rewrite,_,_).
dont_export(utility_translation,_,_).
dont_export(_,goal_expansion,_).
dont_export(_,clause_expansion,_).


expose_all:- !.
expose_all:-
     forall((current_predicate(M:F/A),functor(P,F,A),
       (predicate_property(M:P,imported_from(RM))->true;RM=M),
       \+ dont_export(M,F,A)),
       (catch((RM:export(RM:F/A),system:import(RM:F/A)),E,nop(dmsg(E))))).



abolish_module(M):-
 notrace(forall(
   (current_predicate(M:F/A), functor(P,F,A), \+ predicate_property(M:P, imported_from(_))),
    (predicate_property(M:P, static) -> abolish(M:F/A) ; retractall(M:P)))),!,
   (exists_file(M) -> unload_file(M) ; true).


%:-export(kaggle_arc/0).

% test LPS is not broken yet
melee:- lps_sanity(lps_tests('Melee')).
system:lps_sanity:- lps_sanity(lps_tests('binaryChop2.pl' )).
restaurant:- lps_sanity(lps_tests('restaurant')).
goat:- lps_sanity(lps_tests('goat')).
ballot:- lps_sanity(lps_tests('Ballot')).

:- dynamic(user:file_search_path/2).
:- multifile(user:file_search_path/2).
user:file_search_path(lps_tests, Dir):-
 %absolute_file_name(library('.'),LibDir,[file_type(directory),solutions(all),access(exist),file_errors(fail)]),
 member(A,['../test/lps_planner/','../test/ec_planner/abdemo_test/','../test/lps_user_examples/','../examples/']),
 absolute_file_name(library(A),Dir,[ /*relative_to(LibDir),*/ file_type(directory),solutions(all),access(exist),file_errors(fail)]),
 exists_directory(Dir).


lps_demo_tests:- lps_sanity(lps_tests('lps_demo_tests')).
lps_demo_test_1:- lps_sanity(lps_tests('lps_demo_test_1')).
lps_demo_test_2:- lps_sanity(lps_tests('lps_demo_test_2.pl')).
lps_demo_test_3:- lps_sanity(lps_tests('lps_demo_test_3.pl')).
lps_demo_test_4:- lps_sanity(lps_tests('lps_demo_test_4.pl')).
lps_demo_test_5:- lps_sanity(lps_tests('lps_demo_test_5.pl')).
lps_demo_test_9:- lps_sanity(lps_tests('lps_demo_test_9.pl')).

lps_insanity(File):-
   absolute_file_name(File,M,[access(read),extensions(['pl','P','lps','pfc.pl',''])]),
   M\==File,!,lps_insanity(M).

lps_insanity(M):-
   M:use_module(library(lps_corner)),
   interpreter:check_lps_program_module(M),
   M:unload_file(M),
   M:consult(M),
   %listing(db:actions/1),
   %listing(interpreter:actions/1),
   interpreter:get_lps_program_module(M),
   notrace(from_elsewhere:listing(M:_)),
   wdmsg(running(M)),
   % M:golps(X),
   ignore((M:godc(X),
   %listing(interpreter:lps_program_module/1),
   notrace(print_tree(X)))),!,
   run_tests_from_file(M).

run_tests_from_file(File):-
 forall((clause(ec:demo_test(Name, Type, Goal),Body,R),clause_property(R,source(File))),
  (forall(call(Body),
   (pprint_ecp_cmt(blue, do(demo_test(Name, Type))),  %Type \== slow,
     abdemo(Goal))))).

lps_sanity(File):- Limit = 110580,
 catch(call_with_depth_limit(lps_insanity(File), Limit, R), E,(R=E)),
   format(user_error,"~N ~q~n",[lps_sanity=R]),
   ((integer(R),R<Limit)-> true; (dumpST,break,fail)).


baseKB:':-'(ConsqIn):- throw(':-'(ConsqIn)).
:- baseKB:lock_predicate(':-',1).
:- '$set_predicate_attribute'(baseKB:':-'(_), system, true).
% t:/opt/logicmoo_workspace/packs_sys/logicmoo_nlu/ext/pldata/plkb7166/kb7166_pt7_constant_renames.pldata

/*
 (1) * /usr/local/share/swi-prolog/pack
   (2)   /usr/share/swi-prolog/pack
   (3)   /var/lib/snapd/desktop/swi-prolog/pack
   (4)   /etc/xdg/swi-prolog/pack

*/

:- multifile(html_write:(html_meta)/1).
:- dynamic(html_write:(html_meta)/1).
% Logicmoo temporal logic is different than NARS in that i dont believe humans learn new classifications.. we just reuse the same old 177 games that temporal of them but under differnt domains
:-  use_module(library(prolog_autoload)).
:-  use_module(library(qsave)).

keep_user_module(MGoal):-
 strip_module(MGoal,M,Goal),
   setup_call_cleanup('$current_typein_module'(WasTIM),
          setup_call_cleanup('$set_source_module'(Was,user),
           M:Goal,
          '$set_source_module'(_,Was)),
   '$set_typein_module'(WasTIM)).

:- multifile(cp_menu:(cp_menu/2)).
:- dynamic(cp_menu:(cp_menu/2)).

load_before_compile:- keep_user_module(load_before_compile_now).
load_before_compile_now:-
 call_safely([
   set_prolog_flag(ec_loader,false),
   skip_sandboxing,
   %set_prolog_flag(verbose_file_search,true),
   use_module(library(sandbox)),
   use_module(library(logicmoo_webui)),
    webui_load_swish_and_clio,
    % webui_start_swish_and_clio,
    % suppliment_cp_menu,
    % use_module(library(xlisting/xlisting_web)),
    use_module(library(logicmoo_lps)),
    %use_module(library(logicmoo/butterfly_console)),
    use_module(library(logicmoo/pretty_clauses)),

   %use_module(library(logicmoo_lps)),
   %set_prolog_flag(verbose_file_search,false),

   %:- use_module(library(logicmoo_nlu)).

   /*
   ignore(catch(pack_install(rocksdb),_,true)),
   ignore(catch(pack_install(sldnfdraw),_,true)),
   ignore(catch(pack_install(aleph),_,true)),
   ignore(catch(pack_install(phil),_,true)),
   ignore(catch(pack_install(cplint_r),_,true)),
   */
   % ignore(( \+ exists_directory('/tmp/tempDir/') -> catch(shell('./PreStartMUD.sh'),_,true))),
   % ignore(( exists_directory('/tmp/tempDir') -> cd('/tmp/tempDir'))),
    %use_module(library(pfc_lib)),
    use_module(library(xlisting/xlisting_web)),    
    baseKB:ensure_loaded(library(logicmoo_nlu)),!,
    %dumpST,prolog_load_context(file,N),upcase_atom(N,AB),print(AB),break,
    baseKB:ensure_loaded(library(logicmoo_clif)),
    %register_logicmoo_browser,
  % never_notrace,
  % bfly_set(butterfly,t),
    load_nomic_mu,
    baseKB:ensure_loaded(library(logicmoo_cg)),
    baseKB:ensure_loaded(library(logicmoo_ec)),
    baseKB:ensure_loaded(library('logicmoo/common_logic/common_logic_sumo.pfc')),
    %system:reexport(pldata(kb_0988)),
    %ensure_loaded(pldata(kb_0988)),
    baseKB:ensure_loaded(library(narsese)),
    use_module(library(instant_prolog_docs)),
    baseKB:ensure_loaded(library(logicmoo_agi)),    
    add_history(start_network)]).

start_network:- only_runtime(keep_user_module(start_network_now)).
start_network_now:-
  call_safely(
   [
   load_before_compile,
   user:use_module(library(eggdrop)),
   nop(use_module(library(discord_client))),
   egg_go,
   webui_start_swish_and_clio,
   load_plweb,
   suppliment_cp_menu,   
   threads,statistics]),
   !.

post_restore:-
  keep_user_module((
  call_safely(
  [ import_some,    
    expose_all,
    %start_network,
    %start_lsp_server,
    %kaggle_arc,
    set_modules_baseKB]))),
  wdmsg("type ?- lmoo_restore."),!.

system:lmoo_restore:- wdmsg(" Dont forget to ?- lmoo_restore_now.").
system:lmoo_restore_now:-
  keep_user_module((
  call_safely(
  [ import_some,
    baseKB:ensure_loaded(library(logicmoo_mud)),
    start_runtime_mud,
    % run_setup_now,
    baseKB:start_mud_telnet,
    % adventure,
    % lar,
    baseKB:listing(mudAtLoc),
    user:ensure_loaded('/opt/logicmoo_workspace/packs_sys/logicmoo_nlu/ext/LogicalEnglish/swish/le_for_logicmoo.pl'),
    threads]))),
   !.

start_all :- keep_user_module((start_network, post_restore)).

add_logicmoo_history:- 
  set_prolog_flag(history, 50000),
  maplist(add_history,
  [
  ((mmake, autodoc_test)),
  (swi_ide),
  ([run_mud_server]),
  (forall(chat80(XX),run_pipeline(XX))),
  (run_pipeline("is there a man who becomes the greatest tenor?")),
  (forall(((ape_test(_,X);fracas(X);e2c(X);chat80(X)),!),run_pipeline(X))),
  (never_notrace),
  (never_portray),
  (bfly_set(butterfly,t)),
  (bfly_tests),
  (test_pp),
  (x123),
  (search4term),
  (edit1term),
  (test_chat80),
  (xlisting(contains("test"))),
  (shrdlurn_eval:js_test2),
  (try_zebra),
  (reset_IO),
  %(never_catch),
  (start_lsp_server),
  (ensure_plkb0988_kb),
  (post_restore)]).
  

%start_network:-
%   load_before_compile,!.


start_lsp_server:- \+ thread_self(main),!,
 use_module(library(lsp_server)),
 lsp_server:
    
   (set_prolog_flag(toplevel_prompt, ''),
    debug(server),
    debug(server, "Starting stdio client", []),
    current_input(In),
    set_stream(In, buffer(full)),
    set_stream(In, newline(posix)),
    set_stream(In, tty(false)),
    set_stream(In, representation_errors(error)),
    % handling UTF decoding in JSON parsing, but doing the auto-translation
    % causes Content-Length to be incorrect
    set_stream(In, encoding(octet)),
    current_output(Out),
    set_stream(Out, encoding(utf8)),
    stdio_handler(A-A, In)).

start_lsp_server:- thread_property(_,alias(lsp_server)),!.
start_lsp_server:- thread_create(start_lsp_server,_,[detached(true),alias(lsp_server)]).



:- dynamic(lmconfig:has_import_module/2).
normalize_imports(M):-
 forall(current_module(M),forall(import_module(M,Inherits),
  (assertz(lmconfig:has_import_module(M,Inherits)),format('mi(~q,~q).~n',[Inherits,M])))).

normalize_and_save_imports :- forall(current_module(M),normalize_imports(M)).

check_memory(_):- current_prolog_flag(check_memory,false),!.
check_memory(_):- \+ current_prolog_flag(check_memory,true),!.
check_memory(G):-
  set_prolog_flag(debug,true),
  set_prolog_flag(report_error,true),
  set_prolog_flag(debug_on_error,true),
  prolog_load_context(file,Y),
  writeln(prolog_load_context(file,Y)),
  gensym(akill,X),
  qsave_program(X),
  catch(notrace(process_create(path(true), [], [])),
    error(resource_error(no_memory),_),
     (dumpST,wdmsg(no_memory(after,G)),break)).

system:qsave_logicmoo:- system:qsave_logicmoo(swipl).

system:qsave_logicmoo(Swipl) :-
  load_before_compile,
  (current_prolog_flag(logicmoo_compiling,Was);Was=false),
  set_prolog_flag(lisp_repl_goal,true),
  setup_call_cleanup(
    set_prolog_flag(logicmoo_compiling,done),
    qsave_bin_now(Swipl),
    set_prolog_flag(logicmoo_compiling,Was)),
  add_history(start_all),
  statistics,
  !.


import_some:- !.
import_some:-
      forall((current_predicate(baseKB:F/A),M=baseKB,functor(P,F,A),
         (predicate_property(M:P,imported_from(RM))->true;RM=M)),
         (RM:export(RM:F/A),rtrace:import(RM:F/A))),
      forall((current_predicate(M:F/A),M==baseKB,functor(P,F,A),
         (predicate_property(M:P,imported_from(RM))->true;RM=M)),
         (RM:export(RM:F/A),rtrace:import(RM:F/A))), !.


skip_sandboxing(F):- functor(P,F,1),
  (SF1 = (sandbox:F/1)),
  sandbox:redefine_system_predicate(SF1),
  sandbox:multifile(SF1),
  sandbox:dynamic(SF1),
  sandbox:asserta((P:-!)).

skip_sandboxing:-
 set_prolog_flag(no_sandbox, true),
 maplist(skip_sandboxing,
  [safe_goal,
   safe_call,
   safe_directive,
   safe_meta_predicate,
   safe_source_directive,
   safe_load_file_option,
   safe_source_directive]).

:- skip_sandboxing.

:- nop(use_module(library(discord_client))).

% :- use_module(library(pfc_lib)).

:- keep_user_module((load_before_compile)).

%:- lps_sanity.
%:- goat.


un_used:- abolish(check:cross_module_call,2),
   asserta((check:cross_module_call(_Callee, _Context):- fail)).
un_used:- abolish(error:permission_error,3),
   asserta((
    error:permission_error(Operation, PermissionType, Culprit) :-
    wdmsg((throw(error(permission_error(Operation,
                                 PermissionType,
                                 Culprit),
                _)))))).



%:- set_prolog_flag(debug,true).
:- set_prolog_flag(access_level,system).

%:- abolish( yall:(?)/0 ).
%:- delete_import_module(user,pfc_lib).

% swish_highlight:lazy_read_lines


% :- qsave_logicmoo.
%:- setenv('DISPLAY', '192.168.88.1:0.0').
%:- (notrace(gtrace),nodebug).
%:- guitracer.

% :- mu:srv_mu.



swi_ide:- \+ current_prolog_flag(xpce, true), !, wdmsg("No XPCE"). 
swi_ide:- \+ (getenv('DISPLAY',Atom),atom_length(Atom,Len),Len>0), !, wdmsg("DISPLAY not set"). 
swi_ide:- \+ exists_source(library(swi_ide)), !, wdmsg("library(swi_ide) not found"). 
swi_ide:-
   on_x_fail(prolog_ide(open_navigator)),
   on_x_fail(prolog_ide(debug_monitor)),
   on_x_fail(prolog_ide(thread_monitor)), 
   !.
  
:- initialization(add_logicmoo_history,now).
:- initialization(add_logicmoo_history,restore_state).
%:- make:make_no_trace, make.

%:- break.

%:- autoload_all.
:- if( current_prolog_flag(xpce, true) ).
:- gui_tracer:noguitracer.
%:- gui_tracer:guitracer.
:- tnodebug.
%:- tdebug.
:- endif.


%:- bfly.

%:- autoload_all.
%:- never_notrace.
%:- never_catch.

%:- lps_sanity.

% :- prolog.


%:- abolish(user:prolog_load_file/2).
%:- dynamic(user:prolog_load_file/2).
:- initialization(start_network,restore_state).
:- if( \+ logicmoo_compiling_mud_server).
:- initialization(start_network,now).
:- endif.

% :- initialization(qsave_logicmoo, main).
:- initialization(keep_user_module(initialize),restore_state).
:- if( \+ logicmoo_compiling_mud_server).
:- initialization(keep_user_module(initialize),now).
:- endif.

:- initialization(post_restore,restore_state).
:- if( \+ logicmoo_compiling_mud_server).
:- initialization(post_restore,now).
:- initialization(lmoo_restore,now).
:- endif.

%:- reset_IO.
:- add_history(qsave_program('../bin/swipl-lm',[class(development),toplevel(prolog),goal(true)])).
:- add_history(qsave_logicmoo).

:- logicmoo_compiling_mud_server -> dmsg(logicmoo_compiling_mud_server) ; wdmsg(not_logicmoo_compiling_mud_server).

:- add_history(consult(library('../ext/mkultra/Assets/logicmoo_mkultra.pl'))).

:- only_runtime(ensure_logicmoo_arc).

:- only_runtime(prolog).

end_of_file.