XSLT like transforms in Erlang using xmerl

[Vladimir Sekissov]

Good day,

Yaws has simple and excellent idea of EHTML. Here are my two cents.
XSLT like transforms in Erlang without xmerl.

Example in source (exmlt:test/0) transforms

{user, [],
     [{first_name, [], "Tom"},
      {last_name, [], "Jones"}
     ]}

to

{form,[{action,"adduser"}],
      [{table,[],
              [{tr,[{class,"rowset0"}],
                   [{td,[],"first_name"},
                    {td,[],[{input,[{name,"first_name"},{value,"Tom"}]}]}]},
               {tr,[{class,"rowset1"}],
                   [{td,[],"last_name"},
                    {td,[],[{input,[{name,"last_name"},{value,"Jones"}]}]}]}|
               {tr,[{colspan,"2"}],
                   [{td,[],[{input,[{type,"submit"},{name,"save"}]}]}]}]}]}

Best Regards,
Vladimir Sekissov

------------------------------ cut  here ---------------------------

%%%-------------------------------------------------------------------
%%% File    : exmlt.erl
%%% Author  :  <svg@REDACTED>
%%% Description : XML like EHTML transformation  
%%%
%%% Created : 10 Jan 2003 by  <svg@REDACTED>
%%%-------------------------------------------------------------------
%%
%% $Id$
%%
%% $Log$
%%
%%**
%% 
%% @doc XML like EHTML transformation
%% @end
%%*
-module(exmlt).

-export([transform/3, rule_normalize/2, text/1, default/1, r/2, param_new/3, param_set/3, param_get/2, param_find/2]).

-export([mapfold/3]).
-export([test/0]).

transform(Rs, Ps, Tree) ->
  Ctxt = create_context(Ps),
  mapfold(Rs, Ctxt, Tree).

default(Rs) ->
  r('#default#', Rs).

text(Rs) ->
  r('#text#', Rs).

r(Name, {PreHlr, PostHlr, Rs}) ->
  {Name, {wrap_pre_hlr(PreHlr), wrap_post_hlr(PostHlr), Rs}};
r(Name, Hlr) when function(Hlr) ->
  {Name, wrap_post_hlr(wrap_pre_hlr(Hlr))};
r(Name, {Hlr, Rs}) ->
  r(Name, {fun dummy_rule/2, Hlr, Rs}).

wrap_pre_hlr(Hlr) ->
  fun (Node, Ctxt) ->
      Hlr(Node, push_context(Ctxt))
  end.

wrap_post_hlr(Hlr) ->
  fun (Node0, Ctxt0) ->
      {Node1, Ctxt1} = Hlr(Node0, Ctxt0),
      {Node1, pop_context(Ctxt1)}
  end.

param_new(N, V, Cs=[C|Rest]) ->
  [orddict:store(N, V, C)|Rest].

param_set(N, V, Cs) ->
  case context_map(fun (C) ->
		       case orddict:is_key(N, C) of
			 true ->
			   {ok, ok, orddict:store(N, V, C)};
			 false ->
			   false
		       end
		   end, Cs) of
    false ->
      exit({param_undef, N});
    {ok, _, NCs} ->
      NCs
  end.
		       
param_find(N, Cs) ->
  context_map(fun (C) -> orddict:find(N, C) end, Cs).

param_get(N, Cs) ->
  case param_find(N, Cs) of
    {ok, V} ->
      V;
    _ ->
      exit({param_undef, N})
  end.

push_context(Cs) ->
  [orddict:new()|Cs].

pop_context([_|Rest]) ->
  Rest.

context_map(Fun, Cs) ->
  context_map(Fun, Cs, []).

context_map(Fun, [], _) ->
  false;
context_map(Fun, [C|Rest], A) ->
  case Fun(C) of
    Ret={ok, _} ->
      Ret;
    {ok, Res, NC} ->
      {ok, Res, lists:reverse(A) ++ [NC|Rest]};
    _ ->
      context_map(Fun, Rest, [C|A])
  end.

%%context_merge(From, To) ->
%%  lists:foldl(fun ({K, V}, D) ->
%%		  case orddict:is_key(K, D) of
%%		    true ->
%%		      orddict:store(K, V, D);
%%		     false ->
%%		      D
%%		  end
%%	      end, To, orddict:to_list(From)).

create_context(Ps) ->
  [orddict:from_list(Ps)].
%%
mapfold(Rs, Acc, Node={Name, Args}) ->
  mapfold(Rs, Acc, Node={Name, Args, []});
mapfold(Rs0, Acc0, Node0={Name0, _Args0, Cont0}) ->
  {PreHlr, PostHlr, ContRs} = match_rule(Name0, Rs0),
  {{Name1, Args1, Cont1}, Acc1} = PreHlr(Node0, Acc0),
  {Cont2, Acc2} = mapfold_content(ContRs, Acc1, [], Cont1),
  PostHlr({Name1, Args1, Cont2}, Acc2);
mapfold(Rs, Acc, Tree) when list(Tree) ->
  mapfold_content(Rs, Acc, [], Tree).

mapfold_content(_Rs, Acc, Tree, []) ->
  {lists:append(lists:reverse(Tree)), Acc};
mapfold_content(Rs, Acc0, Tree, TextNode=[I|_]) when not(is_tuple(I)) ->
  {PreHlr, PostHlr, _} = match_rule(TextNode, Rs),
  {Add1, Acc1} = PreHlr(TextNode, Acc0),
  {Add2, Acc2} = PostHlr(Add1, Acc1),
  {mk_list(Add2), Acc2};
mapfold_content(Rs, Acc0, Tree, [Node|Rest]) ->
  {Add1, Acc1} = mapfold(Rs, Acc0, Node),
  mapfold_content(Rs, Acc1, [mk_list(Add1)|Tree], Rest).

match_rule(Node, Rs) ->
  Rule = match_rule(Node, Rs, nodefault),
  rule_normalize(Rule, Rs).

match_rule(Node, [], nodefault) ->
  exit({no_rule, Node});
match_rule(Node, [], DefRule) ->
  DefRule;
match_rule(Node, [{'#default#', Rule}|Rs], nodefault) ->
  match_rule(Node, Rs, Rule);
match_rule(Name, [{Name, Rule}|_], _) when atom(Name) ->
  Rule;
%%text node
match_rule(Str, [{'#text#', Rule}|_], _) when list(Str) ->
  Rule;
match_rule(Node, [_|Rs], DefRule) ->
  match_rule(Node, Rs, DefRule).

rule_normalize(Hlr, Rs) when function(Hlr) ->
  {fun dummy_rule/2, Hlr, Rs};
rule_normalize(NRs, _) when list(NRs) ->
  {fun dummy_rule/2, fun dummy_rule/2, NRs};
rule_normalize({PostHlr, Rs}, _) when function(PostHlr) ->
  {fun dummy_rule/2, PostHlr, Rs};
rule_normalize(R={_PreHlr, _PostHlr, _NRs}, _) ->
  R.

mk_list(L) when list(L) ->
  L;
mk_list(V) ->
  [V].

dummy_rule(Node, Acc) ->
  {Node, Acc}.

test() ->
  FieldRule =
    exmlt:default(
      fun ({N, Args, Content}, Params) ->
	  Row = exmlt:param_get(rowcnt, Params),
	  NameStr = atom_to_list(N),
	  Out =
	    {tr, [{class, "rowset"++integer_to_list(Row band 16#1)}],
	     [{td, [], NameStr},
	      {td, [], [{input, [{name, NameStr}, {value, Content}|Args]}]}
	     ]},
	  {Out, exmlt:param_set(rowcnt, Row+1, Params)};
	  (V, Params) ->
	  {V, Params}
      end),
  StyleSheet =
    [exmlt:r(user,
	    {fun (Node, Params) ->
		 {Node, exmlt:param_new(rowcnt, 0, Params)}
	     end,
	     fun ({N, Args, Contents}, Params) ->
		 Out =
		   {form,
		    [{action, exmlt:param_get(action, Params)}|Args],
		    [{table, [],
		      Contents ++
		      {tr, [{colspan, "2"}],
		       [{td, [],
			 [{input, [{type, "submit"}, {name, "save"}]}]}
		       ]}
		     
		     }]
		   },
		 {Out, Params}
	     end,
	     [FieldRule]
	    })
    ],
  TestInput =
    {user, [],
     [{first_name, [], "Tom"},
      {last_name, [], "Jones"}
     ]},
  {Result, OutParams} =
    exmlt:transform(StyleSheet, [{action, "adduser"}], TestInput),
  Result.