Commit f873428c authored by Michael Hanus 's avatar Michael Hanus

First new version of HTML library without server processes

parents
*~
.cpm
.curry
Copyright (c) 2017, Michael Hanus
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the names of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
html2: Support for HTML programming
===================================
This package contains libraries to support HTML programming.
It provides a similar API as package `html`.
In contract to package `html`, this library implements
dynamic web pages without server processes waiting for answers
form the client (web browser). Thus, it does not need
the Curry Port Name Server (CPNS), the HTML/CGI Registry, etc.
For this purpose, web forms are a bit more restricted:
each web form has an IO action to read the data required for
the form and a result page shown after submitting the form.
To implement the event handler inside a form without a process,
the read IO action is executed again when a form is submitted.
Some simple examples for dynamic web pages can be found in the
directory `examples`.
--------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Example for HTML programming in Curry:
--
-- A form to browse the structure of a directory.
-- The form is parameterized by the (URL-encoded) name of the directory.
-- Subdirectories are presented as links to browse them.
--
-- @author Michael Hanus
-- @version November 2018
------------------------------------------------------------------------------
import Directory
import HTML.Base
main :: IO HtmlPage
main = do
param <- getUrlParameter
let dir = if null param then "." else urlencoded2string param
entries <- getDirectoryContents dir
hexps <- mapIO (entry2html dir) entries
return $ page "Browse Directory"
[h1 [htxt $ "Directory: " ++ dir], ulist hexps]
-- Transform directory and entry in this directory into a link
-- (if it is a directory) or a text:
entry2html :: String -> String -> IO [HtmlExp]
entry2html dir e = do
direx <- doesDirectoryExist (dir ++ "/" ++ e)
if direx
then return [href ("?" ++ string2urlencoded (dir ++ "/" ++ e))
[htxt e]]
else return [htxt e]
-- Install with:
-- > cypm exec curry2cgi -o ~/public_html/cgi-bin/browsedir.cgi BrowseDir
--
-- Call with: http://...CGIBINDIR/browsedir.cgi?<directory (urlencoded)>
------------------------------------------------------------------------------
-- Example for HTML programming in Curry:
--
-- A recursive form for a number guessing game
-- which also counts the number of guesses
------------------------------------------------------------------------------
import Global
import HTML.Base
import HTML.Session
--- The data stored in the session is the number of guesses.
guessNr :: Global (SessionStore Int)
guessNr = global emptySessionStore (Persistent "guessNr")
guessInputForm :: HtmlFormDef Int
guessInputForm = HtmlFormDef "Guess.guessInputForm" readGuesses formHtml
where
readGuesses = getSessionData guessNr 0 -- read session data
formHtml n =
(if n>0 then [h4 [htxt $ show (n+1) ++ ". attempt:"]] else []) ++
[htxt "Guess a natural number: ", textfield nref "",
formButton "Check" guessHandler]
where
nref free
guessHandler env = do
let nr = read (env nref) :: Int
if nr==42
then do
putSessionData guessNr 0
return $ page "Answer" $
[h1 [htxt $ "Right! You needed " ++ show (n+1) ++ " guesses!"]]
else do
putSessionData guessNr (n+1)
return $ page "Answer" $
[h1 [htxt $ if nr<42 then "Too small!"
else "Too large!"],
hrule, formExp guessInputForm]
-- main HTML page containing the form
main :: IO HtmlPage
main = do
cookie <- sessionCookie -- be sure that there is a cookie for the session
putSessionData guessNr 0 -- initialize session state
return (standardPage "Number Guessing Game"
[ formExp guessInputForm ] `addPageParam` cookie)
-- Install the CGI script in user homepage by:
-- > cypm exec curry2cgi -o ~/public_html/cgi-bin/guess.cgi Guess
------------------------------------------------------------------------------
-- Example for CGI programming in Curry:
-- A web page with a form containing a text input field and two submit buttons
-- to reverse and duplicate the input string.
------------------------------------------------------------------------------
import HTML.Base
-- Example: a form with a text input field and two submit buttons.
revDupForm :: HtmlFormDef String
revDupForm = HtmlFormDef "RevDup.revDupForm" (return "") formHtml
where
formHtml _ =
[ htxt "Enter a string: ", textfield ref ""
, hrule
, formButton "Reverse string" revHandler
, formButton "Duplicate string" dupHandler
]
where
ref free
revHandler env = return $ page "Answer"
[ h1 [ htxt $ "Reversed input: " ++ reverse (env ref)] ]
dupHandler env = return $ page "Answer"
[ h1 [ htxt $ "Duplicated input: " ++ env ref ++ env ref] ]
-- main HTML page containing the form
main :: IO HtmlPage
main = return $ page "Question"
[ h1 [htxt "This is an example form"], formExp revDupForm ]
-- Install with:
-- > cypm exec curry2cgi -o ~/public_html/cgi-bin/revdup.cgi RevDup
-------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Example for CGI programming in Curry:
-- A web page with a form containing a text input field and two submit buttons
-- to reverse and duplicate the input string.
-- Here we use session data to store the string typed into the input
-- field in order to use it for a subsequent form.
------------------------------------------------------------------------------
import FilePath ( (</>) )
import Global
import HTML.Base
import HTML.Session
--- The data stored in a session is the string typed into the input field.
rdInput :: Global (SessionStore String)
rdInput = global emptySessionStore (Persistent ("." </> "rdInput"))
-- Example: a form with a text input field and two submit buttons.
revDupForm :: HtmlFormDef String
revDupForm = HtmlFormDef "RevDupSession.revDupForm" readInfo formHtml
where
readInfo = getSessionData rdInput ""
formHtml s =
[ htxt "Enter a string: ", textfield ref s
, hrule
, formButton "Reverse string" revHandler
, formButton "Duplicate string" dupHandler
]
where
ref free
revHandler env = do
putSessionData rdInput (env ref)
withSessionCookie $ page "Answer"
[ h1 [ htxt $ "Reversed input: " ++ reverse (env ref)], hrule
, formExp revDupForm ]
dupHandler env = do
putSessionData rdInput (env ref)
withSessionCookie $ page "Answer"
[ h1 [ htxt $ "Duplicated input: " ++ env ref ++ env ref], hrule
, formExp revDupForm ]
-- main HTML page containing the form
main :: IO HtmlPage
main = withSessionCookie $ page "Question"
[ h1 [htxt "This is an example form"]
, formExp revDupForm
]
-- Install with:
-- > cypm exec curry2cgi -o ~/public_html/cgi-bin/revdup.cgi RevDupSession
-------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Example for CGI programming in Curry:
-- A form with a text input field and two submit buttons to reverse
-- and duplicate the input string together with a "time" form imported
-- from another module.
------------------------------------------------------------------------------
import Time
import HTML.Base
import TimeForm ( timeForm )
-- Example: a form with a text input field and two submit buttons.
revDupForm :: HtmlFormDef String
revDupForm = HtmlFormDef "RevDupTime.revDupForm" (return "") formHtml
where
formHtml _ =
[ htxt "Enter a string: ", textfield ref ""
, hrule
, formButton "Reverse string" revHandler
, formButton "Duplicate string" dupHandler
]
where
ref free
revHandler env = return $ page "Answer"
[ h1 [ htxt $ "Reversed input: " ++ reverse (env ref)] ]
dupHandler env = return $ page "Answer"
[ h1 [ htxt $ "Duplicated input: " ++ env ref ++ env ref] ]
-- main HTML page containing the form
main :: IO HtmlPage
main = return $ page "Question"
[ h1 [htxt "This is an example form"]
, formExp revDupForm
, hrule
, formExp timeForm
]
-- Install with (note that we need to include forms from `TimeForm`!):
-- > cypm exec curry2cgi -i TimeForm -o ~/public_html/cgi-bin/revduptime.cgi RevDupTime
-------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Example for CGI programming in Curry:
-- a form with button to show the current time
------------------------------------------------------------------------------
import Time
import HTML.Base
-- Example: a form with button to show the current time.
timeForm :: HtmlFormDef String
timeForm = HtmlFormDef "TimeForm.timeForm" (return "") formHtml
where
formHtml _ = [ formButton "Show time" timeHandler ]
where
timeHandler _ = do
ltime <- getLocalTime
return $ page "Answer"
[ h1 [ htxt $ "Local time: " ++ calendarTimeToString ltime ] ]
-- main HTML page containing the form
main :: IO HtmlPage
main = return $ page "Time"
[ h1 [htxt "This is an example form to show the current time"]
, hrule
, formExp timeForm
]
-- Install with:
-- > cypm exec curry2cgi -o ~/public_html/cgi-bin/time.cgi TimeForm
-------------------------------------------------------------------------
{
"name": "html2",
"version": "0.0.1",
"author": "Michael Hanus <mh@informatik.uni-kiel.de>",
"synopsis": "Libraries for better HTML programming.",
"category": [ "Web" ],
"dependencies": {
"currypath": ">= 0.0.1",
"flatcurry": ">= 2.0.0",
"random" : ">= 0.0.1"
},
"sourceDirs": [ "src", "scripts" ],
"exportedModules": [ "HTML.Base",
"HTML.CategorizedList", "HTML.LaTeX",
"HTML.Parser",
"HTML.Styles.Bootstrap3" ],
"compilerCompatibility": {
"pakcs": ">= 2.0.0",
"kics2": ">= 2.0.0"
},
"license": "BSD-3-Clause",
"licenseFile": "LICENSE",
"executable": {
"name": "curry2cgi",
"main": "Curry2CGI"
},
"source": {
"git": "https://git.ps.informatik.uni-kiel.de/curry-packages/html.git",
"tag": "$version"
}
}
------------------------------------------------------------------------------
--- Auxiliary definitions used by the form checker.
---
--- @author Michael Hanus
--- @version September 2019
------------------------------------------------------------------------------
import System ( exitWith )
import HTML.Base
checkFormID :: (HtmlFormDef a, String) -> IO ()
checkFormID (fd, s) =
unless (formDefId fd == s) $ do
putStrLn $ "ERROR: form operation '" ++ s ++ "' has non-matching ID!"
exitWith 1
------------------------------------------------------------------------------
--- Script to compile a Curry program implementing a web script
--- using the package `html2` and the library `HTML.Base`
--- into a cgi script to be placed in a server-accessible directory
--- for executing cgi scripts.
---
--- @author Michael Hanus
--- @version September 2019
------------------------------------------------------------------------------
module Curry2CGI
where
import Directory ( createDirectoryIfMissing, doesFileExist )
import Distribution ( installDir )
import FileGoodies
import FilePath ( (</>) )
import GetOpt
import List ( intercalate, isPrefixOf, nub )
import ReadNumeric ( readNat )
import System
import Time ( calendarTimeToString, getLocalTime )
import FlatCurry.Types
import System.CurryPath ( stripCurrySuffix )
import ExtractForms ( extractFormsInProg )
main :: IO ()
main = do
args <- getArgs
(opts,prog) <- processOptions args
checkCurrySystem (optSystem opts)
formops <- mapM (extractFormsInProg (optSystem opts)) (optFormMods opts)
compileCGI (opts { optForms = nub (concat formops) }) prog
checkCurrySystem :: String -> IO ()
checkCurrySystem currydir = do
let currybin = currydir </> "bin" </> "curry"
isexec <- doesFileExist currybin
unless isexec $
error $ "Curry system executable '" ++ currybin ++ "' does not exist!"
compileCGI :: Options -> String -> IO ()
compileCGI opts mname = do
putStrLn $ "Wrapping '" ++ mname ++ "' to generate CGI binary..."
pid <- getPID
let mainmod = mname ++ "_CGIMAIN_" ++ show pid
maincall = "main_cgi_9999_" ++ show pid
cgifile = if null (optOutput opts) then mname ++ ".cgi"
else optOutput opts
cgidir = dirName cgifile
createDirectoryIfMissing True cgidir
writeFile (mainmod ++ ".curry") (genMainProg opts mname mainmod maincall)
-- compile main module:
cf <- system $ unwords
[optCPM opts, optSystem opts </> "bin" </> "curry", "--nocypm",
-- $CURRYDOPTIONS $CURRYOPTIONS
":load", mainmod, ":save", maincall, ":quit"]
when (cf > 0) $ do
putStrLn "Error occurred, generation aborted."
cleanMain mainmod
exitWith 1
-- move compiled executable to final position and generate small shell
-- script to call the executable with ulimit and correct path:
system $ unwords ["mv", mainmod, cgifile ++ ".bin"]
system $ unwords ["chmod", "755", cgifile ++ ".bin"]
genShellScript opts cgifile
cleanMain mainmod
cdate <- getLocalTime >>= return . calendarTimeToString
writeFile (cgifile ++ ".log") (cdate ++ ": cgi script compiled\n")
putStrLn $ "New files \"" ++ cgifile ++ "*\" with compiled cgi script generated."
where
cleanMain mainmod = do
system $ unwords [optSystem opts </> "bin" </> "cleancurry", mainmod]
system $ "/bin/rm -f " ++ mainmod ++ ".curry"
-- generate cgi shell script:
genShellScript :: Options -> String -> IO ()
genShellScript opts cgifile = do
system $ "/bin/rm -f " ++ cgifile
langenv <- getEnviron "LANG"
let limit = optLimit opts
let script = unlines $
["#!/bin/sh"] ++
(if null langenv then []
else ["LANG=" ++ langenv, "export LANG"]) ++
(if null limit then [] else ["ulimit " ++ limit]) ++
["exec " ++ cgifile ++ ".bin 2>> " ++ cgifile ++ ".log"]
writeFile cgifile script
system $ unwords ["chmod", "755", cgifile]
done
genMainProg :: Options -> String -> String -> String -> String
genMainProg opts mname mainmod maincall = unlines $
[ "module " ++ mainmod ++ "(" ++ maincall ++ ") where"
, "import HTML.Base"
, "import HTML.CGI.Exec" ] ++
(map ("import " ++) (nub (mname : optFormMods opts))) ++
[ maincall ++ " :: IO ()"
, maincall ++ " = HTML.CGI.Exec.showFormPageAction [" ++
intercalate "," formCalls ++ "] (" ++ optMain opts ++ ")"
]
where
formCalls = map (\f -> "(\"" ++ f ++ "\", HTML.CGI.Exec.showFormAction " ++
f ++ ")")
(map showQName (optForms opts))
------------------------------------------------------------------------------
-- Option processing for the script.
data Options = Options
{ optVerb :: Int -- verbosity (0: quiet, 1: status, 2: interm, 3: all)
, optHelp :: Bool -- if help info should be printed
, optOutput :: String -- name of the cgi program file (with suffix .cgi)
, optMain :: String -- the main expression
, optForms :: [QName] -- qualified names of form operations
, optFormMods:: [String] -- names of modules containing form operations
, optSystem :: String -- path to root of Curry system
, optCPM :: String -- command to invoke Curry Package Manager
, optLimit :: String -- ulimit settings for the cgi program
}
defaultOptions :: Options
defaultOptions = Options 1 False "" "" [] [] installDir "cypm exec" "-t 120"
--- Process the actual command line argument and return the options
--- and the name of the main program.
processOptions :: [String] -> IO (Options,String)
processOptions argv = do
let (funopts, args, opterrors) = getOpt Permute options argv
opts = foldl (flip id) defaultOptions funopts
unless (null opterrors)
(putStr (unlines opterrors) >> printUsage >> exitWith 1)
when (optHelp opts) (printUsage >> exitWith 0)
case args of
[p] -> let mname = stripCurrySuffix p
opts1 = opts { optFormMods = nub (optFormMods opts ++ [mname])
, optMain = if null (optMain opts)
then mname ++ ".main"
else optMain opts }
in return (opts1, mname)
[] -> error $ "Name of main module missing!"
_ -> error $ "Please provide only one main module!"
where
printUsage = putStrLn usageText
-- Usage text
usageText :: String
usageText =
usageInfo ("Usage: curry2cgi [options] <module name>\n") options
-- Definition of actual command line options.
options :: [OptDescr (Options -> Options)]
options =
[ Option "h?" ["help"]
(NoArg (\opts -> opts { optHelp = True }))
"print help and exit"
, Option "v" ["verb"]
(OptArg (maybe (checkVerb 2) (safeReadNat checkVerb)) "<n>")
"verbosity level:\n0: quiet (same as `-q')\n1: show status messages (default)\n2: show intermediate results (same as `-v')\n3: show all details (e.g., SMT scripts)"
, Option "m" ["main"]
(ReqArg (\s opts -> opts { optMain = s }) "<m>")
("Curry expression (of type IO HtmlPage) computing\n" ++
"the HTML page\n(default: main)")
, Option "o" ["output"]
(ReqArg (\s opts -> opts { optOutput = s }) "<o>")
("name of the file (with suffix .cgi) where the cgi\n" ++
"program should be stored (default: <curry>.cgi)")
, Option "i" ["include"]
(ReqArg (\s opts -> opts { optFormMods = optFormMods opts ++ [s] })
"<i>")
("Additional Curry module for which all public\n" ++
"form handlers should be generated")
, Option "s" ["system"]
(ReqArg (\s opts -> opts { optSystem = s }) "<s>")
("set path to the root of Curry system\n" ++
"(then 'path/bin/curry' is invoked to compile script)")
, Option "" ["cpmexec"]
(ReqArg (\s opts -> opts { optSystem = s }) "<c>")
("set the command to execute programs with the\n" ++
"Curry Package Manager (default: 'cypm exec')")
, Option "u" ["ulimit"]
(ReqArg (\s opts -> opts { optLimit = s }) "<l>")
("set 'ulimit <l>' when executing the cgi program\n" ++
"(default: '-t 120')")
]
where
safeReadNat opttrans s opts =
let numError = error "Illegal number argument (try `-h' for help)"
in maybe numError
(\ (n,rs) -> if null rs then opttrans n opts else numError)
(readNat s)
checkVerb n opts = if n>=0 && n<4
then opts { optVerb = n }
else error "Illegal verbosity level (try `-h' for help)"
-------------------------------------------------------------------------
------------------------------------------------------------------------------
--- Compute infos about all `HtmlFormDef` operations occurring in a module.
---
--- @author Michael Hanus
--- @version September 2019
------------------------------------------------------------------------------
module ExtractForms ( extractFormsInProg )
where
import FilePath ( (</>) )
import List ( intercalate )
import System ( exitWith, getArgs, getPID, system )
import FlatCurry.Files
import FlatCurry.Goodies
import FlatCurry.Types
import HTML.Base
import System.CurryPath ( stripCurrySuffix )
extractFormsInProg :: String -> String -> IO [QName]
extractFormsInProg curryroot mname = do
putStrLn $ "Extracting and checking forms contained in module '" ++
mname ++ "'..."
intcurry <- readFlatCurryInt mname
let formnames = extractFormOps intcurry
putStrLn $ "Form operations found: " ++ unwords (map snd formnames)
checkFormIDsInProg curryroot mname formnames
return formnames
extractFormOps :: Prog -> [QName]
extractFormOps prog = map funcName (filter isPublicFormDef (progFuncs prog))
where
isPublicFormDef fdecl =
funcVisibility fdecl == Public &&
isFormDefType (funcType fdecl)
isFormDefType t = case t of
TCons tc _ -> tc == ("HTML.Base","HtmlFormDef")
_ -> False
-- Test whether all `HtmlFormDef` identifiers in a module are correct,
-- i.e., are identical to the string representation of their defining
-- operations.
checkFormIDsInProg :: String -> String -> [QName] -> IO ()
checkFormIDsInProg curryroot mname formnames = do
pid <- getPID
let testprogname = "TESTFORMPROG_" ++ show pid
writeFile (testprogname ++ ".curry") $ unlines
[ "import " ++ mname
, "import HTML.Base"
, "import CheckFormIDs"
, "main :: IO ()"
, "main = sequence_ [" ++
intercalate "," (map genFormCall formnames) ++ "]"
]
c <- system $ unwords
[curryroot </> "bin" </> "curry",":set v0", ":load", testprogname,
":eval", "main", ":quit"]
cleanProg testprogname
unless (c==0) (exitWith c)
where
cleanProg modname = do
system $ unwords [curryroot </> "bin" </> "cleancurry", modname]
system $ "/bin/rm -f " ++ modname ++ ".curry"
genFormCall qn =
let s = showQName qn
in "checkFormID (" ++ s ++ ",\"" ++ s ++ "\")"
This diff is collapsed.
------------------------------------------------------------------------------
--- This module contains some operations to support the execution
--- of CGI scripts defined with the library `HTML.Base`.
--- These operations are used by the script `curry2cgi`
--- to compile Curry CGI scripts into executables.
---
--- @author Michael Hanus
--- @version September 2019
------------------------------------------------------------------------------
module HTML.CGI.Exec ( showFormPageAction, showFormAction )
where
import IO ( hPutStrLn, stderr )
import List ( intercalate )
import ReadNumeric ( readHex, readNat )
import System ( getEnviron )
import Time ( calendarTimeToString, getLocalTime )
import HTML.Base
------------------------------------------------------------------------------
--- Shows the HTML page generated from the parameter action
--- as a string on stdout.
--- The forms possibly contained in the HTML page are passed as parameters,
--- where the elements are usually `(formid, showFormAction formdef)`.
--- This operation is used by the script to compile web scripts
--- into executables.
showFormPageAction :: [(String, [(String,String)] -> IO ())] -> IO HtmlPage
-> IO ()
showFormPageAction formmap genpage = catchFormErrors $ do
cgivars <- getFormVariables
maybe (genpage >>= showPage)
(\formid -> maybe (showPage (formNotCompiledPage formid))
(\f -> f cgivars)
(lookup formid formmap))
(lookup "FORMID" cgivars)
--- Processes a submitted HTML form by reading the data and