Flippi 0.0.4 → 0.0.5
raw patch · 8 files changed
+704/−703 lines, 8 filesdep ~cgi
Dependency ranges changed: cgi
Files
- Flippi.cabal +3/−3
- src/DeWikify.hs +96/−96
- src/Flippi.hs +118/−117
- src/PageIO.hs +86/−86
- src/PageTemplates.hs +147/−147
- src/RecentChanges.hs +81/−81
- src/ScriptSyntax.hs +124/−124
- src/Scripts.hs +49/−49
Flippi.cabal view
@@ -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 <flippa@flippac.org> 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
src/DeWikify.hs view
@@ -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
src/Flippi.hs view
@@ -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
src/PageIO.hs view
@@ -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)
src/PageTemplates.hs view
@@ -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
src/RecentChanges.hs view
@@ -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++"]"
src/ScriptSyntax.hs view
@@ -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 ++ ":]"+ )+ )
src/Scripts.hs view
@@ -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