packages feed

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 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