diff --git a/Flippi.cabal b/Flippi.cabal --- a/Flippi.cabal +++ b/Flippi.cabal @@ -1,5 +1,5 @@ name: Flippi -version: 0.0.4 +version: 0.0.5 synopsis: Wiki description: Flippi is a Wiki clone written in Haskell category: Text @@ -8,7 +8,7 @@ author: Philippa Cowderoy maintainer: Philippa Cowderoy homepage: http://www.flippac.org/projects/flippi/ -build-depends: base, haskell98, xhtml, cgi, parsec, directory, old-time, containers +build-depends: base, haskell98, xhtml, cgi >= 3001.1.5.2, parsec, directory, old-time, containers build-type: Simple tested-with: GHC==6.8 data-files: README, data/ScriptLinks, data/RecentChanges, data/LameEasterEgg, data/WhatIsFlippi, @@ -19,5 +19,5 @@ hs-source-dirs: src/ other-modules: DeWikify, PageIO, PageTemplates, RecentChanges, Scripts, ScriptSyntax -ghc-options: -O2 -Wall -optl-Wl,-s +ghc-options: -O2 -Wall ghc-prof-options: -prof -auto-all diff --git a/src/DeWikify.hs b/src/DeWikify.hs --- a/src/DeWikify.hs +++ b/src/DeWikify.hs @@ -1,96 +1,96 @@ -{- -Copyright (c) 2004, Philippa Jane Cowderoy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * 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. - * Neither the name of the original author nor the names of any - 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 OWNER 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. --} - -module DeWikify (deWikify, pagenamePattern) -where - -import Text.XHtml -import Text.ParserCombinators.Parsec -import List - -import ScriptSyntax - -wikiParser sn = do l <- many (prependedUnderscore - <|> try (wikiLink sn) - <|> try (scriptLink sn) - <|> try newParagraph - <|> aCharacter - ) - case l of - (_:_) -> return (foldl1 (+++) l) - [] -> return (stringToHtml "") - -newParagraph = do string "\n\n" - return (br +++ br) - <|> - do string "\r\n\r\n" - return (br +++ br) - -wikiLink sn = do (l,t,_) <- linkPattern - return (anchor (stringToHtml t) - ! [href (sn ++ "?view=" ++ l)] - ) - -prependedUnderscore = do char '_' - try nextUnderscore - <|> try matchLink - <|> try matchScriptLink - <|> return (stringToHtml "_") - where matchLink = do (_,_,p) <- linkPattern - return (stringToHtml p) - nextUnderscore = do pu <- prependedUnderscore - return (stringToHtml "_" +++ pu) - -pagenamePattern = studlyCapsPattern - -linkPattern = try $ do char '[' - l <- pagenamePattern - char '|' - t <- manyTill anyChar (char ']') - return (l,t, ("["++l++"|"++t++"]")) - <|> - do p <- studlyCapsPattern - return (p,p,p) - -studlyCapsPattern = do u1 <- upper - ls1 <- many1 lower - u2 <- upper - l2 <- lower - as <- many letter - return ([u1]++ls1++[u2]++[l2]++as) - -aCharacter = do c <- anyChar - return (stringToHtml [c]) - -deWikify sn wt = case (parse (wikiParser sn) "" wt) of - Left e -> stringToHtml ("Error in wikitext: " - ++ - (show e) - ) - Right t -> t +{- +Copyright (c) 2004, Philippa Jane Cowderoy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of the original author nor the names of any + 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 OWNER 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. +-} + +module DeWikify (deWikify, pagenamePattern) +where + +import Text.XHtml +import Text.ParserCombinators.Parsec +import List + +import ScriptSyntax + +wikiParser sn = do l <- many (prependedUnderscore + <|> try (wikiLink sn) + <|> try (scriptLink sn) + <|> try newParagraph + <|> aCharacter + ) + case l of + (_:_) -> return (foldl1 (+++) l) + [] -> return (stringToHtml "") + +newParagraph = do string "\n\n" + return (br +++ br) + <|> + do string "\r\n\r\n" + return (br +++ br) + +wikiLink sn = do (l,t,_) <- linkPattern + return (anchor (stringToHtml t) + ! [href (sn ++ "?view=" ++ l)] + ) + +prependedUnderscore = do char '_' + try nextUnderscore + <|> try matchLink + <|> try matchScriptLink + <|> return (stringToHtml "_") + where matchLink = do (_,_,p) <- linkPattern + return (stringToHtml p) + nextUnderscore = do pu <- prependedUnderscore + return (stringToHtml "_" +++ pu) + +pagenamePattern = studlyCapsPattern + +linkPattern = try $ do char '[' + l <- pagenamePattern + char '|' + t <- manyTill anyChar (char ']') + return (l,t, ("["++l++"|"++t++"]")) + <|> + do p <- studlyCapsPattern + return (p,p,p) + +studlyCapsPattern = do u1 <- upper + ls1 <- many1 lower + u2 <- upper + l2 <- lower + as <- many letter + return ([u1]++ls1++[u2]++[l2]++as) + +aCharacter = do c <- anyChar + return (stringToHtml [c]) + +deWikify sn wt = case (parse (wikiParser sn) "" wt) of + Left e -> stringToHtml ("Error in wikitext: " + ++ + (show e) + ) + Right t -> t diff --git a/src/Flippi.hs b/src/Flippi.hs --- a/src/Flippi.hs +++ b/src/Flippi.hs @@ -1,117 +1,118 @@ -{- -Copyright (c) 2004, Philippa Jane Cowderoy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * 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. - * Neither the name of the original author nor the names of any - 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 OWNER 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. --} - -module Main (main) where - -import Network.CGI hiding (Html) -import Text.XHtml -import System.IO -import System.Time -import List -import Maybe - -import PageIO -import DeWikify -import PageTemplates -import Scripts -import System.Environment - -main :: IO () -main = wrapper cgi - -cgi :: [(String, String)] -> IO Html -cgi env = do m <- return (maybe "GET" id (lookup "REQUEST_METHOD" env)) - qs <- return (maybe "" id (lookup "QUERY_STRING" env)) - case m of - 'G':'E':'T':[] -> handleGet qs env - 'P':'O':'S':'T':[] -> handlePost qs env - _ -> malformedQueryPage env - -data PParms = Default | - View String | - Edit String | - Script String - -parseParms p = case p of - ('e':'d':'i':'t':'=':[]) -> Default - ('e':'d':'i':'t':'=':e) -> Edit e - ('v':'i':'e':'w':'=':[]) -> Default - ('v':'i':'e':'w':'=':v) -> View v - ('s':'c':'r':'i':'p':'t':'=':s) -> Script s - [] -> Default - s -> View s - -handleGet qs env = do action <- return (parseParms qs) - case action of - View v -> if (isPagename v) then - viewPage v env - else defaultPage env - Default -> defaultPage env - Edit e -> if (isPagename e) then - editPage e env - else - editMalformedPage e env - Script s -> runScript s env - -handlePost qs env = do action <- return (parseParms qs) - case action of - View v -> if (isPagename v) then - viewPage v env - else defaultPage env - Default -> defaultPage env - Edit e -> if (isPagename e) then - updatePage e env - else - updateMalformedPage e env - Script s -> runScript s env - -updatePage p env = do text <- return (lookup "Text" env) - oldmodified <- return (lookup "oldDate" env) - oldmodified <- - case oldmodified of - Nothing -> return Nothing - Just ct -> return (Just ((read ct)::CalendarTime)) - modified <- getPageLastUpdated p - modified <- case modified of - Nothing -> return Nothing - Just dt -> do ct <- toCalendarTime dt - return (Just ct) - case (oldmodified, modified) of - (Nothing, Nothing) -> tryWrite text - (Nothing, Just d) -> updateMalformedPage p env - (Just d, Nothing) -> tryWrite text - (Just od, Just d) -> if (od < d) then - editConflictPage p env - else if (od > d) then - updateMalformedPage p env - else tryWrite text - where tryWrite t = case t of - Just text -> do writePage p text - updateSuccessPage p env - Nothing -> do updateMalformedPage p env +{- +Copyright (c) 2004, Philippa Jane Cowderoy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of the original author nor the names of any + 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 OWNER 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. +-} + +module Main (main) where + +import Network.CGI +import Network.CGI.Compat (wrapper) +import Text.XHtml +import System.IO +import System.Time +import List +import Maybe + +import PageIO +import DeWikify +import PageTemplates +import Scripts +import System.Environment + +main :: IO () +main = wrapper cgi + +cgi :: [(String, String)] -> IO Html +cgi env = do m <- return (maybe "GET" id (lookup "REQUEST_METHOD" env)) + qs <- return (maybe "" id (lookup "QUERY_STRING" env)) + case m of + 'G':'E':'T':[] -> handleGet qs env + 'P':'O':'S':'T':[] -> handlePost qs env + _ -> malformedQueryPage env + +data PParms = Default | + View String | + Edit String | + Script String + +parseParms p = case p of + ('e':'d':'i':'t':'=':[]) -> Default + ('e':'d':'i':'t':'=':e) -> Edit e + ('v':'i':'e':'w':'=':[]) -> Default + ('v':'i':'e':'w':'=':v) -> View v + ('s':'c':'r':'i':'p':'t':'=':s) -> Script s + [] -> Default + s -> View s + +handleGet qs env = do action <- return (parseParms qs) + case action of + View v -> if (isPagename v) then + viewPage v env + else defaultPage env + Default -> defaultPage env + Edit e -> if (isPagename e) then + editPage e env + else + editMalformedPage e env + Script s -> runScript s env + +handlePost qs env = do action <- return (parseParms qs) + case action of + View v -> if (isPagename v) then + viewPage v env + else defaultPage env + Default -> defaultPage env + Edit e -> if (isPagename e) then + updatePage e env + else + updateMalformedPage e env + Script s -> runScript s env + +updatePage p env = do text <- return (lookup "Text" env) + oldmodified <- return (lookup "oldDate" env) + oldmodified <- + case oldmodified of + Nothing -> return Nothing + Just ct -> return (Just ((read ct)::CalendarTime)) + modified <- getPageLastUpdated p + modified <- case modified of + Nothing -> return Nothing + Just dt -> do ct <- toCalendarTime dt + return (Just ct) + case (oldmodified, modified) of + (Nothing, Nothing) -> tryWrite text + (Nothing, Just d) -> updateMalformedPage p env + (Just d, Nothing) -> tryWrite text + (Just od, Just d) -> if (od < d) then + editConflictPage p env + else if (od > d) then + updateMalformedPage p env + else tryWrite text + where tryWrite t = case t of + Just text -> do writePage p text + updateSuccessPage p env + Nothing -> do updateMalformedPage p env diff --git a/src/PageIO.hs b/src/PageIO.hs --- a/src/PageIO.hs +++ b/src/PageIO.hs @@ -1,86 +1,86 @@ -{- -Copyright (c) 2004, Philippa Jane Cowderoy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * 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. - * Neither the name of the original author nor the names of any - 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 OWNER 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. --} - -module PageIO (isPagename, - getPageLastUpdated, - writePage, - getPage, - getPagenames) -where - -import System.Time -import System.Directory -import System.IO -import Monad - -import DeWikify(pagenamePattern) -import Text.ParserCombinators.Parsec as Parsec - -dataDirectory = "data" - -pagenameToFilename pn = dataDirectory ++ "/" ++ pn - -isPagename pn = case (parse (do {pagenamePattern; eof;}) "" pn) of - Left _ -> False - Right _ -> True - -getPageLastUpdated :: String -> IO (Maybe ClockTime) -getPageLastUpdated p = - catch (do date <- getModificationTime (pagenameToFilename p) - return (Just date) - ) - (\_ -> return Nothing) - -deCRLF s = case parse (many (Parsec.try (do string "\r\n"; return '\n') - <|> - anyChar - ) - ) - "" - s of - Right r -> r - -writePage p text = do h <- openBinaryFile (pagenameToFilename p) WriteMode - hPutStr h (deCRLF text) - hClose h - -getPage p env = do exists <- doesFileExist fn - if (exists) then - do xs <- readFile fn - case (deCRLF xs) of - [] -> return (Just []) - dxs -> return (last dxs `seq` Just dxs) - else return Nothing - where fn = pagenameToFilename p - -getPagenames = do dir <- getDirectoryContents dataDirectory - filterM con dir - where con fp = do c1 <- doesFileExist (pagenameToFilename fp) - c2 <- return (isPagename fp) - return (c1 && c2) +{- +Copyright (c) 2004, Philippa Jane Cowderoy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of the original author nor the names of any + 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 OWNER 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. +-} + +module PageIO (isPagename, + getPageLastUpdated, + writePage, + getPage, + getPagenames) +where + +import System.Time +import System.Directory +import System.IO +import Monad + +import DeWikify(pagenamePattern) +import Text.ParserCombinators.Parsec as Parsec + +dataDirectory = "data" + +pagenameToFilename pn = dataDirectory ++ "/" ++ pn + +isPagename pn = case (parse (do {pagenamePattern; eof;}) "" pn) of + Left _ -> False + Right _ -> True + +getPageLastUpdated :: String -> IO (Maybe ClockTime) +getPageLastUpdated p = + catch (do date <- getModificationTime (pagenameToFilename p) + return (Just date) + ) + (\_ -> return Nothing) + +deCRLF s = case parse (many (Parsec.try (do string "\r\n"; return '\n') + <|> + anyChar + ) + ) + "" + s of + Right r -> r + +writePage p text = do h <- openBinaryFile (pagenameToFilename p) WriteMode + hPutStr h (deCRLF text) + hClose h + +getPage p env = do exists <- doesFileExist fn + if (exists) then + do xs <- readFile fn + case (deCRLF xs) of + [] -> return (Just []) + dxs -> return (last dxs `seq` Just dxs) + else return Nothing + where fn = pagenameToFilename p + +getPagenames = do dir <- getDirectoryContents dataDirectory + filterM con dir + where con fp = do c1 <- doesFileExist (pagenameToFilename fp) + c2 <- return (isPagename fp) + return (c1 && c2) diff --git a/src/PageTemplates.hs b/src/PageTemplates.hs --- a/src/PageTemplates.hs +++ b/src/PageTemplates.hs @@ -1,147 +1,147 @@ -{- -Copyright (c) 2004, Philippa Jane Cowderoy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * 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. - * Neither the name of the original author nor the names of any - 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 OWNER 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. --} - -module PageTemplates where - -import Text.XHtml -import DeWikify -import PageIO -import System.Time - -import Maybe - -htmlPage p t env = return $ (header $ thetitle t) +++ bodystuff p - where bodystuff h = body $ (viewform +++ - hr +++ - p) - sn = fromJust (lookup "SCRIPT_NAME" env) - editform = stringToHtml "Edit a page: " - +++ - form ( - input ! [thetype "text", - value "", - name "edit"] - +++ - input ! [thetype "submit", value "Submit"] - ) ! [action sn, method "get"] - viewform = stringToHtml "View a page: " - +++ - form ( - input ! [thetype "text", - value "", - name "view"] - +++ - input ! [thetype "submit", value "Submit"] - ) ! [action sn, method "get"] - -page p t env = do sn <- return (fromJust (lookup "SCRIPT_NAME" env)) - htmlPage (deWikify sn p) (stringToHtml t) env - -viewPage p env = do text <- getPage p env - case text of - Just text -> htmlPage ((deWikify sn text) +++ viewFooter) - (stringToHtml p) - env - Nothing -> pageNotFound p env - where viewFooter = hr +++ (anchor (stringToHtml "Edit this page") - ! [(href (sn ++ "?edit=" ++ p))] - ) - sn = fromJust (lookup "SCRIPT_NAME" env) - -editPage p env = do sn <- return (fromJust (lookup "SCRIPT_NAME" env)) - text <- getPage p env - modified <- getPageLastUpdated p - modified <- case modified of - Just d -> toCalendarTime d - Nothing -> do ct <- getClockTime - toCalendarTime ct - htmlPage (stringToHtml ("editing " ++ p) - +++ - br - +++ - form ( - textarea ( - case text of - Nothing -> stringToHtml "" - Just t -> stringToHtml t - ) ! [cols "80", - rows "18", - name "Text"] - +++ - input ! [thetype "hidden", - name "oldDate", - value $ (show modified) - ] - +++ - input ! [thetype "submit", value "Submit"] - ) ! [action (sn ++ "?edit=" ++ p), - method "post"] - ) - (stringToHtml ("editing " ++ p)) - env - -pageNotFound p env = do sn <- return (fromJust (lookup "SCRIPT_NAME" env)) - htmlPage (pbody sn) - (stringToHtml "Page not found") - env - where pbody sn = (deWikify sn ("Page not found: " ++ p)) - +++ - br - +++ - (anchor (stringToHtml ("Create " ++ p)) - ! [(href (sn ++ "?edit=" ++ p))] - ) - -updateSuccessPage p env = page ("Page " ++ p ++ " updated") - "Update Successful" - env -updateMalformedPage p env = page "Malformed update request" - "Update Failed" - env -editMalformedPage p env = page "Malformed edit request" - "Edit Failed" - env -editConflictPage p env = page ("Somebody else updated " ++ p - ++ " while you were editing - " - ++ "your edit has been discarded" - ) - "Update Failed" - env - - -malformedQueryPage env = page "Malformed query" - "Error" - env - -unknownScriptPage s env = page ("Unknown script \"" ++ s ++ "\"") - "Error" - env - - -defaultPage env = viewPage "FrontPage" env +{- +Copyright (c) 2004, Philippa Jane Cowderoy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of the original author nor the names of any + 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 OWNER 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. +-} + +module PageTemplates where + +import Text.XHtml +import DeWikify +import PageIO +import System.Time + +import Maybe + +htmlPage p t env = return $ (header $ thetitle t) +++ bodystuff p + where bodystuff h = body $ (viewform +++ + hr +++ + p) + sn = maybe "" id (lookup "SCRIPT_NAME" env) + editform = stringToHtml "Edit a page: " + +++ + form ( + input ! [thetype "text", + value "", + name "edit"] + +++ + input ! [thetype "submit", value "Submit"] + ) ! [action sn, method "get"] + viewform = stringToHtml "View a page: " + +++ + form ( + input ! [thetype "text", + value "", + name "view"] + +++ + input ! [thetype "submit", value "Submit"] + ) ! [action sn, method "get"] + +page p t env = do sn <- return (maybe "" id (lookup "SCRIPT_NAME" env)) + htmlPage (deWikify sn p) (stringToHtml t) env + +viewPage p env = do text <- getPage p env + case text of + Just text -> htmlPage ((deWikify sn text) +++ viewFooter) + (stringToHtml p) + env + Nothing -> pageNotFound p env + where viewFooter = hr +++ (anchor (stringToHtml "Edit this page") + ! [(href (sn ++ "?edit=" ++ p))] + ) + sn = maybe "" id (lookup "SCRIPT_NAME" env) + +editPage p env = do sn <- return (maybe "" id (lookup "SCRIPT_NAME" env)) + text <- getPage p env + modified <- getPageLastUpdated p + modified <- case modified of + Just d -> toCalendarTime d + Nothing -> do ct <- getClockTime + toCalendarTime ct + htmlPage (stringToHtml ("editing " ++ p) + +++ + br + +++ + form ( + textarea ( + case text of + Nothing -> stringToHtml "" + Just t -> stringToHtml t + ) ! [cols "80", + rows "18", + name "Text"] + +++ + input ! [thetype "hidden", + name "oldDate", + value $ (show modified) + ] + +++ + input ! [thetype "submit", value "Submit"] + ) ! [action (sn ++ "?edit=" ++ p), + method "post"] + ) + (stringToHtml ("editing " ++ p)) + env + +pageNotFound p env = do sn <- return (maybe "" id (lookup "SCRIPT_NAME" env)) + htmlPage (pbody sn) + (stringToHtml "Page not found") + env + where pbody sn = (deWikify sn ("Page not found: " ++ p)) + +++ + br + +++ + (anchor (stringToHtml ("Create " ++ p)) + ! [(href (sn ++ "?edit=" ++ p))] + ) + +updateSuccessPage p env = page ("Page " ++ p ++ " updated") + "Update Successful" + env +updateMalformedPage p env = page "Malformed update request" + "Update Failed" + env +editMalformedPage p env = page "Malformed edit request" + "Edit Failed" + env +editConflictPage p env = page ("Somebody else updated " ++ p + ++ " while you were editing - " + ++ "your edit has been discarded" + ) + "Update Failed" + env + + +malformedQueryPage env = page "Malformed query" + "Error" + env + +unknownScriptPage s env = page ("Unknown script \"" ++ s ++ "\"") + "Error" + env + + +defaultPage env = viewPage "FrontPage" env diff --git a/src/RecentChanges.hs b/src/RecentChanges.hs --- a/src/RecentChanges.hs +++ b/src/RecentChanges.hs @@ -1,81 +1,81 @@ -{- -Copyright (c) 2004, Philippa Jane Cowderoy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * 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. - * Neither the name of the original author nor the names of any - 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 OWNER 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. --} - -module RecentChanges (recentChanges) where - -import Text.XHtml -import PageTemplates -import PageIO -import List - -recentChanges env = do pns <- getPagenames - pds <- mapM getPageLastUpdated pns - pnds <- return $ filter (\(_,md) -> - case md of - Nothing -> False - Just d -> True - ) - (zip pns pds) - opnds <- return $ sortBy ordering pnds - count <- case (lookup "count" env) of - Nothing -> return defaultCount - Just x -> case (reads x) of - [(i,_)]-> return i - _ -> return defaultCount - out <- return $ - (concat - (intersperse - "\n\n" - (take count - (map (\(pn,Just d) -> - (linkTo pn) ++ - " - " ++ - (show d) - ) - opnds - ) - ) - ) - ) - page ("Showing the " - ++ - (show count) - ++ - " most [:RecentChanges||RecentChanges:]:\n\n" - ++ - out - ) - "RecentChanges" - env - where ordering (_,d1) (_,d2) = case d1 `compare` d2 of - LT -> GT - EQ -> EQ - GT -> LT - defaultCount = 50 - linkTo pn = "["++pn++"|"++pn++"]" +{- +Copyright (c) 2004, Philippa Jane Cowderoy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of the original author nor the names of any + 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 OWNER 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. +-} + +module RecentChanges (recentChanges) where + +import Text.XHtml +import PageTemplates +import PageIO +import List + +recentChanges env = do pns <- getPagenames + pds <- mapM getPageLastUpdated pns + pnds <- return $ filter (\(_,md) -> + case md of + Nothing -> False + Just d -> True + ) + (zip pns pds) + opnds <- return $ sortBy ordering pnds + count <- case (lookup "count" env) of + Nothing -> return defaultCount + Just x -> case (reads x) of + [(i,_)]-> return i + _ -> return defaultCount + out <- return $ + (concat + (intersperse + "\n\n" + (take count + (map (\(pn,Just d) -> + (linkTo pn) ++ + " - " ++ + (show d) + ) + opnds + ) + ) + ) + ) + page ("Showing the " + ++ + (show count) + ++ + " most [:RecentChanges||RecentChanges:]:\n\n" + ++ + out + ) + "RecentChanges" + env + where ordering (_,d1) (_,d2) = case d1 `compare` d2 of + LT -> GT + EQ -> EQ + GT -> LT + defaultCount = 50 + linkTo pn = "["++pn++"|"++pn++"]" diff --git a/src/ScriptSyntax.hs b/src/ScriptSyntax.hs --- a/src/ScriptSyntax.hs +++ b/src/ScriptSyntax.hs @@ -1,124 +1,124 @@ -{- -Copyright (c) 2004, Philippa Jane Cowderoy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * 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. - * Neither the name of the original author nor the names of any - 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 OWNER 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. --} - -module ScriptSyntax (scriptLink, matchScriptLink) where - -import Text.XHtml -import Text.ParserCombinators.Parsec -import List - -data ScriptParm = Field String | Value String String - -scriptname = many1 alphaNum - -fieldname = many1 alphaNum - -parmstring = do char '"' - ps <- manyTill anyChar (char '"') - return ps - -scriptparm = try (do f <- fieldname - char '=' - p <- parmstring - return (Value f p) - ) - <|> - do f <- fieldname - return (Field f) - -scriptLink sn = do char '[' - char ':' - s <- scriptname - char '|' - ps <- many (do p <- scriptparm - many (char ' ') - return p - ) - char '|' - t <- manyTill anyChar (try $ do char ':'; char ']';) - t <- case t of - [] -> return s - _ -> return t - case ps of - [] -> linkToScript s t - ps -> return (form ( - (foldl1 (\a b->a +++ br +++ b) - (map parmToField ps) - ) - +++ - input ! [thetype "submit", value t] - ) ! [action (sn ++ "?script=" ++ s), - method "post" - ] - ) - where parmToField (Value f v) = - input ! [thetype "hidden", - name f, - value v - ] - parmToField (Field f) = - (f ++ ": ") - +++ - input ! [thetype "text", - name f, - value "" - ] - linkToScript s t = - return (anchor (stringToHtml t) - ! [href (sn ++ "?script=" ++ s) - ] - ) - -matchScriptLink = do char '[' - char ':' - s <- scriptname - char '|' - ps <- many (try (do f <- fieldname - char '=' - p <- parmstring - spaces <- many (char ' ') - return (f ++ "=\"" - ++ p ++ - "\"" ++ - spaces - ) - ) - <|> - (do f <- fieldname - spaces <- many (char ' ') - return (f ++ spaces) - ) - ) - char '|' - t <- manyTill anyChar (try $ do char ':'; char ']';) - return (stringToHtml ("[:" ++ s ++ "|" ++ - (concat ps) ++ "|" - ++ t ++ ":]" - ) - ) +{- +Copyright (c) 2004, Philippa Jane Cowderoy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of the original author nor the names of any + 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 OWNER 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. +-} + +module ScriptSyntax (scriptLink, matchScriptLink) where + +import Text.XHtml +import Text.ParserCombinators.Parsec +import List + +data ScriptParm = Field String | Value String String + +scriptname = many1 alphaNum + +fieldname = many1 alphaNum + +parmstring = do char '"' + ps <- manyTill anyChar (char '"') + return ps + +scriptparm = try (do f <- fieldname + char '=' + p <- parmstring + return (Value f p) + ) + <|> + do f <- fieldname + return (Field f) + +scriptLink sn = do char '[' + char ':' + s <- scriptname + char '|' + ps <- many (do p <- scriptparm + many (char ' ') + return p + ) + char '|' + t <- manyTill anyChar (try $ do char ':'; char ']';) + t <- case t of + [] -> return s + _ -> return t + case ps of + [] -> linkToScript s t + ps -> return (form ( + (foldl1 (\a b->a +++ br +++ b) + (map parmToField ps) + ) + +++ + input ! [thetype "submit", value t] + ) ! [action (sn ++ "?script=" ++ s), + method "post" + ] + ) + where parmToField (Value f v) = + input ! [thetype "hidden", + name f, + value v + ] + parmToField (Field f) = + (f ++ ": ") + +++ + input ! [thetype "text", + name f, + value "" + ] + linkToScript s t = + return (anchor (stringToHtml t) + ! [href (sn ++ "?script=" ++ s) + ] + ) + +matchScriptLink = do char '[' + char ':' + s <- scriptname + char '|' + ps <- many (try (do f <- fieldname + char '=' + p <- parmstring + spaces <- many (char ' ') + return (f ++ "=\"" + ++ p ++ + "\"" ++ + spaces + ) + ) + <|> + (do f <- fieldname + spaces <- many (char ' ') + return (f ++ spaces) + ) + ) + char '|' + t <- manyTill anyChar (try $ do char ':'; char ']';) + return (stringToHtml ("[:" ++ s ++ "|" ++ + (concat ps) ++ "|" + ++ t ++ ":]" + ) + ) diff --git a/src/Scripts.hs b/src/Scripts.hs --- a/src/Scripts.hs +++ b/src/Scripts.hs @@ -1,49 +1,49 @@ -{- -Copyright (c) 2004, Philippa Jane Cowderoy -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * 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. - * Neither the name of the original author nor the names of any - 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 OWNER 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. --} - -module Scripts (runScript) where - -import Text.XHtml -import PageTemplates -import qualified Data.Map as Map - -import RecentChanges - -scriptMap = Map.fromList scripts - -runScript :: String -> [(String, String)] -> IO Html -runScript s env = case (Map.lookup s scriptMap) of - Just script -> script env - Nothing -> unknownScriptPage s env - -scripts = [("HelloWorld", helloWorldScript), - ("RecentChanges", recentChanges) - ] - -helloWorldScript env = page "Hello World!" "Hello World!" env +{- +Copyright (c) 2004, Philippa Jane Cowderoy +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * 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. + * Neither the name of the original author nor the names of any + 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 OWNER 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. +-} + +module Scripts (runScript) where + +import Text.XHtml +import PageTemplates +import qualified Data.Map as Map + +import RecentChanges + +scriptMap = Map.fromList scripts + +runScript :: String -> [(String, String)] -> IO Html +runScript s env = case (Map.lookup s scriptMap) of + Just script -> script env + Nothing -> unknownScriptPage s env + +scripts = [("HelloWorld", helloWorldScript), + ("RecentChanges", recentChanges) + ] + +helloWorldScript env = page "Hello World!" "Hello World!" env