Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

Anonymous BBS

Name: Anonymous 2007-04-22 14:18 ID:faJud7z4

I want to set up a message board in my own language.
What do you recomand:
1.Shiichan
2.Kareha
3.Others( if so what?)

Name: ddddddddddddddddddddddddddddd 2007-04-22 19:40 ID:Zj9Po692

-- -----------------------------------------------------------------------------
-- HBBS
-- Licence: BSD
-- Copyright: dddddddddddddddddddddddd 2007 -

module Main where

import Control.Monad
import Network.CGI
import System.IO

import Text.XHtml.Strict
import Data.Maybe
import Data.Char

data Entry = Entry { author  :: String
                   , text    :: String
    } deriving (Show, Read)

main :: IO ()
main = runCGI (handleErrors hbbs)

hbbs :: CGI CGIResult
hbbs = do
    let out = output . showHtml
    efile   <- liftIO (openFile "entries.dat" ReadWriteMode)
    name    <- getInput "name"
    text    <- getInput "text"
    entries <- liftM read (liftIO (hGetLine efile))

    case text of
        Nothing  -> out $ hbbstitle +++
                          hbbscontent entries +++
                          hbbsform +++
                          hbbsend

        Just txt ->
            do let n  = take  20 $ fromMaybe "Anonymous" name
                   t  = take 200 $ filter isAscii txt
                   es = take  10 $ entries
               liftIO $ do hSeek efile AbsoluteSeek 0
                           hPutStrLn efile (show ((Entry n t):es))
                           hClose efile
               out $ hbbssubmitted entries (fromMaybe "Anonymous" name) txt

hbbssubmitted es n t =
    p (toHtml ("Saved!")) +++
    p (toHtml ((address (toHtml "Click here to reload")) ! [src "Main.cgi"]))

hbbstitle =
    (thetitle (toHtml "HBBS")) +++
    h1 (toHtml "HBBS!!") +++
    h2 (toHtml "Do you dare to post?!")


hbbsform  =
    form $
        (p (toHtml "Name: ")) +++
        (textfield "name") +++
        (p (toHtml "Message: ")) +++
        (textfield "text") +++
        (submit "send" "poooost") ! [method "POST"]

hbbscontent es =
    let formatentry (Entry n t) = p (toHtml ("name: " ++ n)) +++
                                  p (toHtml (unlines (wrapList 72 t)))
     in hr +++ h2 (toHtml "Messages: ") +++ (map formatentry es) +++ hr

hbbsend =
    p (toHtml ("HBBS is powered by the awesome power of Text.XHtml.Strict " ++
              "and Network.CGI. Rock on!")) +++

wrapList :: Int -> [a] -> [[a]]
wrapList _ [] = []
wrapList n xs = (take n xs) : wrapList n (drop n xs)


Needs some work, but it functions. I even have it running on my web server, but I'm not adventurous enough to link it.

You'll have to create a 666 file entries.dat with an empty entry list (i.e. [Entry {author = "", text = ""}])

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List