module Halipeto.Functions ( split, parse, eval, attribute, text, textReplace, textAfter, repeat, addDefaultsFn, parseElements, parseElement, mkElements, mkElement, xhtml, element ) where import Prelude hiding (repeat) import Halipeto.Template import Halipeto.Dictionary import Halipeto.Utilities import Data.Char import Text.XML.HaXml.Parse import Text.XML.HaXml.Types\end{code} \subsection{Argument Lists} A function may require more than one argument, but attributes have only a single value. The convention used here is for a fixed number of space delimited arguments, with the possibility of spaces in the final value (usually text). %%Haddock: Separate the argument into the expected number of values \begin{code}
split :: Int -> String -> [String] split n s = case split' n [] "" (dropSpace s) of Just ss -> ss Nothing -> error $ "too few arguments (<" ++ (show n) ++ "): " ++ s split' :: Int -> [String] -> String -> String -> Maybe [String] split' _ _ _ "" = Nothing split' 1 l _ s = Just $ l ++ [dropSpace s] split' n l a (c:s) | isSpace c = split' (n-1) (l++[a]) "" (dropSpace s) | otherwise = split' n l (a++[c]) s\end{code} \subsection{Argument Parsing} I had to decide whether to do substittion before or after splitting an argument. If it introduces spaces then early substitution may alter how the argument is split. While this might have lead to cool meta-programming hacks, I thought it more likely to confuse. So substitution is later. The only danger with this that I can see is that one might incorrectly assume that initial arguments, after parsing and substitution, never contain embedded spaces. %%Haddock: Separate argument and do substituion from state \begin{code}
parse :: SubDictionary d => d String -> Int -> String -> [String] parse d n = subAll d . split n\end{code} \subsection{hal:eval} Evaluate a function. Probably pointless, but I can't resist the temptation. All substitution takes place during the first evaluation. \begin{verbatim}
eval :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f eval ctx arg = case search' (funcs ctx) nm of Nothing -> return $ error $ "cannot find function " ++ nm Just fn -> fn ctx val where [nm,val] = parse (state ctx) 2 arg\end{code} \subsection{hal:attribute} Add an attribute to the current element. \begin{verbatim}
attribute :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f attribute ctx arg = do return (ctx, Attr nm val) where [nm, val] = parse (state ctx) 2 arg\end{code} \subsection{hal:text} Append / prepend text to the contents of the current element. \begin{verbatim}
text' :: (SubDictionary s, Dictionary f (CustomFn s f)) => Position -> CustomFn s f text' pos ctx arg = do return (ctx, Text pos $ substitute (state ctx) arg)\end{code} %%Haddock: Prepend text to the current element \begin{code}
text :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f text = text' Before\end{code} %%Haddock: Append text to the current element \begin{code}
textAfter :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f textAfter = text' After\end{code} %%Haddock: Replace text to the current element \begin{code}
textReplace :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f textReplace = text' Replace\end{code} \subsection{hal:repeat} Assign the sub-elements of root (in the state dictionary) to name, one at a time, evaluating the template sub--tree. \begin{verbatim} root.1 = a root.2 = b
a
b
repeat :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f repeat ctx arg = repeat' nm vals ctx "" where dct = state ctx [nm, val] = parse dct 2 arg vals = children' dct val repeat' :: (SubDictionary s, Dictionary f (CustomFn s f)) => String -> [s String] -> CustomFn s f repeat' p [] ctx _ = do putStrLn $ "end of repeat: " ++ p return (ctx, Skip) repeat' p (s:ss) ctx _ = do putStrLn $ "repeat: " ++ p ++ ": " ++ (show (contents s)) return (ctx', Repeat $ repeat' p ss) where ctx' = ctx {state = adopt' (state ctx) (p, s)}\end{code} \subsection{hal:eq, hal:neq} Test for (non--)equality of the two arguments. \begin{verbatim}
eq :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f eq ctx arg = eq' ctx True $ parse (state ctx) 2 arg\end{code} %%Haddock: Continue evaluation of contents if two arguments inequal \begin{code}
neq :: (SubDictionary s, Dictionary f (CustomFn s f)) => CustomFn s f neq ctx arg = eq' ctx False $ parse (state ctx) 2 arg eq' :: (SubDictionary s, Dictionary f (CustomFn s f)) => Context s f -> Bool -> [String] -> IO (Context s f, Result s f) eq' ctx x (a:[b]) = do return $ (ctx, if x `xor` (a /= b) then Continue else Skip) where p `xor` q = (p && not q) || (q && not p)\end{code} \subsection{Support for Insertion} These functions provide basic support for meta-templates. You can place template HTML in the database then insert it in a ``skeleton'' template. They're also useful for writing small ``abbreviation'' functions. %%Haddock: Parse text as XML \begin{code}
parseElements :: String -> [Element] parseElements txt = fromElement $ parseElement "parseelements" txt where fromElement (Elem "parseelements" _ els) = map unContent els unContent (CElem x) = x unContent s@(CString _ _) = Elem "p" [] [s] unContent _ = error "cannot parse xml as element"\end{code} %%Haddock: Parse text as XML within an element \begin{code}
parseElement :: String -> String -> Element parseElement elt txt = fromDoc $ xmlParse txt txt' where txt' = "<?xml version='1.0' encoding='iso-8859-1'?><" ++ elt ++ ">" ++ txt ++ "</" ++ elt ++ ">" fromDoc (Document _ _ el _) = el\end{code} %%Haddock: Generate a function that inserts XML parsed from text \begin{code}
mkElements :: Position -> String -> CustomFn s f mkElements pos txt ctx _ = do return (ctx, Xml pos (parseElements txt))\end{code} %%Haddock: Generate a function that inserts XML parsed from text, %%Haddock: within an element \begin{code}
mkElement :: Position -> String -> String -> CustomFn s f mkElement pos elt txt ctx _ = do return (ctx, Xml pos [parseElement elt txt])\end{code} \subsection{hal:xhtml} Insert a group of elements (bare text is enclosed in p tags). \begin{verbatim} link = foo text = hello world
hello
worldxhtml :: (SubDictionary s, Dictionary f (CustomFn s f)) => Position -> CustomFn s f xhtml pos ctx txt = do return (ctx, Xml pos (parseElements txt')) where txt' = substitute (state ctx) txt\end{code} \subsection{hal:element} Insert a named element. \begin{verbatim} link = foo text = hello world
hello world
element :: (SubDictionary s, Dictionary f (CustomFn s f)) => Position -> CustomFn s f element pos ctx txt = do return (ctx, Xml pos [parseElement tag txt'']) where [tag, txt'] = split 2 txt txt'' = substitute (state ctx) txt'\end{code} For an example of the element tag in use, see the image.html teplate in the demo. Insertion of a p element allows the body text to contain template functions without the need for explicit $<$p$>$ markup around each paragraph. \subsection{Load Defaults} Make the custom functions above available in the funcs dictionary under the hal namespace. %%Haddock: Add standard functions to a dictionary \begin{code}
addDefaultsFn :: (SubDictionary s, Dictionary f (CustomFn s f)) => f (CustomFn s f) -> f (CustomFn s f) addDefaultsFn fn = addAll fn fns where fns = map (\(n,f) -> ([hal, n], f)) lst lst = [("eval", eval), ("attribute", attribute), ("text", text), ("textafter", textAfter), ("textreplace", textReplace), ("repeat", repeat), ("eq", eq), ("neq", neq), ("xhtml", xhtml Before), ("xhtmlafter", xhtml After), ("xhtmlreplace", xhtml Replace), ("element", element Before), ("elementafter", element After), ("elementreplace", element Replace)]\end{code}