% ----------------------------------------------------------------------
% BEGIN LICENSE BLOCK
% Version: CMPL 1.1
%
% The contents of this file are subject to the Cisco-style Mozilla Public
% License Version 1.1 (the "License"); you may not use this file except
% in compliance with the License.  You may obtain a copy of the License
% at www.eclipseclp.org/license.
% 
% Software distributed under the License is distributed on an "AS IS"
% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
% the License for the specific language governing rights and limitations
% under the License. 
% 
% The Original Code is  The format library for ECLiPSe
% Contributor(s): Joachim Schimpf, 2025
% 
% END LICENSE BLOCK
% ----------------------------------------------------------------------

:- module(format, [format/2, format/3], eclipse_language).

:- use_module(library(error)).


% Implements PIP-0110, which implies:
% - not accepting non-list in Args
% - don't allow negative parameters (SP does)
% - unused numeric parameters are quietly ignored (rather than error)
% - ~0f prints x (like in SWI, not x.0 like in SP)
% 
% Not in PIP:
% - ~@ (goal failure is caught and ignored)


:- tool(format/2, format_/3).
format_(Cs, Args, M) :-
        format_(output, Cs, Args, M).

:- tool(format/3, format_/4).
format_(Stream, Text, Args, M) :-
        text_to_string(Text, String),
        string_codes(String, Cs),
        must_be(list, Args),
        format(Cs, Args, M, [], 0, 0, Out),
        % Emit list Out to Stream
        ( foreach(Item,Out), param(Stream) do
            ( integer(Item) -> put(Stream, Item)
            ; atom(Item) -> write(Stream, Item)
            ; string(Item) -> write(Stream, Item)
            ; Item = nl(N) -> (for(_,1,N), param(Stream) do nl(Stream))
            ; Item = pad(N,C) -> (for(_,1,N), param(Stream,C) do put(Stream, C))
            )
        ).

/*
% Pass proper lists, listify non-lists, error for improper lists
list_or_listify(XorXs, Xs) :-
        sepia_kernel:list_end(XorXs, T),
        ( var(T) -> instantiation_error(XorXs) % including var(XorXs)
        ; T == [] ->  Xs = XorXs
        ; XorXs = [_|_] -> type_error(list, XorXs)
        ; Xs = [XorXs]
        ).
*/

% format(+Chars, +Args, +Module, +Pads, +ColStart, +Col, -Out)
format([], Args, _M, Pads, _Start, _Pos, []) :-
        ( foreach(0,Pads) do true ),
        ( Args == [] -> true ; domain_error(empty_list, Args) ).
format([C|Cs], Args, M, Pads, Start, Col, Out) :-
        ( C == 0'~ ->
            phrase(opt_int(Par, Args, Args1), Cs, Cs1),
            ( Cs1 = [F|Cs2] -> true ; domain_error(missing_format_char, Cs) ),
            format_char(F, Par, Cs2, Args1, M, Pads, Start, Col, Out)
        ;
            Out = [C|Out1],
            Col1 is Col + 1,
            format(Cs, Args, M, Pads, Start, Col1, Out1)
        ).


expect_arg(_, [], _) :- !, domain_error(non_empty_list, []).
expect_arg(X, [X|Xs], Xs).

expect_expr(Number, Args, Args1) :-
        expect_arg(Expr, Args, Args1),
        Number is Expr.


% Parse optional (signed) integer, or take from argument list
opt_int(N, Args0, Args) -->
        ( [0'*] ->
            { expect_expr(N0, Args0, Args), must_be(nonneg, N0), N = N0 }
        ; [0'`,N0] ->
            { must_be(code, N0), N = N0, Args = Args0 }
        ; int(0, N0) ->
            { N = N0, Args = Args0 }
        ;
            { Args = Args0 }    % leave N uninstantiated
        ).

int(N0, N) -->
        [C],
        { integer(C), 0'0 =< C, C =< 0'9, N1 is 10*N0+(C-0'0) },
        ( int(N1, N2) -> { N = N2 } ; { N = N1 } ).


% format_char(+Fmt, ?Par, +Cs, +Args, +Module, +Pads, +ColStart, +Col, -Out)
% Col is the line position, but under the assumption that the current
% column does not have any padding yet.
:- mode format_char(+,?,+,+,+,+,+,+,-).
format_char(0'~, _Par, Cs, Args, M, Pads, Start, Col, [0'~|Out]) :- !,
        Col1 is Col+1,
        format(Cs, Args, M, Pads, Start, Col1, Out).

format_char(0'n, Par, Cs, Args, M, Pads, _Start, _Col, [nl(Par)|T]) :- !,
        ( foreach(0,Pads) do true ),
        default(Par, 1),
        format(Cs, Args, M, [], 0, 0, T).

format_char(0'N, _Par, Cs, Args, M, Pads, _Start, Col, T) :- !,
        ( foreach(0,Pads) do true ),
        ( Col == 0 -> format(Cs, Args, M, [], 0, 0, T)
        ; T = [nl(1)|T1], format(Cs, Args, M, [], 0, 0, T1)
        ).

format_char(0'i, _Par, Cs, Args, M, Pads, Start, Col, T) :- !,
        expect_arg(_Ignore, Args, Args1),
        format(Cs, Args1, M, Pads, Start, Col, T).

format_char(0'@, _Par, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_arg(Goal, Args, Args1),
        open(string(""), write, Buf),
        get_stream(output, Output),
        set_stream(output, Buf),
        ( 
            \+ catch(Goal, Ball, (set_stream(output, Output), throw(Ball)))@M,
            fail
        ;
            true
        ),
        set_stream(output, Output),
        get_stream_info(Buf, name, String),
        close(Buf),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).


%
% Terms
%
format_char(0'k, _Par, Cs, Args, M, Pads, Start, Col, [String|Out]) :- !,
        expect_arg(Arg, Args, Args1),
        open(string(""), write, S),
        write_canonical(S, Arg)@M,
        get_stream_info(S, name, String),
        close(S),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, Out).

format_char(0'p, _Par, Cs, Args, M, Pads, Start, Col, [String|Out]) :- !,
        expect_arg(Arg, Args, Args1),
        open(string(""), write, S),
        print(S, Arg)@M,
        get_stream_info(S, name, String),
        close(S),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, Out).

format_char(0'q, _Par, Cs, Args, M, Pads, Start, Col, [String|Out]) :- !,
        expect_arg(Arg, Args, Args1),
        open(string(""), write, S),
        writeq(S, Arg)@M,
        get_stream_info(S, name, String),
        close(S),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, Out).

format_char(0'w, _Par, Cs, Args, M, Pads, Start, Col, [String|Out]) :- !,
        expect_arg(Arg, Args, Args1),
        open(string(""), write, S),
        write(S, Arg)@M,
        get_stream_info(S, name, String),
        close(S),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, Out).

format_char(0'W, _Par, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_arg(Term, Args, Args1),
        expect_arg(Options, Args1, Args2),
        open(string(""), write, S),
        write_term(S, Term, Options)@M,
        get_stream_info(S, name, String),
        close(S),
        Col1 is Col+string_length(String), 
        format(Cs, Args2, M, Pads, Start, Col1, T).


%
% Characters and strings
%
format_char(0'a, _Par, Cs, Args, M, Pads, Start, Col, [Arg|Out]) :- !,
        expect_arg(Arg, Args, Args1),
        ( atom(Arg) -> Col1 is Col+atom_length(Arg)
        ; string(Arg) -> Col1 is Col+string_length(Arg)
        ; var(Arg) -> instantiation_error(Arg)
        ; type_error(atom_or_string, Arg)
        ),
        format(Cs, Args1, M, Pads, Start, Col1, Out).

format_char(0'c, Par, Cs, Args, M, Pads, Start, Col, T) :- !,
        expect_expr(Arg, Args, Args1),
        must_be(code, Arg),
        default(Par, 1),
        Col1 is Col+Par,
        ( for(_,1,Par), fromto(T,[Arg|T1],T1,T2), param(Arg) do true ),
        format(Cs, Args1, M, Pads, Start, Col1, T2).

format_char(0's, Par, Cs, Args, M, Pads, Start, Col, T) :- !,
        expect_arg(Arg, Args, Args1),
        text_to_string(Arg, FullString),
        string_length(FullString, Len),
        ( integer(Par) ->
            Col1 is Col+Par,
            ( Par < Len ->
                T = [String|T1],
                substring(FullString, 0, Par, _, String)
            ; Pad is Par-Len, Pad > 0 ->
                T = [FullString,pad(Pad,0' )|T1]
            ;
                T = [FullString|T1]
            )
        ;
            T = [FullString|T1],
            Col1 is Col+Len
        ),
        format(Cs, Args1, M, Pads, Start, Col1, T1).

%
% Padding
%
format_char(0't, Code, Cs, Args, M, Pads, Start, Col, [pad(Pad,Code)|T1]) :- !,
        default(Code, 0' ),
        format(Cs, Args, M, [Pad|Pads], Start, Col, T1).

format_char(0'|, Pos, Cs, Args, M, Pads, _Start, Col, T) :- !,
        default(Pos, Col),
        Col1 is max(Pos, Col),
        Padding is Col1-Col,
        ( Pads == [] ->
            % pad here (at the end of the column)
            T = [pad(Padding,0' )|T1]
        ;
            % distribute padding over all ~t in this column
            T = T1,
            length(Pads, NPads),
            MinPad is Padding // NPads,
            ExtraPad is Padding rem NPads,
            ( foreach(Pad,Pads), fromto(ExtraPad,XP1,XP2,0), param(MinPad) do
                Pad is MinPad + sgn(XP1),
                XP2 is XP1 - sgn(XP1)
            )
        ),
        format(Cs, Args, M, [], Col1, Col1, T1).

format_char(0'+, ColWidth, Cs, Args, M, Pads, Start, Col, T) :- !,
        default(ColWidth, 8),
        Pos is Start+ColWidth,
        format_char(0'|, Pos, Cs, Args, M, Pads, Start, Col, T).

%
% Numbers
%
format_char(0'd, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 0),
        format_d(Decimals, _SepChar, Arg, String),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'D, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 0),
        format_d(Decimals, 0',, Arg, String),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'r, Radix, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        must_be(integer, Arg),
        default(Radix, 8),
        must_be(between(2,36), Radix),
        sprintf(String, "%*r", [Radix,Arg]),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'R, Radix, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        must_be(integer, Arg),
        default(Radix, 8),
        must_be(between(2,36), Radix),
        sprintf(String, "%*R", [Radix,Arg]),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'f, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 6),
        sprintf(String, "%.*f", [Decimals,Arg]),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'F, Decimals, Cs, Args, M, Pads, Start, Col, T) :- !,
        format_char(0'f, Decimals, Cs, Args, M, Pads, Start, Col, T).

format_char(0'e, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 6),
        sprintf(String, "%.*e", [Decimals,Arg]),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'E, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 6),
        sprintf(String, "%.*E", [Decimals,Arg]),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'g, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 6),
        sprintf(String, "%.*g", [Decimals,Arg]),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'G, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 6),
        % Until sprintf supports G:
        sprintf(StringLower, "%.*g", [Decimals,Arg]),
        string_upper(StringLower, String),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(0'E, Decimals, Cs, Args, M, Pads, Start, Col, [String|T]) :- !,
        expect_expr(Arg, Args, Args1),
        default(Decimals, 6),
        sprintf(String, "%.*E", [Decimals,Arg]),
        Col1 is Col+string_length(String), 
        format(Cs, Args1, M, Pads, Start, Col1, T).

format_char(Fmt, _Par, _Cs, _Args, _M, _Pads, _Start, _Col, _T) :-
        char_code(FmtChar, Fmt),
        domain_error(format_character, FmtChar).



print_chunked(S, SepChar, SignedX) :- var(SepChar),
        printf(S, "%d", SignedX).
print_chunked(S, SepChar, SignedX) :- nonvar(SepChar),
        ( SignedX==0 ->
            put(S, 0'0)
        ;
            ( SignedX>0 -> X = SignedX
            ; put(S, 0'-), X is -SignedX
            ),
            ( fromto(X,X1,X2,0), fromto([],Chunks1,[Chunk|Chunks1],Chunks) do
                X2 is X1 // 1000,
                Chunk is X1 mod 1000
            ),
            Chunks = [First|Chunks2],
            printf(S, "%d", First),
            ( foreach(Chunk,Chunks2), param(S,SepChar) do
                put(S, SepChar),
                printf(S, "%03d", Chunk)
            )
        ).

format_d(Decimals, SepChar, Arg, String) :-
        must_be(integer, Arg),
        open(string(""), write, S),
        ( Decimals =< 0 ->
            print_chunked(S, SepChar, Arg)
        ;
            Scale is 10^Decimals,
            Int is Arg // Scale,
            Frac is abs(Arg rem Scale),
            ( Int == 0, Arg < 0 ->
                printf(S, "-0.%0*d", [Decimals,Frac])
            ;
                print_chunked(S, SepChar, Int),
                printf(S, ".%0*d", [Decimals,Frac])
            )
        ),
        get_stream_info(S, name, String),
        close(S).

default(X, Default) :- var(X), X=Default.
default(X, _Default) :- nonvar(X).

