%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2001-2003, 2005-2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: query.m.
% Authors: conway, zs.
%
% This module contains the top level predicates for servicing individual
% queries.
%
% This module defines the types of commands and preferences. It provides
% mechanisms for converting queries to strings and strings to queries, but
% it does not expose the encoding. The encoding is compositional; each
% component of the query (say x) has a x_to_string function to convert it to
% a string and a string_to_x predicate to try to convert a string fragment
% back to it. The function/predicate pairs are adjacent to make it easy to
% update both at the same time. This is essential, because we have no other
% mechanism to ensure that the URLs embedded in the HTML pages generated by
% the mdprof_cgi tool will be recognized and correctly parsed by mdprof_cgi.
%
%---------------------------------------------------------------------------%

:- module query.
:- interface.

:- import_module measurement_units.
:- import_module profile.

:- import_module bool.
:- import_module maybe.

%---------------------------------------------------------------------------%
%
% Reading and writing queries.
%

    % A deep profiler query.
    %
:- type deep_query
    --->    deep_query(
                maybe_cmd                   :: maybe(cmd),
                deep_file_name              :: string,
                maybe_prefs                 :: maybe(preferences)
            ).

    % A subtype of the above, with a mandatory command field.
    %
:- inst deep_query_with_cmd for deep_query/0
    --->    deep_query(bound(yes(ground)), ground, ground).

:- type cmd
    --->    deep_cmd_quit
    ;       deep_cmd_restart
    ;       deep_cmd_timeout(
                cmd_timeout_minutes             :: int
            )
    ;       deep_cmd_menu
    ;       deep_cmd_root(
                % If set to yes(Action), chase the dominant call sites
                % until we get to a clique that is responsible for less than
                % or equal to Action percent of the program's total callseqs.
                cmd_root_maybe_action           :: maybe(int)
            )
    ;       deep_cmd_clique(
                cmd_clique_clique_id            :: clique_ptr
            )
    ;       deep_cmd_clique_recursive_costs(
                % Construct formulas for calculating the costs of the
                % recursive calls within this clique.
                cmd_crc_clique_id               :: clique_ptr
            )
    ;       deep_cmd_proc(
                cmd_proc_proc_id                :: proc_static_ptr
            )
    ;       deep_cmd_proc_callers(
                cmd_pc_proc_id                  :: proc_static_ptr,
                cmd_pc_called_groups            :: caller_groups,
                cmd_pc_bunch_number             :: int,
                cmd_pc_callers_per_bunch        :: int,
                cmd_pc_contour_exclusion        :: contour_exclusion
            )
    ;       deep_cmd_static_procrep_coverage(
                cmd_static_coverage_ps          :: proc_static_ptr
            )
    ;       deep_cmd_dynamic_procrep_coverage(
                cmd_dynamic_coverage_pd         :: proc_dynamic_ptr
            )
    ;       deep_cmd_call_site_dynamic_var_use(
                cmd_csdvu_id                    :: call_site_dynamic_ptr
            )
    ;       deep_cmd_recursion_types_frequency
                % Generate a frequency table about how often each recursion
                % type occurs in the program.
    ;       deep_cmd_program_modules
    ;       deep_cmd_module(
                cmd_module_module_name          :: string
            )
    ;       deep_cmd_module_getter_setters(
                cmd_mgs_module_name             :: string
            )
    ;       deep_cmd_module_rep(
                cmd_mr_module_name              :: string
            )
    ;       deep_cmd_top_procs(
                cmd_tp_display_limit            :: display_limit,
                cmd_tp_sort_cost_kind           :: cost_kind,
                cmd_tp_incl_desc                :: include_descendants,
                cmd_tp_scope                    :: measurement_scope
            )

    % The following commands are for debugging.

    ;       deep_cmd_dump_clique(
                cmd_dcl_id                      :: clique_ptr
            )
    ;       deep_cmd_dump_proc_static(
                cmd_dps_id                      :: proc_static_ptr
            )
    ;       deep_cmd_dump_proc_dynamic(
                cmd_dpd_id                      :: proc_dynamic_ptr
            )
    ;       deep_cmd_dump_call_site_static(
                cmd_dcss_id                     :: call_site_static_ptr
            )
    ;       deep_cmd_dump_call_site_dynamic(
                cmd_dcsd_id                     :: call_site_dynamic_ptr
            ).

:- type caller_groups
    --->    group_by_call_site
    ;       group_by_proc
    ;       group_by_module
    ;       group_by_clique.

:- type cost_kind
    --->    cost_calls
    ;       cost_redos
    ;       cost_time
    ;       cost_callseqs
    ;       cost_allocs
    ;       cost_words.

:- type include_descendants
    --->    self
    ;       self_and_desc.

:- type descendants_meaningful
    --->    descendants_meaningful
    ;       descendants_not_meaningful.

:- type display_limit
    --->    rank_range(int, int)
            % rank_range(M, N): display procedures with rank M to N,
            % both inclusive.

    ;       threshold_percent(float)
            % threshold(Percent): display procedures whose cost is at least
            % Percent% of the whole program's cost.

    ;       threshold_value(float).
            % threshold_value(Value): display procedures whose cost is at least
            % this value.

:- type preferences
    --->    preferences(
                % The set of fields to display.
                pref_fields         :: fields,

                % Whether displays should be boxed.
                pref_box            :: box_tables,

                % What principle governs colours.
                pref_colour         :: colour_column_groups,

                % The max number of ancestors to display.
                pref_anc            :: maybe(int),

                % The max number of proc statics to display for each recursion
                % type group in the recursion type frequency report.
                pref_proc_statics_per_rec_type
                                    :: int,

                % Whether pages should summarize at higher order call sites.
                pref_summarize      :: summarize_ho_call_sites,

                % The criteria for ordering lines in pages, if the command
                % doesn't specify otherwise.
                pref_criteria       :: order_criteria,

                % Whether contour exclusion should be applied. The commands
                % that depend on this setting take a contour value as an
                % argument that will override this setting. However, we do not
                % want to require users to restate their preferences about
                % contour exclusion over and over again, so we store their
                % preference here. A link from a page for which contour
                % exclusion is irrelevant to a page for which it is relevant
                % can pick up the preferred value of this parameter from here.
                pref_contour        :: contour_exclusion,

                pref_time           :: time_format,

                pref_module_qual    :: module_qual,

                % Whether we should show modules/procs that haven't been
                % called.
                pref_inactive       :: inactive_items,

                % Whether to show developer-only options.
                pref_developer_mode :: developer_mode
            ).

:- type preferences_indication
    --->    given_pref(preferences)
    ;       default_pref
    ;       all_pref.

:- type port_fields
    --->    no_port
    ;       port.

:- type time_fields
    --->    no_time
    ;       ticks
    ;       time
    ;       ticks_and_time
    ;       time_and_percall
    ;       ticks_and_time_and_percall.

:- type callseqs_fields
    --->    no_callseqs
    ;       callseqs
    ;       callseqs_and_percall.

:- type alloc_fields
    --->    no_alloc
    ;       alloc
    ;       alloc_and_percall.

:- type memory_fields
    --->    no_memory
    ;       memory(memory_units)
    ;       memory_and_percall(memory_units).

:- type fields
    --->    fields(
                port_fields     :: port_fields,
                time_fields     :: time_fields,
                callseqs_fields :: callseqs_fields,
                alloc_fields    :: alloc_fields,
                memory_fields   :: memory_fields
            ).

:- type box_tables
    --->    box_tables
    ;       do_not_box_tables.

:- type colour_column_groups
    --->    colour_column_groups
    ;       do_not_colour_column_groups.

:- type summarize_ho_call_sites
    --->    summarize_ho_call_sites
    ;       do_not_summarize_ho_call_sites.

:- type order_criteria
    --->    by_context
    ;       by_name
    ;       by_cost(
                cost_kind,
                include_descendants,
                measurement_scope
            ).

:- type measurement_scope
    --->    per_call
    ;       overall.

:- type contour_exclusion
    --->    apply_contour_exclusion
    ;       do_not_apply_contour_exclusion.

:- type time_format
    --->    no_scale
    ;       scale_by_millions
    ;       scale_by_thousands.

:- type module_qual
    --->    module_qual_always
    ;       module_qual_when_diff
    ;       module_qual_never.

:- type inactive_status
    --->    inactive_hide
    ;       inactive_show.

:- type inactive_items
    --->    inactive_items(
                inactive_call_sites :: inactive_status,
                inactive_procs      :: inactive_status,
                inactive_modules    :: inactive_status
            ).

:- type developer_mode
    --->    developer_options_visible
    ;       developer_options_invisible.

%---------------------------------------------------------------------------%

:- func query_to_string(deep_query) = string.
:- mode query_to_string(in(deep_query_with_cmd)) = out is det.

:- func string_to_maybe_query(string) = maybe(deep_query).

:- func string_to_maybe_cmd(string) = maybe(cmd).

:- func string_to_maybe_pref(string) = maybe(preferences).

%---------------------------------------------------------------------------%

:- pred try_exec(cmd::in, preferences::in, deep::in, string::out) is cc_multi.

%---------------------------------------------------------------------------%

    % Return "yes" if it is worth displaying times for this profile.
    %
:- func should_display_times(deep) = bool.

:- func default_command = cmd.

:- func solidify_preference(deep, preferences_indication) = preferences.

:- func default_preferences(deep) = preferences.

:- func default_fields(deep) = fields.
:- func all_fields = fields.
:- func default_box_tables = box_tables.
:- func default_colour_column_groups = colour_column_groups.
:- func default_ancestor_limit = maybe(int).
:- func default_proc_statics_per_rec_type_limit = int.
:- func default_summarize_ho_call_sites = summarize_ho_call_sites.
:- func default_order_criteria = order_criteria.
:- func default_cost_kind = cost_kind.
:- func default_incl_desc = include_descendants.
:- func default_scope = measurement_scope.
:- func default_contour_exclusion = contour_exclusion.
:- func default_time_format = time_format.
:- func default_module_qual = module_qual.
:- func default_inactive_items = inactive_items.
:- func default_developer_mode = developer_mode.

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.

:- import_module create_report.
:- import_module display_report.
:- import_module html_format.
:- import_module report.
:- import_module util.

:- import_module char.
:- import_module exception.
:- import_module int.
:- import_module io.
:- import_module list.
:- import_module string.
:- import_module univ.

%---------------------------------------------------------------------------%
%
% Converting whole queries to and from strings.
%

query_to_string(DeepQuery) = String :-
    DeepQuery = deep_query(yes(Cmd), DeepFileName, MaybePreferences),
    (
        MaybePreferences = yes(Preferences),
        PreferencesString = preferences_to_string(Preferences)
    ;
        MaybePreferences = no,
        PreferencesString = ""
    ),
    String = cmd_to_string(Cmd) ++
        string.char_to_string(query_separator_char) ++
        PreferencesString ++
        string.char_to_string(query_separator_char) ++
        DeepFileName.

string_to_maybe_query(String) = MaybeDeepQuery :-
    ( if
        split_query_string(String, MaybeCmdStr, MaybePrefStr, DeepFileName)
    then
        (
            MaybeCmdStr = no,
            MaybeCmd = no
        ;
            MaybeCmdStr = yes(CmdStr),
            MaybeCmd = yes(string_to_cmd(CmdStr, deep_cmd_menu))
        ),
        (
            MaybePrefStr = yes(PrefStr),
            MaybePreferences = string_to_maybe_pref(PrefStr)
        ;
            MaybePrefStr = no,
            MaybePreferences = no
        ),
        MaybeDeepQuery =
            yes(deep_query(MaybeCmd, DeepFileName, MaybePreferences))
    else
        MaybeDeepQuery = no
    ).

    % Break up the string into separate pieces.
    % There may be one, two or three pieces.
    %
:- pred split_query_string(string::in, maybe(string)::out, maybe(string)::out,
    string::out) is semidet.

split_query_string(QueryString, MaybeCmdStr, MaybePrefStr, DeepFileName) :-
    split(QueryString, query_separator_char, Pieces),
    ( if Pieces = [DeepFileName0] then
        MaybeCmdStr = no,
        MaybePrefStr = no,
        DeepFileName = DeepFileName0
    else if Pieces = [CmdStr, DeepFileName0] then
        MaybeCmdStr = yes(CmdStr),
        MaybePrefStr = no,
        DeepFileName = DeepFileName0
    else if Pieces = [CmdStr, PrefsStr, DeepFileName0] then
        MaybeCmdStr = yes(CmdStr),
        MaybePrefStr = yes(PrefsStr),
        DeepFileName = DeepFileName0
    else
        fail
    ).

%---------------------------------------------------------------------------%
%
% Converting commands to and from strings.
%

:- func cmd_to_string(cmd) = string.

cmd_to_string(Cmd) = CmdStr :-
    (
        Cmd = deep_cmd_quit,
        CmdStr = cmd_str_quit
    ;
        Cmd = deep_cmd_restart,
        CmdStr = cmd_str_restart
    ;
        Cmd = deep_cmd_timeout(Minutes),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_timeout), c(cmd_separator_char), i(Minutes)])
    ;
        Cmd = deep_cmd_menu,
        CmdStr = cmd_str_menu
    ;
        Cmd = deep_cmd_root(MaybePercent),
        (
            MaybePercent = yes(Percent),
            CmdStr = string.format("%s%c%d",
                [s(cmd_str_root), c(cmd_separator_char), i(Percent)])
        ;
            MaybePercent = no,
            CmdStr = string.format("%s%c%s",
                [s(cmd_str_root), c(cmd_separator_char), s("no")])
        )
    ;
        (
            Cmd = deep_cmd_clique(CliquePtr),
            Name = cmd_str_clique
        ;
            Cmd = deep_cmd_clique_recursive_costs(CliquePtr),
            Name = cmd_str_clique_recursive_costs
        ),
        CliquePtr = clique_ptr(CliqueNum),
        CmdStr = string.format("%s%c%d",
            [s(Name), c(cmd_separator_char), i(CliqueNum)])
    ;
        Cmd = deep_cmd_recursion_types_frequency,
        CmdStr = cmd_str_recursion_types_frequency
    ;
        Cmd = deep_cmd_proc(PSPtr),
        PSPtr = proc_static_ptr(PSI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_proc), c(cmd_separator_char), i(PSI)])
    ;
        Cmd = deep_cmd_proc_callers(PSPtr, GroupCallers, BunchNum,
            CallersPerBunch, Contour),
        PSPtr = proc_static_ptr(PSI),
        GroupCallersStr = caller_groups_to_string(GroupCallers),
        ContourStr = contour_exclusion_to_string(Contour),
        CmdStr = string.format("%s%c%d%c%s%c%d%c%d%c%s",
            [s(cmd_str_proc_callers),
            c(cmd_separator_char), i(PSI),
            c(cmd_separator_char), s(GroupCallersStr),
            c(cmd_separator_char), i(BunchNum),
            c(cmd_separator_char), i(CallersPerBunch),
            c(cmd_separator_char), s(ContourStr)])
    ;
        Cmd = deep_cmd_program_modules,
        CmdStr = cmd_str_program_modules
    ;
        Cmd = deep_cmd_module(ModuleName),
        CmdStr = string.format("%s%c%s",
            [s(cmd_str_module), c(cmd_separator_char), s(ModuleName)])
    ;
        Cmd = deep_cmd_module_getter_setters(ModuleName),
        CmdStr = string.format("%s%c%s",
            [s(cmd_str_module_getter_setters), c(cmd_separator_char),
            s(ModuleName)])
    ;
        Cmd = deep_cmd_module_rep(ModuleName),
        CmdStr = string.format("%s%c%s",
            [s(cmd_str_module_rep), c(cmd_separator_char), s(ModuleName)])
    ;
        Cmd = deep_cmd_top_procs(Limit, CostKind, InclDesc, Scope),
        LimitStr = limit_to_string(Limit),
        CostKindStr = cost_kind_to_string(CostKind),
        InclDescStr = incl_desc_to_string(InclDesc),
        ScopeStr = scope_to_string(Scope),
        CmdStr = string.format("%s%c%s%c%s%c%s%c%s",
            [s(cmd_str_top_procs),
            c(cmd_separator_char), s(LimitStr),
            c(cmd_separator_char), s(CostKindStr),
            c(cmd_separator_char), s(InclDescStr),
            c(cmd_separator_char), s(ScopeStr)])
    ;
        Cmd = deep_cmd_static_procrep_coverage(PSPtr),
        PSPtr = proc_static_ptr(PSI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_static_coverage), c(cmd_separator_char), i(PSI)])
    ;
        Cmd = deep_cmd_dynamic_procrep_coverage(PDPtr),
        PDPtr = proc_dynamic_ptr(PDI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_dynamic_coverage), c(cmd_separator_char), i(PDI)])
    ;
        Cmd = deep_cmd_dump_proc_static(PSPtr),
        PSPtr = proc_static_ptr(PSI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_dump_proc_static), c(cmd_separator_char), i(PSI)])
    ;
        Cmd = deep_cmd_dump_proc_dynamic(PDPtr),
        PDPtr = proc_dynamic_ptr(PDI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_dump_proc_dynamic), c(cmd_separator_char), i(PDI)])
    ;
        Cmd = deep_cmd_dump_call_site_static(CSSPtr),
        CSSPtr = call_site_static_ptr(CSSI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_dump_call_site_static), c(cmd_separator_char), i(CSSI)])
    ;
        Cmd = deep_cmd_dump_call_site_dynamic(CSDPtr),
        CSDPtr = call_site_dynamic_ptr(CSDI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_dump_call_site_dynamic), c(cmd_separator_char),
                i(CSDI)])
    ;
        Cmd = deep_cmd_dump_clique(CliquePtr),
        CliquePtr = clique_ptr(CliqueNum),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_dump_raw_clique), c(cmd_separator_char), i(CliqueNum)])
    ;
        Cmd = deep_cmd_call_site_dynamic_var_use(CSDPtr),
        CSDPtr = call_site_dynamic_ptr(CSDI),
        CmdStr = string.format("%s%c%d",
            [s(cmd_str_call_site_dynamic_var_use), c(cmd_separator_char),
                i(CSDI)])
    ).

:- func string_to_cmd(string, cmd) = cmd.

string_to_cmd(QueryString, DefaultCmd) = Cmd :-
    MaybeCmd = string_to_maybe_cmd(QueryString),
    (
        MaybeCmd = yes(Cmd)
    ;
        MaybeCmd = no,
        Cmd = DefaultCmd
    ).

string_to_maybe_cmd(QueryString) = MaybeCmd :-
    split(QueryString, pref_separator_char, Pieces),
    ( if
        Pieces = [cmd_str_root, MaybePercentStr],
        ( if MaybePercentStr = "no" then
            MaybePercent = no
        else if string.to_int(MaybePercentStr, Percent) then
            MaybePercent = yes(Percent)
        else
            fail
        )
    then
        Cmd = deep_cmd_root(MaybePercent),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_clique, CliqueNumStr],
        string.to_int(CliqueNumStr, CliqueNum)
    then
        CliquePtr = clique_ptr(CliqueNum),
        Cmd = deep_cmd_clique(CliquePtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_clique_recursive_costs, CliqueNumStr],
        string.to_int(CliqueNumStr, CliqueNum)
    then
        CliquePtr = clique_ptr(CliqueNum),
        Cmd = deep_cmd_clique_recursive_costs(CliquePtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_recursion_types_frequency]
    then
        Cmd = deep_cmd_recursion_types_frequency,
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_proc, PSIStr],
        string.to_int(PSIStr, PSI)
    then
        PSPtr = proc_static_ptr(PSI),
        Cmd = deep_cmd_proc(PSPtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_proc_callers, PSIStr, GroupCallersStr, BunchNumStr,
            CallersPerBunchStr, ContourStr],
        string.to_int(PSIStr, PSI),
        string_to_caller_groups(GroupCallersStr, GroupCallers),
        string.to_int(BunchNumStr, BunchNum),
        string.to_int(CallersPerBunchStr, CallersPerBunch),
        string_to_contour_exclusion(ContourStr, Contour)
    then
        PSPtr = proc_static_ptr(PSI),
        Cmd = deep_cmd_proc_callers(PSPtr, GroupCallers, BunchNum,
            CallersPerBunch, Contour),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_program_modules]
    then
        Cmd = deep_cmd_program_modules,
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_module, ModuleName]
    then
        Cmd = deep_cmd_module(ModuleName),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_module_getter_setters, ModuleName]
    then
        Cmd = deep_cmd_module_getter_setters(ModuleName),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_module_rep, ModuleName]
    then
        Cmd = deep_cmd_module_rep(ModuleName),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_top_procs, LimitStr, CostKindStr, InclDescStr,
            ScopeStr],
        string_to_limit(LimitStr, Limit),
        string_to_cost_kind(CostKindStr, CostKind),
        string_to_incl_desc(InclDescStr, InclDesc),
        string_to_scope(ScopeStr, Scope)
    then
        Cmd = deep_cmd_top_procs(Limit, CostKind, InclDesc, Scope),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_static_coverage, PSIStr],
        string.to_int(PSIStr, PSI)
    then
        PSPtr = proc_static_ptr(PSI),
        MaybeCmd = yes(deep_cmd_static_procrep_coverage(PSPtr))
    else if
        Pieces = [cmd_str_dynamic_coverage, PDIStr],
        string.to_int(PDIStr, PDI)
    then
        PDPtr = proc_dynamic_ptr(PDI),
        MaybeCmd = yes(deep_cmd_dynamic_procrep_coverage(PDPtr))
    else if
        Pieces = [cmd_str_menu]
    then
        Cmd = deep_cmd_menu,
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_dump_proc_static, PSIStr],
        string.to_int(PSIStr, PSI)
    then
        PSPtr = proc_static_ptr(PSI),
        Cmd = deep_cmd_dump_proc_static(PSPtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_dump_proc_dynamic, PDIStr],
        string.to_int(PDIStr, PDI)
    then
        PDPtr = proc_dynamic_ptr(PDI),
        Cmd = deep_cmd_dump_proc_dynamic(PDPtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_dump_call_site_static, CSSIStr],
        string.to_int(CSSIStr, CSSI)
    then
        CSSPtr = call_site_static_ptr(CSSI),
        Cmd = deep_cmd_dump_call_site_static(CSSPtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_dump_call_site_dynamic, CSDIStr],
        string.to_int(CSDIStr, CSDI)
    then
        CSDPtr = call_site_dynamic_ptr(CSDI),
        Cmd = deep_cmd_dump_call_site_dynamic(CSDPtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_dump_raw_clique, CliqueNumStr],
        string.to_int(CliqueNumStr, CliqueNum)
    then
        CliquePtr = clique_ptr(CliqueNum),
        Cmd = deep_cmd_dump_clique(CliquePtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_call_site_dynamic_var_use, CSDIStr],
        string.to_int(CSDIStr, CSDI)
    then
        CSDPtr = call_site_dynamic_ptr(CSDI),
        Cmd = deep_cmd_call_site_dynamic_var_use(CSDPtr),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_timeout, TimeOutStr],
        string.to_int(TimeOutStr, TimeOut)
    then
        Cmd = deep_cmd_timeout(TimeOut),
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_restart]
    then
        Cmd = deep_cmd_restart,
        MaybeCmd = yes(Cmd)
    else if
        Pieces = [cmd_str_quit]
    then
        Cmd = deep_cmd_quit,
        MaybeCmd = yes(Cmd)
    else
        MaybeCmd = no
    ).

%---------------------%

    % Constant strings used in command links and parsing.
    %
:- func cmd_str_quit = string.
cmd_str_quit = "quit".

:- func cmd_str_restart = string.
cmd_str_restart = "restart".

:- func cmd_str_timeout = string.
cmd_str_timeout = "timeout".

:- func cmd_str_menu = string.
cmd_str_menu = "menu".

:- func cmd_str_root = string.
cmd_str_root = "root".

:- func cmd_str_clique = string.
cmd_str_clique = "clique".

:- func cmd_str_clique_recursive_costs = string.
cmd_str_clique_recursive_costs = "clique_rc".

:- func cmd_str_recursion_types_frequency = string.
cmd_str_recursion_types_frequency = "recursion_type_freq".

:- func cmd_str_proc = string.
cmd_str_proc = "proc".

:- func cmd_str_proc_callers = string.
cmd_str_proc_callers = "proc_callers".

:- func cmd_str_program_modules = string.
cmd_str_program_modules = "program_modules".

:- func cmd_str_module = string.
cmd_str_module = "module".

:- func cmd_str_module_getter_setters = string.
cmd_str_module_getter_setters = "module_getter_setters".

:- func cmd_str_module_rep = string.
cmd_str_module_rep = "module_rep".

:- func cmd_str_top_procs = string.
cmd_str_top_procs = "top_procs".

:- func cmd_str_static_coverage = string.
cmd_str_static_coverage = "proc_static_coverage".

:- func cmd_str_dynamic_coverage = string.
cmd_str_dynamic_coverage = "proc_dynamic_coverage".

:- func cmd_str_dump_proc_static = string.
cmd_str_dump_proc_static = "dump_proc_static".

:- func cmd_str_dump_proc_dynamic = string.
cmd_str_dump_proc_dynamic = "dump_proc_dynamic".

:- func cmd_str_dump_call_site_static = string.
cmd_str_dump_call_site_static = "dump_call_site_static".

:- func cmd_str_dump_call_site_dynamic = string.
cmd_str_dump_call_site_dynamic = "dump_call_site_dynamic".

:- func cmd_str_dump_raw_clique = string.
cmd_str_dump_raw_clique = "dump_raw_clique".

:- func cmd_str_call_site_dynamic_var_use = string.
cmd_str_call_site_dynamic_var_use = "call_site_dynamic_var_use".

%---------------------%

:- func caller_groups_to_string(caller_groups) = string.

caller_groups_to_string(CallerGroups) = String :-
    string_to_caller_groups(String, CallerGroups).

:- pred string_to_caller_groups(string, caller_groups).
:- mode string_to_caller_groups(in, out) is semidet.
:- mode string_to_caller_groups(out, in) is det.

string_to_caller_groups("cs", group_by_call_site).
string_to_caller_groups("pr", group_by_proc).
string_to_caller_groups("mo", group_by_module).
string_to_caller_groups("cl", group_by_clique).

%---------------------%

:- func limit_to_string(display_limit) = string.

limit_to_string(rank_range(Lo, Hi)) =
    string.format("%d%c%d", [i(Lo), c(limit_separator_char), i(Hi)]).
limit_to_string(threshold_percent(Threshold)) =
    string.format("p%g", [f(Threshold)]).
limit_to_string(threshold_value(Value)) =
    string.format("v%g", [f(Value)]).

:- pred string_to_limit(string::in, display_limit::out) is semidet.

string_to_limit(LimitStr, Limit) :-
    ( if
        split(LimitStr, limit_separator_char, Pieces),
        Pieces = [FirstStr, LastStr],
        string.to_int(FirstStr, First),
        string.to_int(LastStr, Last)
    then
        Limit = rank_range(First, Last)
    else if
        string.append("p", PercentStr, LimitStr),
        string.to_float(PercentStr, Threshold)
    then
        Limit = threshold_percent(Threshold)
    else if
        string.append("v", ValueStr, LimitStr),
        string.to_float(ValueStr, Value)
    then
        Limit = threshold_value(Value)
    else
        fail
    ).

:- func cost_kind_to_string(cost_kind) = string.

cost_kind_to_string(CostKind) = String :-
    string_to_cost_kind(String, CostKind).

:- pred string_to_cost_kind(string, cost_kind).
:- mode string_to_cost_kind(in, out) is semidet.
:- mode string_to_cost_kind(out, in) is det.

string_to_cost_kind("calls",    cost_calls).
string_to_cost_kind("redos",    cost_redos).
string_to_cost_kind("time",     cost_time).
string_to_cost_kind("callseqs", cost_callseqs).
string_to_cost_kind("allocs",   cost_allocs).
string_to_cost_kind("words",    cost_words).

:- func incl_desc_to_string(include_descendants) = string.

incl_desc_to_string(InclDesc) = String :-
    string_to_incl_desc(String, InclDesc).

:- pred string_to_incl_desc(string, include_descendants).
:- mode string_to_incl_desc(in, out) is semidet.
:- mode string_to_incl_desc(out, in) is det.

string_to_incl_desc("self", self).
string_to_incl_desc("both", self_and_desc).

:- func scope_to_string(measurement_scope) = string.

scope_to_string(Scope) = String :-
    string_to_scope(String, Scope).

:- pred string_to_scope(string, measurement_scope).
:- mode string_to_scope(in, out) is semidet.
:- mode string_to_scope(out, in) is det.

string_to_scope("pc", per_call).
string_to_scope("oa",  overall).

%---------------------------------------------------------------------------%
%
% Converting preferences to and from strings.
%

:- func preferences_to_string(preferences) = string.

preferences_to_string(Pref) = PrefStr :-
    Pref = preferences(Fields, Box, Colour, MaybeAncestorLimit,
        ProcStaticsPerRecTypeLimit, SummarizeHoCallSites, Order, Contour,
        Time, ModuleQual, InactiveItems, DeveloperMode),
    (
        MaybeAncestorLimit = yes(AncestorLimit),
        MaybeAncestorLimitStr =
            string.format("%d", [i(AncestorLimit)])
    ;
        MaybeAncestorLimit = no,
        MaybeAncestorLimitStr = "no"
    ),
    PrefStr = string.format("%s%c%s%c%s%c%s%c%d%c%s%c%s%c%s%c%s%c%s%c%s%c%s",
        [s(fields_to_string(Fields)),
        c(pref_separator_char), s(box_to_string(Box)),
        c(pref_separator_char), s(colour_scheme_to_string(Colour)),
        c(pref_separator_char), s(MaybeAncestorLimitStr),
        c(pref_separator_char), i(ProcStaticsPerRecTypeLimit),
        c(pref_separator_char), s(summarize_to_string(SummarizeHoCallSites)),
        c(pref_separator_char), s(order_criteria_to_string(Order)),
        c(pref_separator_char), s(contour_exclusion_to_string(Contour)),
        c(pref_separator_char), s(time_format_to_string(Time)),
        c(pref_separator_char), s(module_qual_to_string(ModuleQual)),
        c(pref_separator_char), s(inactive_items_to_string(InactiveItems)),
        c(pref_separator_char), s(developer_mode_to_string(DeveloperMode))
    ]).

string_to_maybe_pref(QueryString) = MaybePreferences :-
    split(QueryString, pref_separator_char, Pieces),
    ( if
        Pieces = [FieldsStr, BoxStr, ColourStr,
            MaybeAncestorLimitStr, ProcStaticsPerRecTypeLimitStr,
            SummarizeHoCallSitesStr, OrderStr, ContourStr, TimeStr,
            ModuleQualStr, InactiveItemsStr, DeveloperModeStr],
        string_to_fields(FieldsStr, Fields),
        string_to_box(BoxStr, Box),
        string_to_colour_scheme(ColourStr, Colour),
        ( if string.to_int(MaybeAncestorLimitStr, AncestorLimit) then
            MaybeAncestorLimit = yes(AncestorLimit)
        else if MaybeAncestorLimitStr = "no" then
            MaybeAncestorLimit = no
        else
            fail
        ),
        string.to_int(ProcStaticsPerRecTypeLimitStr,
            ProcStaticsPerRecTypeLimit),
        string_to_summarize(SummarizeHoCallSitesStr, SummarizeHoCallSites),
        string_to_order_criteria(OrderStr, Order),
        string_to_contour_exclusion(ContourStr, Contour),
        string_to_time_format(TimeStr, Time),
        string_to_module_qual(ModuleQualStr, ModuleQual),
        string_to_inactive_items(InactiveItemsStr, InactiveItems),
        string_to_developer_mode(DeveloperModeStr, DeveloperMode)
    then
        Preferences = preferences(Fields, Box, Colour, MaybeAncestorLimit,
            ProcStaticsPerRecTypeLimit, SummarizeHoCallSites, Order, Contour,
            Time, ModuleQual, InactiveItems, DeveloperMode),
        MaybePreferences = yes(Preferences)
    else
        MaybePreferences = no
    ).

%---------------------------------------------------------------------------%

:- func fields_to_string(fields) = string.

fields_to_string(fields(Port, Time, CallSeqs, Allocs, Memory)) =
    port_fields_to_string(Port) ++
    string.char_to_string(field_separator_char) ++
    time_fields_to_string(Time) ++
    string.char_to_string(field_separator_char) ++
    callseqs_fields_to_string(CallSeqs) ++
    string.char_to_string(field_separator_char) ++
    alloc_fields_to_string(Allocs) ++
    string.char_to_string(field_separator_char) ++
    memory_fields_to_string(Memory).

:- pred string_to_fields(string::in, fields::out) is semidet.

string_to_fields(FieldsStr, Fields) :-
    ( if
        split(FieldsStr, field_separator_char, Pieces),
        Pieces = [PortStr, TimeStr, CallSeqsStr, AllocStr, MemoryStr],
        string_to_port_fields(PortStr, Port),
        string_to_time_fields(TimeStr, Time),
        string_to_callseqs_fields(CallSeqsStr, CallSeqs),
        string_to_alloc_fields(AllocStr, Alloc),
        string_to_memory_fields(MemoryStr, Memory)
    then
        Fields = fields(Port, Time, CallSeqs, Alloc, Memory)
    else
        fail
    ).

%---------------------%

:- func port_fields_to_string(port_fields) = string.

port_fields_to_string(PortFields) = String :-
    string_to_port_fields(String, PortFields).

:- pred string_to_port_fields(string, port_fields).
:- mode string_to_port_fields(in, out) is semidet.
:- mode string_to_port_fields(out, in) is det.

string_to_port_fields("_", no_port).
string_to_port_fields("p", port).

:- func time_fields_to_string(time_fields) = string.

time_fields_to_string(TimeFields) = String :-
    string_to_time_fields(String, TimeFields).

:- pred string_to_time_fields(string, time_fields).
:- mode string_to_time_fields(in, out) is semidet.
:- mode string_to_time_fields(out, in) is det.

string_to_time_fields("_",   no_time).
string_to_time_fields("q",   ticks).
string_to_time_fields("t",   time).
string_to_time_fields("qt",  ticks_and_time).
string_to_time_fields("tp",  time_and_percall).
string_to_time_fields("qtp", ticks_and_time_and_percall).

:- func callseqs_fields_to_string(callseqs_fields) = string.

callseqs_fields_to_string(AllocFields) = String :-
    string_to_callseqs_fields(String, AllocFields).

:- pred string_to_callseqs_fields(string, callseqs_fields).
:- mode string_to_callseqs_fields(in, out) is semidet.
:- mode string_to_callseqs_fields(out, in) is det.

string_to_callseqs_fields("_", no_callseqs).
string_to_callseqs_fields("s", callseqs).
string_to_callseqs_fields("S", callseqs_and_percall).

:- func alloc_fields_to_string(alloc_fields) = string.

alloc_fields_to_string(AllocFields) = String :-
    string_to_alloc_fields(String, AllocFields).

:- pred string_to_alloc_fields(string, alloc_fields).
:- mode string_to_alloc_fields(in, out) is semidet.
:- mode string_to_alloc_fields(out, in) is det.

string_to_alloc_fields("_", no_alloc).
string_to_alloc_fields("a", alloc).
string_to_alloc_fields("A", alloc_and_percall).

:- func memory_fields_to_string(memory_fields) = string.

memory_fields_to_string(MemoryFields) = String :-
    string_to_memory_fields(String, MemoryFields).

:- pred string_to_memory_fields(string, memory_fields).
:- mode string_to_memory_fields(in, out) is semidet.
:- mode string_to_memory_fields(out, in) is det.

string_to_memory_fields("_", no_memory).
string_to_memory_fields("b", memory(units_bytes)).
string_to_memory_fields("w", memory(units_words)).
string_to_memory_fields("B", memory_and_percall(units_bytes)).
string_to_memory_fields("W", memory_and_percall(units_words)).

%---------------------%

:- func box_to_string(box_tables) = string.

box_to_string(Box) = String :-
    string_to_box(String, Box).

:- pred string_to_box(string, box_tables).
:- mode string_to_box(in, out) is semidet.
:- mode string_to_box(out, in) is det.

string_to_box("box",   box_tables).
string_to_box("nobox", do_not_box_tables).

:- func colour_scheme_to_string(colour_column_groups) = string.

colour_scheme_to_string(Scheme) = String :-
    string_to_colour_scheme(String, Scheme).

:- pred string_to_colour_scheme(string, colour_column_groups).
:- mode string_to_colour_scheme(in, out) is semidet.
:- mode string_to_colour_scheme(out, in) is det.

string_to_colour_scheme("cols", colour_column_groups).
string_to_colour_scheme("none", do_not_colour_column_groups).

:- func summarize_to_string(summarize_ho_call_sites) = string.

summarize_to_string(summarize_ho_call_sites) = "sum".
summarize_to_string(do_not_summarize_ho_call_sites) = "nosum".

:- pred string_to_summarize(string::in, summarize_ho_call_sites::out)
    is semidet.

string_to_summarize("sum",   summarize_ho_call_sites).
string_to_summarize("nosum", do_not_summarize_ho_call_sites).

:- func order_criteria_to_string(order_criteria) = string.

order_criteria_to_string(by_context) = "context".
order_criteria_to_string(by_name) = "name".
order_criteria_to_string(by_cost(CostKind, InclDesc, Scope)) =
    "cost" ++
    string.char_to_string(criteria_separator_char) ++
    cost_kind_to_string(CostKind) ++
    string.char_to_string(criteria_separator_char) ++
    incl_desc_to_string(InclDesc) ++
    string.char_to_string(criteria_separator_char) ++
    scope_to_string(Scope).

:- pred string_to_order_criteria(string::in, order_criteria::out) is semidet.

string_to_order_criteria(CriteriaStr, Criteria) :-
    ( if
        CriteriaStr = "context"
    then
        Criteria = by_context
    else if
        CriteriaStr = "name"
    then
        Criteria = by_name
    else if
        split(CriteriaStr, criteria_separator_char, Pieces),
        Pieces = ["cost", CostKindStr, InclDescStr, ScopeStr],
        string_to_cost_kind(CostKindStr, CostKind),
        string_to_incl_desc(InclDescStr, InclDesc),
        string_to_scope(ScopeStr, Scope)
    then
        Criteria = by_cost(CostKind, InclDesc, Scope)
    else
        fail
    ).

:- func contour_exclusion_to_string(contour_exclusion) = string.

contour_exclusion_to_string(Contour) = String :-
    string_to_contour_exclusion(String, Contour).

:- pred string_to_contour_exclusion(string, contour_exclusion).
:- mode string_to_contour_exclusion(in, out) is semidet.
:- mode string_to_contour_exclusion(out, in) is det.

string_to_contour_exclusion("ac", apply_contour_exclusion).
string_to_contour_exclusion("nc", do_not_apply_contour_exclusion).

:- func time_format_to_string(time_format) = string.

time_format_to_string(no_scale)           = "no".
time_format_to_string(scale_by_millions)  = "mi".
time_format_to_string(scale_by_thousands) = "th".

:- pred string_to_time_format(string, time_format).
:- mode string_to_time_format(in, out) is semidet.
:- mode string_to_time_format(out, in) is det.

string_to_time_format("no", no_scale).
string_to_time_format("mi", scale_by_millions).
string_to_time_format("th", scale_by_thousands).

:- func module_qual_to_string(module_qual) = string.

module_qual_to_string(module_qual_always) = "mqa".
module_qual_to_string(module_qual_when_diff) = "mqwd".
module_qual_to_string(module_qual_never) = "mqn".

:- pred string_to_module_qual(string::in, module_qual::out) is semidet.

string_to_module_qual("mqa",  module_qual_always).
string_to_module_qual("mqwd", module_qual_when_diff).
string_to_module_qual("mqn",  module_qual_never).

:- func inactive_items_to_string(inactive_items) = string.

inactive_items_to_string(Items) = String :-
    string_to_inactive_items(String, Items).

:- pred string_to_inactive_items(string, inactive_items).
:- mode string_to_inactive_items(in, out) is semidet.
:- mode string_to_inactive_items(out, in) is det.

string_to_inactive_items("hhh",
    inactive_items(inactive_hide, inactive_hide, inactive_hide)).
string_to_inactive_items("hhs",
    inactive_items(inactive_hide, inactive_hide, inactive_show)).
string_to_inactive_items("hsh",
    inactive_items(inactive_hide, inactive_show, inactive_hide)).
string_to_inactive_items("hss",
    inactive_items(inactive_hide, inactive_show, inactive_show)).
string_to_inactive_items("shh",
    inactive_items(inactive_show, inactive_hide, inactive_hide)).
string_to_inactive_items("shs",
    inactive_items(inactive_show, inactive_hide, inactive_show)).
string_to_inactive_items("ssh",
    inactive_items(inactive_show, inactive_show, inactive_hide)).
string_to_inactive_items("sss",
    inactive_items(inactive_show, inactive_show, inactive_show)).

:- func developer_mode_to_string(developer_mode) = string.

developer_mode_to_string(DevMode) = String :-
    string_to_developer_mode(String, DevMode).

:- pred string_to_developer_mode(string, developer_mode).
:- mode string_to_developer_mode(in, out) is semidet.
:- mode string_to_developer_mode(out, in) is det.

string_to_developer_mode("dev", developer_options_visible).
string_to_developer_mode("nodev", developer_options_invisible).

%---------------------------------------------------------------------------%

:- func query_separator_char = char.
:- func cmd_separator_char = char.
:- func pref_separator_char = char.
:- func criteria_separator_char = char.
:- func field_separator_char = char.
:- func limit_separator_char = char.

query_separator_char = ('&').
cmd_separator_char = ('/').
pref_separator_char = ('/').
criteria_separator_char = ('-').
field_separator_char = ('-').
limit_separator_char = ('-').

%---------------------------------------------------------------------------%

try_exec(Cmd, Pref, Deep, HTML) :-
    try(exec(Cmd, Pref, Deep), Result),
    (
        Result = succeeded(HTML)
    ;
        Result = exception(Exception),
        ( if univ_to_type(Exception, MsgPrime) then
            Msg = MsgPrime
        else if univ_to_type(Exception, software_error(ErrorMsg)) then
            Msg = "internal software error: " ++ ErrorMsg
        else if univ_to_type(Exception, domain_error(DomainMsg)) then
            Msg = "domain error: " ++ DomainMsg
        else
            Msg = "unknown exception",
            trace [compile_time(flag("query_exception")), io(!DebugIO)] (
                io.open_output("/tmp/deep_profiler_exception_debug",
                    DebugResult, !DebugIO),
                (
                    DebugResult = ok(DebugStream),
                    io.write(DebugStream, Exception, !DebugIO),
                    io.close_output(DebugStream, !DebugIO)
                ;
                    DebugResult = error(_)
                )
            )
        ),
        HTML = string.format("<H3>AN EXCEPTION HAS OCCURRED: %s</H3>\n",
            [s(Msg)])
    ).

:- pred exec(cmd::in, preferences::in, deep::in, string::out) is det.

exec(Cmd, Prefs, Deep, HTMLStr) :-
    ( if slow_cmd(Cmd) then
        create_and_memoize_report(Cmd, Deep, Report)
    else
        create_report(Cmd, Deep, Report)
    ),
    Display = report_to_display(Deep, Prefs, Report),
    HTMLStr = htmlize_display(Deep, Prefs, Display).

    % slow_cmd(Cmd) is slow for any command that is slow and is probably going
    % to be executed more than once.
    %
:- pred slow_cmd(cmd::in) is semidet.

slow_cmd(deep_cmd_recursion_types_frequency).

:- pred create_and_memoize_report(cmd::in, deep::in, deep_report::out) is det.
:- pragma memo(create_and_memoize_report(in, in, out),
    [disable_warning_if_ignored, specified([value, addr, output])]).

create_and_memoize_report(Cmd, Deep, Report) :-
    create_report(Cmd, Deep, Report).

%---------------------------------------------------------------------------%

should_display_times(Deep) = ShouldDisplayTimes :-
    UserQuanta = Deep ^ profile_stats ^ prs_user_quanta,
    ( if UserQuanta > minimum_meaningful_quanta then
        ShouldDisplayTimes = yes
    else
        ShouldDisplayTimes = no
    ).

    % Display times only if the profile was derived from a run that ran for
    % at least this many quanta.
    %
:- func minimum_meaningful_quanta = int.

minimum_meaningful_quanta = 10.

default_command = deep_cmd_menu.

solidify_preference(Deep, PrefInd) = Pref :-
    (
        PrefInd = given_pref(Pref)
    ;
        PrefInd = default_pref,
        Pref = default_preferences(Deep)
    ;
        PrefInd = all_pref,
        Pref = default_preferences(Deep) ^ pref_fields := all_fields
    ).

default_preferences(Deep) =
    preferences(
        default_fields(Deep),
        default_box_tables,
        default_colour_column_groups,
        default_ancestor_limit,
        default_proc_statics_per_rec_type_limit,
        default_summarize_ho_call_sites,
        default_order_criteria,
        default_contour_exclusion,
        default_time_format,
        default_module_qual,
        default_inactive_items,
        default_developer_mode
    ).

default_fields(Deep) = Fields :-
    ShouldDisplayTimes = should_display_times(Deep),
    (
        ShouldDisplayTimes = yes,
        Time = ticks
    ;
        ShouldDisplayTimes = no,
        Time = no_time
    ),
    Fields = fields(port, Time, callseqs, no_alloc, memory(units_words)).

all_fields = fields(port, ticks_and_time_and_percall, callseqs_and_percall,
    alloc, memory(units_words)).

default_box_tables = box_tables.
default_colour_column_groups = colour_column_groups.
default_ancestor_limit = yes(5).
default_proc_statics_per_rec_type_limit = 20.
default_summarize_ho_call_sites = do_not_summarize_ho_call_sites.
default_order_criteria = by_context.
default_cost_kind = cost_callseqs.
default_incl_desc = self_and_desc.
default_scope = overall.
default_contour_exclusion = do_not_apply_contour_exclusion.
default_time_format = scale_by_thousands.
default_module_qual = module_qual_when_diff.
default_inactive_items =
    inactive_items(inactive_hide, inactive_hide, inactive_hide).
default_developer_mode = developer_options_invisible.

%---------------------------------------------------------------------------%
:- end_module query.
%---------------------------------------------------------------------------%
