#! lua
-- weave version 5 (library)
(getmetatable "").__call = string.format
local LIST in require "list"

local check = \ (x)
  local t = type (x)
  local ok = (t == "string") or (t == "table")
  => ok and x
  end

local tag = setmetatable ({ },
--[[
TAG.label (attr) (text) -->  <label attr>text</label>
TAG.label ( ) (text)    -->  <label>text</label>
TAG.label (attr) ( )    -->  <label attr>
TAG.label ( ) ( )       -->  <label>
--]]
      { __index = \ (_, label)
          => \ (attr)
  attr = check (attr)
  label = check (label)
  local a
  if attr then
    a = { [[<]], label, [[ ]], attr, [[>]] }
  else
    a = { [[<]], label, [[>]] }
  end -- if
   => \ (text) => (text and { a, text, [[</]], label, [[>]] }) or a
  end end end; } )

local SET = setmetatable ({ },
--[[
SET.label (val) --> label="val"
--]]
     { __index = \ (_, label)
          =>  \ (adr)
          adr = check (adr)
          label = check (label)
          => { label, [[="]], adr, [["]] } end
         end; })

local put = \ (s, ...)
          s[1 + #s] = { ... }
          end

local mesg = "\nError: bad rope, found a %s <<<\n"
local walk = \ (x, action)
          local f
          f = \ (y, g)
            local ytype = type (y)
            if ytype == "string" then
                if g and #y > 0 then g (y) end -- if
                => true
             end -- if
            if ytype ~= "table" then
                if g then g (mesg (ytype))  end
                => false
            end -- if
            local o = true
            for i, v in ipairs (y) do
               local ok = f (v, g)
               o = o and ok
             end -- for
             => o
           end
          => f (x, action)
          end

local nl = [[

]]

local charset = \ (x)
               => {
 [[http-equiv="Content-Type" content="text/html; charset=]];
 x; [["]]; }
                 end

local CLASS = SET.class
local STYLE = SET.style

local leafaction = \ (f) => \ (s)
    if s and #s > 0 then f:write (s) end -- if
    end end -- function function

local css_style = \ (x) => {
  [[rel="stylesheet" href="]]; x;
  [[" type="text/css"]]; }
  end
local mk_css
mk_css = \ (x)
  x = check (x)
  local type_x = type (x)
  if type_x == "string" then
    => {tag.link (css_style (x)) ( ), nl; }
  else
   local o = { }
   for i = 1, #x do
     o[i] = mk_css (x[i])
   end -- for
   => o
   end -- if
end -- function

local decorate = \ (body)
  local CSS, TITLE, HEADER, CHARSET  in body
  local css = CSS and mk_css (CSS)
  local header = tag.head ( ) {
       nl; tag.title ( ) (TITLE or [[?]]); nl;
       tag.meta (charset (CHARSET or [[utf-8]])) ( );  nl;
       tag.meta { (SET.name [[Generator]]); [[ ]]; (SET.Content [[Weave]]);} ( );
       nl;
       css or [[]]; HEADER or [[]]; }
  local FILE, DOCTYPE, BODYSTYLE, LANG in body
  local bstyle = BODYSTYLE and STYLE (BODYSTYLE)
  local lang = SET.lang (LANG or [[en]])
   => {
       DOCTYPE or [[<!DOCTYPE html>]]; nl;
       tag.html (lang) {nl, header, nl, tag.body (bstyle) (body)};
       }
  end -- function

local settype = "settype %s &FAF"
local END = \ (tree, filename)
      local QUIET in tree
      file = tree.FILE or filename
      assert (file and #file > 0, "no output file")
      local errout = "cannot open file %s"
      local f = io.open (file, "w")
      assert (f, errout (file))
      local ok = walk (decorate (tree or ""), leafaction (f))
      f:close ( )
      if ok then os.execute (settype (file)) end -- if
      if not QUIET then print (file) end -- if
      end -- function

local BEGIN = \ (title, css, filename)
    => setmetatable ({
         END = END;
         TITLE = title;
         CSS = css or [[style.css]];
         FILE = filename;
       }, { __call = put; })
     end

local REM = \ (s) => { "\n<!-- ", s, " -->\n", } end -- function
local catchall = "(.)"
local entity = {
  ["<"] = "&lt;",
  [">"] = "&gt;",
  ["&&"] = "&amp;",
               }
local entify = \ (c)
               assert (type (c) == "string")
               local n, fmts = c:byte ( ),"&#%s;"
               return (n > 127) and fmts (n) or c
               end -- function
local CLEAN = \ (s)
              s = s:gsub (catchall, entify)
              for symb, ent in pairs (entity) do
                s = s:gsub (symb, ent)
              end -- for
              => s
              end
local PATH = \ (s) => s:gsub ("[^%.]*$", "") end
=> {
    BEGIN = BEGIN;
    TAG = tag;
    CLASS = CLASS;
    STYLE = STYLE;
    SET = SET;
    REM = REM;
    CLEAN = CLEAN;
    PATH = PATH;
    LIST = LIST;
    version = [[5]];
    }
