Flippi 0.0.3 → 0.0.4
raw patch · 8 files changed
+30/−46 lines, 8 filesdep +containersdep −FiniteMapdep −htmlnew-uploader
Dependencies added: containers
Dependencies removed: FiniteMap, html
Files
- Flippi.cabal +3/−3
- src/DeWikify.hs +2/−2
- src/Flippi.hs +5/−4
- src/PageIO.hs +1/−1
- src/PageTemplates.hs +6/−18
- src/RecentChanges.hs +2/−2
- src/ScriptSyntax.hs +6/−11
- src/Scripts.hs +5/−5
Flippi.cabal view
@@ -1,5 +1,5 @@ name: Flippi-version: 0.0.3+version: 0.0.4 synopsis: Wiki description: Flippi is a Wiki clone written in Haskell category: Text@@ -8,9 +8,9 @@ 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-depends: base, haskell98, xhtml, cgi, parsec, directory, old-time, containers build-type: Simple-tested-with: GHC==6.4+tested-with: GHC==6.8 data-files: README, data/ScriptLinks, data/RecentChanges, data/LameEasterEgg, data/WhatIsFlippi, data/FrontPage, data/FlippiSyntax
src/DeWikify.hs view
@@ -30,7 +30,7 @@ module DeWikify (deWikify, pagenamePattern) where -import Text.Html +import Text.XHtml import Text.ParserCombinators.Parsec import List @@ -93,4 +93,4 @@ ++ (show e) ) - Right t -> t+ Right t -> t
src/Flippi.hs view
@@ -30,7 +30,7 @@ module Main (main) where import Network.CGI hiding (Html) -import Text.Html +import Text.XHtml import System.IO import System.Time import List @@ -40,13 +40,14 @@ import DeWikify import PageTemplates import Scripts +import System.Environment 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)) +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 @@ -113,4 +114,4 @@ where tryWrite t = case t of Just text -> do writePage p text updateSuccessPage p env - Nothing -> do updateMalformedPage p env+ Nothing -> do updateMalformedPage p env
src/PageIO.hs view
@@ -83,4 +83,4 @@ filterM con dir where con fp = do c1 <- doesFileExist (pagenameToFilename fp) c2 <- return (isPagename fp) - return (c1 && c2)+ return (c1 && c2)
src/PageTemplates.hs view
@@ -29,7 +29,7 @@ module PageTemplates where -import Text.Html +import Text.XHtml import DeWikify import PageIO import System.Time @@ -70,11 +70,7 @@ env Nothing -> pageNotFound p env where viewFooter = hr +++ (anchor (stringToHtml "Edit this page") - ! [(href ((stringToHtmlString sn) ++ - "?edit=" ++ - (stringToHtmlString p) - ) - )] + ! [(href (sn ++ "?edit=" ++ p))] ) sn = fromJust (lookup "SCRIPT_NAME" env) @@ -100,15 +96,11 @@ +++ input ! [thetype "hidden", name "oldDate", - value $ stringToHtmlString - (show modified) + value $ (show modified) ] +++ input ! [thetype "submit", value "Submit"] - ) ! [action (stringToHtmlString sn ++ - "?edit=" ++ - (stringToHtmlString p) - ), + ) ! [action (sn ++ "?edit=" ++ p), method "post"] ) (stringToHtml ("editing " ++ p)) @@ -123,11 +115,7 @@ br +++ (anchor (stringToHtml ("Create " ++ p)) - ! [(href ((stringToHtmlString sn) ++ - "?edit=" ++ - (stringToHtmlString p) - ) - )] + ! [(href (sn ++ "?edit=" ++ p))] ) updateSuccessPage p env = page ("Page " ++ p ++ " updated") @@ -156,4 +144,4 @@ env -defaultPage env = viewPage "FrontPage" env+defaultPage env = viewPage "FrontPage" env
src/RecentChanges.hs view
@@ -29,7 +29,7 @@ module RecentChanges (recentChanges) where -import Text.Html +import Text.XHtml import PageTemplates import PageIO import List @@ -78,4 +78,4 @@ EQ -> EQ GT -> LT defaultCount = 50 - linkTo pn = "["++pn++"|"++pn++"]"+ linkTo pn = "["++pn++"|"++pn++"]"
src/ScriptSyntax.hs view
@@ -29,7 +29,7 @@ module ScriptSyntax (scriptLink, matchScriptLink) where -import Text.Html +import Text.XHtml import Text.ParserCombinators.Parsec import List @@ -73,30 +73,25 @@ ) +++ input ! [thetype "submit", value t] - ) ! [action (stringToHtmlString sn ++ - "?script=" ++ - (stringToHtmlString s) - ), + ) ! [action (sn ++ "?script=" ++ s), method "post" ] ) where parmToField (Value f v) = input ! [thetype "hidden", name f, - value (stringToHtmlString v) + value v ] parmToField (Field f) = - stringToHtmlString (f ++ ": ") + (f ++ ": ") +++ input ! [thetype "text", name f, - value (stringToHtmlString "") + value "" ] linkToScript s t = return (anchor (stringToHtml t) - ! [href (sn ++ "?script=" ++ - (stringToHtmlString s) - ) + ! [href (sn ++ "?script=" ++ s) ] )
src/Scripts.hs view
@@ -29,16 +29,16 @@ module Scripts (runScript) where -import Text.Html +import Text.XHtml import PageTemplates -import Data.FiniteMap +import qualified Data.Map as Map import RecentChanges -scriptMap = listToFM scripts +scriptMap = Map.fromList scripts runScript :: String -> [(String, String)] -> IO Html -runScript s env = case (lookupFM scriptMap s) of +runScript s env = case (Map.lookup s scriptMap) of Just script -> script env Nothing -> unknownScriptPage s env @@ -46,4 +46,4 @@ ("RecentChanges", recentChanges) ] -helloWorldScript env = page "Hello World!" "Hello World!" env+helloWorldScript env = page "Hello World!" "Hello World!" env