diff --git a/Halipeto/Dictionary.lhs b/Halipeto/Dictionary.lhs --- a/Halipeto/Dictionary.lhs +++ b/Halipeto/Dictionary.lhs @@ -17,14 +17,6 @@ % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % -% EXCEPT -% -% Files in FromHaxml are from HaXml - http://www.cs.york.ac.uk/HaXml - -% see the COPYRIGHT and LICENSE in that directory. The files included -% are a subset of the full HaXml distribution and have been modified to -% originate from the FromHaxml module (so that install on Win32 is -% easy). -% \section{Dictionary} diff --git a/Halipeto/Functions.lhs b/Halipeto/Functions.lhs --- a/Halipeto/Functions.lhs +++ b/Halipeto/Functions.lhs @@ -17,14 +17,6 @@ % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % -% EXCEPT -% -% Files in FromHaxml are from HaXml - http://www.cs.york.ac.uk/HaXml - -% see the COPYRIGHT and LICENSE in that directory. The files included -% are a subset of the full HaXml distribution and have been modified to -% originate from the FromHaxml module (so that install on Win32 is -% easy). -% \section{Functions} @@ -44,8 +36,9 @@ import Halipeto.Dictionary import Halipeto.Utilities import Data.Char -import Text.XML.HaXml.Parse +import Text.XML.HaXml.Parse hiding ( element ) import Text.XML.HaXml.Types +import Text.XML.HaXml.Posn \end{code} \subsection{Argument Lists} @@ -236,17 +229,17 @@ %%Haddock: Parse text as XML \begin{code} -parseElements :: String -> [Element] +parseElements :: String -> [Element Posn] 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 (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 :: String -> String -> Element Posn parseElement elt txt = fromDoc $ xmlParse txt txt' where txt' = "<" ++ elt ++ ">" diff --git a/Halipeto/Pages.lhs b/Halipeto/Pages.lhs --- a/Halipeto/Pages.lhs +++ b/Halipeto/Pages.lhs @@ -17,14 +17,6 @@ % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % -% EXCEPT -% -% Files in FromHaxml are from HaXml - http://www.cs.york.ac.uk/HaXml - -% see the COPYRIGHT and LICENSE in that directory. The files included -% are a subset of the full HaXml distribution and have been modified to -% originate from the FromHaxml module (so that install on Win32 is -% easy). -% \section{Pages} @@ -44,6 +36,7 @@ import Halipeto.Utilities import Text.XML.HaXml.Pretty import Text.XML.HaXml.Types +import Text.XML.HaXml.Posn import Data.Maybe import System.IO import Control.Monad @@ -314,14 +307,14 @@ %%Haddock: Define a menu label for a page \begin{code} -type Label s = s String -> Page s -> Maybe [Element] +type Label s = s String -> Page s -> Maybe [Element Posn] \end{code} Collect groups the HTML associated with pages. %%Haddock: Combine menu labels \begin{code} -type Collect = [Element] -> [Element] -> [Element] +type Collect = [Element Posn] -> [Element Posn] -> [Element Posn] \end{code} \begin{code} @@ -333,11 +326,11 @@ %%Haddock: Generate a menu \begin{code} -baseMenu :: Collect -> TreeSite s -> s String -> Label s -> [Element] +baseMenu :: Collect -> TreeSite s -> s String -> Label s -> [Element Posn] baseMenu col ste dct lab = foldT (baseNode col dct lab) [] ste baseNode :: Collect -> s String -> Label s - -> Maybe (Page s) -> [Element] -> [Element] + -> Maybe (Page s) -> [Element Posn] -> [Element Posn] baseNode _ _ _ Nothing rows = rows baseNode col dct lab (Just pg) rows = case lab dct' pg of @@ -353,12 +346,13 @@ %%Haddock: Generate a flat menu \begin{code} -listMenu :: TreeSite s -> s String -> Label s -> Element -listMenu ste dct lab = Elem "table" menuClass (map CElem rows) +listMenu :: TreeSite s -> s String -> Label s -> Element Posn +listMenu ste dct lab = Elem "table" menuClass (map (\x -> CElem x noPos) rows) where rows = baseMenu makeRow ste dct lab makeRow :: Collect -makeRow els rows = (Elem "tr" menuClass - [CElem $ Elem "td" menuClass (map CElem els)]) : rows +makeRow els rows + = (Elem "tr" menuClass + [CElem (Elem "td" menuClass (map (\x -> CElem x noPos) els)) noPos]) : rows \end{code} diff --git a/Halipeto/SimpleDB.lhs b/Halipeto/SimpleDB.lhs --- a/Halipeto/SimpleDB.lhs +++ b/Halipeto/SimpleDB.lhs @@ -17,14 +17,6 @@ % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % -% EXCEPT -% -% Files in FromHaxml are from HaXml - http://www.cs.york.ac.uk/HaXml - -% see the COPYRIGHT and LICENSE in that directory. The files included -% are a subset of the full HaXml distribution and have been modified to -% originate from the FromHaxml module (so that install on Win32 is -% easy). -% \section{Simple Database} diff --git a/Halipeto/Template.lhs b/Halipeto/Template.lhs --- a/Halipeto/Template.lhs +++ b/Halipeto/Template.lhs @@ -17,14 +17,6 @@ % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % -% EXCEPT -% -% Files in FromHaxml are from HaXml - http://www.cs.york.ac.uk/HaXml - -% see the COPYRIGHT and LICENSE in that directory. The files included -% are a subset of the full HaXml distribution and have been modified to -% originate from the FromHaxml module (so that install on Win32 is -% easy). -% \section{Templates} @@ -46,8 +38,9 @@ import Data.Maybe import Data.Char import Halipeto.Dictionary -import Text.XML.HaXml.Parse +import Text.XML.HaXml.Parse hiding ( reference ) import Text.XML.HaXml.Types +import Text.XML.HaXml.Posn \end{code} \subsection{Context} @@ -119,12 +112,12 @@ \end{code} %%Haddock: The result from a function called by the template engine \begin{code} -data Result s f = Attr Name String -- ^ Add an attribute - | Text Position String -- ^ Add text - | Xml Position [Element] -- ^ Add XML - | Repeat (CustomFn s f) -- ^ Recurse on function - | Continue -- ^ Process next attribute - | Skip -- ^ Delete contents +data Result s f = Attr Name String -- ^ Add an attribute + | Text Position String -- ^ Add text + | Xml Position [Element Posn] -- ^ Add XML + | Repeat (CustomFn s f) -- ^ Recurse on function + | Continue -- ^ Process next attribute + | Skip -- ^ Delete contents \end{code} %%Haddock: The XML namespace for builtin functions \begin{code} @@ -178,7 +171,7 @@ %%Haddock: Current implementation uses HaXml \begin{code} -type Template = Document +type Template = Document Posn \end{code} %%Haddock: Read and parse a template \begin{code} @@ -208,7 +201,7 @@ %%Haddock: Evaluate the element (and its contents) \begin{code} evalElement :: (SubDictionary s, Dictionary f (CustomFn s f)) => - Context s f -> Element -> IO Element + Context s f -> Element Posn -> IO (Element Posn) evalElement ctx e@(Elem _ _ _) = evalAttributes ctx evalContents e [] \end{code} @@ -220,8 +213,8 @@ \begin{code} evalAttributes :: (SubDictionary s, Dictionary f (CustomFn s f)) => - Context s f -> (Context s f -> Element -> IO Element) -> Element - -> [Attribute] -> IO Element + Context s f -> (Context s f -> Element Posn -> IO (Element Posn)) -> Element Posn + -> [Attribute] -> IO (Element Posn) evalAttributes ctx nxt (Elem nm [] cn) at = nxt ctx $ Elem nm (reverse at) cn evalAttributes ctx nxt (Elem nm (a@(anm, val):as) cn) at = @@ -280,8 +273,8 @@ \begin{code} evalFunction :: (SubDictionary s, Dictionary f (CustomFn s f)) => - Context s f -> (Context s f -> Element -> IO Element) -> Element - -> [Attribute] -> CustomFn s f -> String -> IO Element + Context s f -> (Context s f -> Element Posn -> IO (Element Posn)) -> Element Posn + -> [Attribute] -> CustomFn s f -> String -> IO (Element Posn) evalFunction ctx nxt (Elem nm at cn) at' f val = do (ctx', res) <- f ctx val case res of @@ -290,29 +283,29 @@ Text p s -> case p of Before -> evalAttributes ctx' nxt - (Elem nm at ([CString False s]++cn)) at' + (Elem nm at ([CString False s noPos]++cn)) at' After -> evalAttributes ctx' nxt - (Elem nm at (cn++[CString False s])) at' + (Elem nm at (cn++[CString False s noPos])) at' Replace -> evalAttributes ctx' nxt - (Elem nm at [CString False s]) at' + (Elem nm at [CString False s noPos]) at' Xml p e -> case p of Before -> evalAttributes ctx' nxt - (Elem nm at ((map CElem e)++cn)) at' + (Elem nm at ((map (\x -> CElem x noPos) e)++cn)) at' After -> evalAttributes ctx' nxt - (Elem nm at (cn++(map CElem e))) at' + (Elem nm at (cn++(map (\x -> CElem x noPos) e))) at' Replace -> evalAttributes ctx' nxt - (Elem nm at (map CElem e)) at' + (Elem nm at (map (\x -> CElem x noPos) e)) at' Repeat f' -> loopAttribute ctx' (Elem nm at cn) at' f' val Continue -> evalAttributes ctx' nxt (Elem nm at cn) at' Skip -> evalAttributes ctx' skip (Elem nm [] []) at' -skip :: Context s f -> Element -> IO Element +skip :: Context s f -> Element Posn -> IO (Element Posn) skip _ e = do return e loopAttribute :: (SubDictionary s, Dictionary f (CustomFn s f)) => - Context s f -> Element -> [Attribute] -> CustomFn s f -> String - -> IO Element + Context s f -> Element Posn -> [Attribute] -> CustomFn s f -> String + -> IO (Element Posn) loopAttribute ctx e@(Elem nm _ _) at1 f val = do (Elem _ at2 cn2) <- evalAttributes ctx evalContents e [] -- first (Elem _ at3 cn3) <- evalFunction ctx skip e [] f val -- remain @@ -326,14 +319,14 @@ joinAtts at1 at2 at3 = reverse (revAppend (revAppend at1 at2) at3) evalContents :: (SubDictionary s, Dictionary f (CustomFn s f)) => - Context s f -> Element -> IO Element + Context s f -> Element Posn -> IO (Element Posn) evalContents ctx (Elem nm at cn) = do cn' <- mapM (evalContent ctx) cn return $ Elem nm at cn' evalContent :: (SubDictionary s, Dictionary f (CustomFn s f)) => - Context s f -> Content -> IO Content -evalContent ctx (CElem e) = do e' <- evalElement ctx e - return $ CElem e' + Context s f -> Content Posn -> IO (Content Posn) +evalContent ctx (CElem e pos) = do e' <- evalElement ctx e + return $ CElem e' pos evalContent _ c = do return c \end{code} @@ -344,7 +337,7 @@ %%Haddock: Evaluate a complete template \begin{code} evalDocument :: (SubDictionary s, Dictionary f (CustomFn s f)) => - Context s f -> Document -> IO Document + Context s f -> Document Posn -> IO (Document Posn) evalDocument ctx (Document p st elt msc) = do elt' <- evalElement ctx elt return $ erase $ Document p st elt' msc @@ -378,21 +371,21 @@ that has always been possible) --- is this a problem? \begin{code} -erase :: Document -> Document +erase :: Document Posn -> Document Posn erase (Document p st elt msc) = Document p st (eraseChildren elt) msc -eraseChildren :: Element -> Element +eraseChildren :: Element Posn -> Element Posn eraseChildren (Elem nm at cn) = Elem nm at $ foldl eraseContent [] cn -eraseContent :: [Content] -> Content -> [Content] -eraseContent cn (CElem el) = if hasErase el' +eraseContent :: [Content Posn] -> Content Posn -> [Content Posn] +eraseContent cn (CElem el pos) = if hasErase el' then cn++cn' - else cn++[CElem el'] + else cn++[CElem el' pos] where el'@(Elem _ _ cn') = eraseChildren el eraseContent cn x = cn++[x] -hasErase :: Element -> Bool +hasErase :: Element Posn -> Bool hasErase (Elem _ at _) = any f at where f ("hal:erase", _) = True diff --git a/Halipeto/Utilities.lhs b/Halipeto/Utilities.lhs --- a/Halipeto/Utilities.lhs +++ b/Halipeto/Utilities.lhs @@ -17,14 +17,7 @@ % along with this program; if not, write to the Free Software % Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA % -% EXCEPT -% -% Files in FromHaxml are from HaXml - http://www.cs.york.ac.uk/HaXml - -% see the COPYRIGHT and LICENSE in that directory. The files included -% are a subset of the full HaXml distribution and have been modified to -% originate from the FromHaxml module (so that install on Win32 is -% easy). -% + \section{Utilities} Various general routines. diff --git a/halipeto.cabal b/halipeto.cabal --- a/halipeto.cabal +++ b/halipeto.cabal @@ -1,5 +1,5 @@ Name: halipeto -Version: 2.2 +Version: 2.3 Copyright: (c) 2004-2010 Peter Simons License: GPL License-File: COPYING @@ -12,7 +12,7 @@ templates and a file-based value dictionary. Cabal-Version: >= 1.6 Build-Type: Simple -Tested-With: GHC == 6.12.1 +Tested-With: GHC == 6.12.3 Source-Repository head Type: git @@ -25,6 +25,5 @@ Halipeto.SimpleDB, Halipeto.Template, Halipeto.Utilities - Build-Depends: base >= 3 && < 5, HaXml == 1.13.*, directory, pandoc + Build-Depends: base >= 3 && < 5, HaXml >= 1.20, directory, pandoc Extensions: MultiParamTypeClasses, FlexibleInstances, FlexibleContexts - Ghc-Options: -Wall