-- An experimental utility to build a (X)HTML page out of a simple page -- template and a set of scripts to embed and/or to make referred to -- from the resulting page. -- The source of this program contains a template itself embedded as HSP XML. -- All necessary elements are inserted into this template based on the command -- line arguments. module Main where import Prelude hiding (readFile, putStrLn) import Data.Maybe import Network.URI import Control.Monad import HSP hiding (catch) import HSP.HJScript import HJScript import HJScript.DOM import System.IO.UTF8 (putStrLn, hPutStrLn, readFile) import System.Environment.UTF8 import qualified System.Console.GetOpt as G import System.FilePath import System.Posix.Files import System.Exit import System.IO (stderr) -- The template. The function's parameters will be embedded into the XML -- below. All stylesheets and scripts are placed into the HEAD element. simplePg :: String -- title -> String -- onLoad if not empty -> [Either String String] -- scripts to embed -> [Either String String] -- stylesheets to embed -> HSP XML -- result simplePg ttl onl scrs csss = <% ttl %> <% mapM csheet csss %> <% mapM script scrs %> <% bdy onl %> -- Create the BODY element with optional onload= attribute. bdy "" = bdy onl = -- Create either embedded SCRIPT element, or one pointing to an external script location. script (Left scr) = script (Right scr) =