Flippi (empty) → 0.0.3
raw patch · 17 files changed
+908/−0 lines, 17 filesdep +FiniteMapdep +basedep +cgisetup-changed
Dependencies added: FiniteMap, base, cgi, directory, haskell98, html, old-time, parsec, xhtml
Files
- Flippi.cabal +23/−0
- LICENSE +31/−0
- README +83/−0
- Setup.hs +5/−0
- data/FlippiSyntax +13/−0
- data/FrontPage +7/−0
- data/LameEasterEgg +3/−0
- data/RecentChanges +3/−0
- data/ScriptLinks +21/−0
- data/WhatIsFlippi +3/−0
- src/DeWikify.hs +96/−0
- src/Flippi.hs +116/−0
- src/PageIO.hs +86/−0
- src/PageTemplates.hs +159/−0
- src/RecentChanges.hs +81/−0
- src/ScriptSyntax.hs +129/−0
- src/Scripts.hs +49/−0
+ Flippi.cabal view
@@ -0,0 +1,23 @@+name: Flippi+version: 0.0.3+synopsis: Wiki+description: Flippi is a Wiki clone written in Haskell+category: Text+license: BSD3+license-file: LICENSE+author: Philippa Cowderoy+maintainer: Philippa Cowderoy <flippa@flippac.org>+homepage: http://www.flippac.org/projects/flippi/+build-depends: base, haskell98, xhtml, html, cgi, parsec, directory, old-time, FiniteMap+build-type: Simple+tested-with: GHC==6.4+data-files: README, data/ScriptLinks, data/RecentChanges, data/LameEasterEgg, data/WhatIsFlippi,+ data/FrontPage, data/FlippiSyntax++executable: flippi+main-is: Flippi.hs+hs-source-dirs: src/+other-modules: DeWikify, PageIO, PageTemplates, RecentChanges, Scripts, ScriptSyntax++ghc-options: -O2 -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2007,2008 Spencer Janssen+Copyright (c) 2007,2008 Don Stewart++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ README view
@@ -0,0 +1,83 @@+Flippi v0.03: A Wiki clone written in Haskell +============================================= + +As the title suggests, Flippi is a Wiki clone - a fairly basic one at +present, written in Haskell by Philippa Cowderoy and released under the BSD +license. There's an installation of Flippi running at +http://www.scannedinavian.org/cgi-bin/flippi/flippi - hopefully, details of +user modifications, new releases etc will be kept there. + +Requirements: Flippi is written in plain Haskell 98 using a recent version + of the hierarchical libraries - it builds fine under + GHC 6.21, doesn't build under 5.02, hasn't been tested anywhere + else. + +To configure: Edit the source a little. The only really critical thing is + where the data files go - this can be changed by editing the + function dataDirectory in the PageIO module. The default is a + directory data under the directory Flippi is run from. + + To change how the pages look on screen, edit PageTemplates.hs. + + To change the wiki markup, edit DeWikify.hs. + + Scripts are ordinary functions of type + [(String,String)] -> IO Html - to make one available, add an + entry to the list "scripts" in Scripts.hs. It's probably a + good idea if anybody distributing scripts they've written + includes a fuller description of how to do this in the + documentation so as to make things easier for users who don't + know Haskell. + +Installation: Should be pretty simple: either compile the lot (a GHC --make + works fine) and set it up as a CGI executable or run it via + your preferred Haskell interpreter like any other script. + + GHC users should find some variant on this works: + "ghc --make Flippi.hs -o <foo>" where <foo> is the name of + the resulting executable. + + Optionally, copy the files found under data\ in the + distribution to wherever the CGI will be looking for page + data - these initial pages document the markup syntax and tell + users you're running Flippi. If you don't want to do this, + you'll want to create a FrontPage - point a browser at the CGI + and follow the link to create it. + +History: +-------- + +v0.03: * Added scripting API and corresponding syntax + (see Script.hs, ScriptSyntax.hs) + * Added RecentChanges script + * Added HelloWorld example script in Script.hs + * Added getPagenames to PageIO + * Restricted page requests to valid pagenames as defined by a + pattern in DeWikify (an isPagename function is exported by + PageIO) + * hopefully removed DOS/UNIX data issue - all data files are now + written out in binary format, all input is done in text mode and + then has CRLFs forcibly converted to LFs. The parser will read + both LF and CRLF as new lines, though this should never be + needed now. + * Data files now go in a specified directory rather than having + a specified prefix + * A couple more bugfixes + +v0.02: * Added proper (first edit wins) edit conflict resolution + * Fixed some potential holes such as editing the page "" + * Better page templates + * Enough markup to just about be usable (paragraphs, escapes) + +v0.01: * Early version shown to a few friends + * Missing just about everything! But it does page IO + +Credits: +-------- + +Thanks to Shae Erisson for encouragement, discussion, a test server and above +all else naming Flippi - if you don't like the name, blame it on him! + +-- +Philippa Cowderoy +flippa@flippac.org
+ Setup.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/runhaskell++import Distribution.Simple++main = defaultMainWithHooks defaultUserHooks
+ data/FlippiSyntax view
@@ -0,0 +1,13 @@+The syntax available on Flippi is fairly simple at present. + +New paragraphs are created whenever two new lines are encountered. + +There are two ways to create a link to a page: + +WordsSmashedTogether is a link automatically - the pattern here is one upper case letter, one or more lower case letters, one upper case letter, one lower case letter then any number of letters. + +_[WordsSmashedTogether|description] gives a [LameEasterEgg|link with a description] + +As of version 0.03, Flippi also has support for scripts. See the ScriptLinks for information on how to provide links that run a script and show the result. + +Finally, if you don't want something that looks like a link to be a link, you can put an underscore in front of it to escape out the markup __LikeSo. You can even escape out an escape, which is how that example was written.
+ data/FrontPage view
@@ -0,0 +1,7 @@+Hi! This is the default FrontPage for Flippi, a Wiki clone written in Haskell. Some things you might be interested in: + +FlippiSyntax + +WhatIsFlippi (a link to download Flippi can be found here) + +[:RecentChanges||:]
+ data/LameEasterEgg view
@@ -0,0 +1,3 @@+Congratulations, you've just found a lame easter egg! + +Perhaps you could edit it to make it more amusing?
+ data/RecentChanges view
@@ -0,0 +1,3 @@+If you're looking at this page, you may want to go here instead: [:RecentChanges||The RecentChanges script:] + +If not, you're probably looking for documentation about the RecentChanges script the link above leads to. The script's pretty simple, it produces a list of pages sorted by the date they were last updated on. It has one optional parameter called "count", which if set to an integer value will dictate how many pages it'll list - if count isn't set or isn't parseable, RecentChanges will default to 50.
+ data/ScriptLinks view
@@ -0,0 +1,21 @@+As of version 0.03, Flippi has support for scripts. Here're some example links to run them: + +_[:RecentChanges|count|description:] + +[:RecentChanges|count|description:] + +_[:RecentChanges|count="20"|Recent Changes (count set to 20):] + +[:RecentChanges|count="20"|Recent Changes (count set to 20):] + +_[:RecentChanges||Recent Changes with no parameters:] + +[:RecentChanges||Recent Changes with no parameters:] + +_[:RecentChanges|count="40"|:] + +[:RecentChanges|count="40"|:] + +In the above examples, RecentChanges is a script, and count is an optional parameter that the RecentChanges script understands. Flippi doesn't currently come with a script that takes more than one parameter, but here's a hypothetical example: + +_[:SomeScript|foo bar="baz" quux|This script does not exist:]
+ data/WhatIsFlippi view
@@ -0,0 +1,3 @@+Flippi is a Wiki clone - that is, a system where you or anybody else can view and create pages on-the-fly. + +For those interested, Flippi was written in Haskell by Philippa Cowderoy and is freely available under the BSD license. It can be found at http://www.flippac.org/projects/flippi/ and a running copy is available at http://www.scannedinavian.org/cgi-bin/flippi/flippi .
+ src/DeWikify.hs view
@@ -0,0 +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.Html +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
@@ -0,0 +1,116 @@+{- +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.Html +import System.IO +import System.Time +import List +import Maybe + +import PageIO +import DeWikify +import PageTemplates +import Scripts + +main :: IO () +main = wrapper cgi + +cgi :: [(String, String)] -> IO Html +cgi env = do m <- return (fromJust (lookup "REQUEST_METHOD" env)) + qs <- return (fromJust (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
@@ -0,0 +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)
+ src/PageTemplates.hs view
@@ -0,0 +1,159 @@+{- +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.Html +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 ((stringToHtmlString sn) ++ + "?edit=" ++ + (stringToHtmlString 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 $ stringToHtmlString + (show modified) + ] + +++ + input ! [thetype "submit", value "Submit"] + ) ! [action (stringToHtmlString sn ++ + "?edit=" ++ + (stringToHtmlString 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 ((stringToHtmlString sn) ++ + "?edit=" ++ + (stringToHtmlString 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
@@ -0,0 +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.Html +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
@@ -0,0 +1,129 @@+{- +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.Html +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 (stringToHtmlString sn ++ + "?script=" ++ + (stringToHtmlString s) + ), + method "post" + ] + ) + where parmToField (Value f v) = + input ! [thetype "hidden", + name f, + value (stringToHtmlString v) + ] + parmToField (Field f) = + stringToHtmlString (f ++ ": ") + +++ + input ! [thetype "text", + name f, + value (stringToHtmlString "") + ] + linkToScript s t = + return (anchor (stringToHtml t) + ! [href (sn ++ "?script=" ++ + (stringToHtmlString 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
@@ -0,0 +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.Html +import PageTemplates +import Data.FiniteMap + +import RecentChanges + +scriptMap = listToFM scripts + +runScript :: String -> [(String, String)] -> IO Html +runScript s env = case (lookupFM scriptMap s) of + Just script -> script env + Nothing -> unknownScriptPage s env + +scripts = [("HelloWorld", helloWorldScript), + ("RecentChanges", recentChanges) + ] + +helloWorldScript env = page "Hello World!" "Hello World!" env