diff --git a/executable/Main.hs b/executable/Main.hs
--- a/executable/Main.hs
+++ b/executable/Main.hs
@@ -1,44 +1,635 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+------------------------------------------------------------------------------
+-- Main Kibro executable
+
 module Main where
 
+import System.Posix.Signals      (installHandler, sigPIPE, Handler(Ignore))
+
+import Prelude hiding (catch)
+import Control.Arrow hiding ((<+>))
+import Control.Concurrent
+import Control.Exception
+import Control.Monad.Error
+import Control.Monad.State
+import Control.Monad.Reader
+import Data.List
+import Data.Maybe
 import System
 import System.IO
+import qualified System.IO.Strict as SIO
+import System.FilePath
 import System.Directory
+import System.Process
 import Text.Printf
-import Data.Maybe
-import Data.List
-import System.FilePath
-import Data.Validate
-import Control.Applicative
-
-import Data.Lighttpd
-
-import New
-import Help
-import Build
-import Start
-import Restart
-import Stop
-import Configure
-import Clean
+import Text.Regex
 
-import Utils
+------------------------------------------------------------------------------
+-- Main start-up functions
 
+-- | Wrapper for start-up in main executable
 main :: IO ()
 main = do
-  args <- getArgs
-  case args of
-    (cmd:opts) -> runCmd cmd opts
-    _          -> showHelp
+  installHandler sigPIPE Ignore Nothing
+  getArgs >>= tryCommand
 
-runCmd :: String -> [String] -> IO ()
-runCmd cmd xs = fromMaybe showHelp $ lookup cmd commands >>= return . ($ xs)
+-- | Tries the given command
+tryCommand :: [String] -> IO ()
+tryCommand [] = do name <- getProgName
+                   error $ "no command given (try `" ++ name ++ " help')"
+tryCommand (command:args) =
+    case find ((==command) . cmdName) commands of
+      Just cmd -> startCommand cmd args
+      Nothing  -> error $ printf "No such command `%s'" command
 
-commands :: [(String, [String] -> IO ())]
-commands = [("new",new)
-           ,("build",build)
-           ,("start",start)
-           ,("restart",restart)
-           ,("stop",stop)
-           ,("refresh",refresh)
-           ,("configure",configure)
-           ,("clean",clean)]
+-- | Starts the Kibro program's first command
+startCommand :: Cmd -> [String] -> IO ()
+startCommand cmd args = do
+  pwd <- getCurrentDirectory
+  name <- getProgName
+  let kibroSt = KibroSt { kibProject = Nothing
+                        , kibProjDir = error "project directory not defined"
+                        , kibCmd     = cmd
+                        , kibArgs    = args 
+                        , kibAppName = name }
+  hSetBuffering stdout NoBuffering
+  status <- evalStateT (runErrorT (cmdAct cmd args)) kibroSt
+  either error (const $ return ()) status
+
+------------------------------------------------------------------------------
+-- Kibro commands
+
+-- | Command list
+commands :: [Cmd]
+commands = [startCmd,stopCmd,buildCmd,refreshCmd
+           ,restartCmd,configureCmd,newCmd,helpCmd]
+
+----------------------------------------
+-- `configure' command
+configureCmd :: Cmd
+configureCmd = Cmd { cmdName = "configure"
+                   , cmdDesc = "Use this to rewrite config files (lighttpd.conf, ..)"
+                   , cmdFlags = []
+                   , cmdAct  = action } where
+    action :: [String] -> Command ()
+    action _ = do initProject
+                  configureProject
+
+configureProject :: Command ()
+configureProject = do
+  writeLightyConf 
+
+----------------------------------------
+-- `refresh' command
+refreshCmd :: Cmd
+refreshCmd = Cmd { cmdName = "refresh"
+                 , cmdDesc = "Rebuild source, if success, restart FastCGI/Lighttpd"
+                 , cmdFlags = []
+                 , cmdAct  = action } where
+    action :: [String] -> Command ()
+    action _ = do initProject
+                  cmdAct buildCmd []
+                  stopFastCGI
+                  spawnFCGI
+
+----------------------------------------
+-- `restart' command
+restartCmd :: Cmd
+restartCmd = Cmd { cmdName = "restart"
+                 , cmdDesc = "Stop and start Lighttpd and/or FastCGI server"
+                 , cmdFlags = []
+                 , cmdAct  = action } where
+    action :: [String] -> Command ()
+    action _ = do initProject
+                  cmdAct stopCmd []
+                  cmdAct startCmd []
+
+----------------------------------------
+-- `stop' command
+
+stopCmd :: Cmd
+stopCmd = Cmd { cmdName = "stop"
+               , cmdDesc = "Stop Lighttpd and/or FastCGI server"
+               , cmdFlags = []
+               , cmdAct  = action } where
+    action :: [String] -> Command ()
+    action _ = do
+      initProject
+      stopProject
+
+stopProject :: Command ()
+stopProject = do stopFastCGI
+                 stopLighttpd
+
+stopLighttpd = onlyIfLighttpd $ stopDaemon "lighttpd" "Stopping Lighttpd ... "
+stopFastCGI = stopDaemon "fastcgi"  "Stopping FastCGI ... "
+
+stopDaemon :: String -> String -> Command ()
+stopDaemon name caption = do
+  dirs <- projectDirs
+  let lighty = fromJust (lookup name dirs)
+      pid = lighty </> (name ++ ".pid")
+  exists <- liftIO $ doesFileExist pid
+  if exists
+     then do liftIO $ putStrLn caption
+             endDaemon pid
+     else liftIO $ putStrLn $ "no such file " ++ pid
+
+----------------------------------------
+-- `start' command
+
+startCmd :: Cmd
+startCmd = Cmd { cmdName = "start"
+               , cmdDesc = "Start Lighttpd and FastCGI server"
+               , cmdFlags = []
+               , cmdAct  = action } where
+    action :: [String] -> Command ()
+    action _ = do
+      initProject
+      ensureBuilt
+      startProject
+
+startProject :: Command ()
+startProject = do
+  spawnFCGI
+  startLighty
+
+startLighty :: Command ()
+startLighty = onlyIfLighttpd $ do
+    dirs <- projectDirs
+    let cmd = "lighttpd -f " ++ conf
+        lighty = fromJust (lookup "lighttpd" dirs)
+        conf = lighty </> "lighttpd.conf"
+        pid = lighty </> "lighttpd.pid"
+    performIfNotExists pid (Just "Lighttpd daemon already running.") $ do
+      liftIO $ putStrLn "Spawning Lighttpd daemon ... "
+      runShellCmd cmd
+      liftIO $ putStrLn "Lighttpd daemon started."
+
+spawnFCGI :: Command ()
+spawnFCGI = do
+  name <- projectName
+  dirs <- projectDirs
+  dir  <- projectDir
+  out <- gets $ projOutDir . fromJust . kibProject
+  let cmd = printf "spawn-fcgi -f %s -s %s -P %s" fcgi sock pid
+      fpath = fromJust $ lookup "fastcgi" dirs
+      ppath = fromJust $ lookup "public" dirs
+      fcgi = dir </> out </> name ++ ".fcgi"
+      sock = fpath </> name ++ ".sock"
+      pid = fpath </> "fastcgi.pid"
+  performIfNotExists pid (Just "FastCGI daemon already running.") $ do
+    liftIO $ putStrLn "Spawning FastCGI daemon ... "
+    runShellCmd cmd
+    liftIO $ putStrLn "Done."
+
+ensureBuilt :: Command ()
+ensureBuilt = do
+  name <- projectName
+  dir  <- projectDir
+  out <- gets $ projOutDir . fromJust . kibProject
+  let fcgi = dir </> out </> name ++ ".fcgi"
+  performIfNotExists fcgi Nothing $ do
+    liftIO $ putStrLn "Not yet built, building ..."
+    cmdAct buildCmd []
+    liftIO $ putStrLn "Finished building."
+
+----------------------------------------
+-- `help' command
+
+-- | Display help about commands
+helpCmd :: Cmd
+helpCmd = Cmd { cmdName = "help"
+              , cmdDesc = "Help about commands (try `help <command>')"
+              , cmdFlags = []
+              , cmdAct  = action } where
+    action :: [String] -> Command ()
+    action []      = cmdList
+    action (cmd:_) = cmdHelp cmd
+
+-- | List all the commands
+cmdList :: Command ()
+cmdList = do
+  let longest = foldr1 max $ map (length . cmdName) commands
+  appName <- gets kibAppName
+  liftIO $ do
+    printf "Usage: %s COMMAND [FLAGS]\n\n" appName
+    putStrLn "Commands:"
+    mapM_ (showHelp longest) commands
+    putStrLn "\nTypical step for creating Kibro project:"
+    putStrLn "  kibro new [PROJECT_NAME]"
+  where showHelp len (Cmd name desc _ _) = do
+            printf "%s   %s\n" (fill ' ' len name) desc
+
+-- | Show help for a command
+cmdHelp :: String -> Command ()
+cmdHelp command = 
+    case find ((==command) . cmdName) commands of
+      Nothing  -> cmdError $ printf "No such command `%s'" command
+      Just cmd -> do 
+        appName <- gets kibAppName
+        liftIO $ do
+          let longest = foldr1 max $ map (length . fst) (cmdFlags cmd)
+          printf "Usage: %s %s [FLAGS]\n\n" appName command
+          printf "Flags for %s:\n" command
+          mapM_ (showFlag longest) (cmdFlags cmd)
+          where showFlag len (name,desc) = do
+                  printf " --%s   %s\n" (fill ' ' len name) desc
+
+----------------------------------------
+-- `build' command
+
+-- | Build the current project
+buildCmd :: Cmd
+buildCmd = Cmd { cmdName  = "build"
+               , cmdDesc  = "Build the current project"
+               , cmdFlags = []
+               , cmdAct   = action } where
+    action :: [String] -> Command ()
+    action _ = do
+      initProject
+      buildProject
+
+buildProject :: Command ()
+buildProject = do
+  dir <- projectDir
+  main <- projectMain
+  name <- projectName
+  let cmd = "ghc --make " ++ dir </> main ++ " -o public" </> fcgi ++ " -threaded"
+      fcgi = name ++ ".fcgi"
+  runShellCmd cmd
+
+----------------------------------------
+-- `new' command
+
+-- | Create a new project
+newCmd :: Cmd
+newCmd = Cmd { cmdName  = "new"
+             , cmdDesc  = "Create a new project"
+                          -- TODO
+             , cmdFlags = [("start","Start after creating")]
+             , cmdAct   = action } where
+    action :: [String] -> Command ()
+    action []       = cmdError "`new' command needs a project name"
+    action (name:_) = do
+      case match regex name of
+        Nothing -> cmdError $ "invalid project name, should be " ++ regex
+        Just _  -> do newProject name; tryMakeProject
+      where regex = "^[a-z][a-z0-9_-]+$"
+
+-- | Try to make a project
+tryMakeProject :: Command ()
+tryMakeProject = do
+  makeProjDir
+  writeDefMain
+  writeLightyConf
+  writeProjConfig
+
+-- | Make the project directory structure
+makeProjDir :: Command ()
+makeProjDir = do
+  dir <- projectDir
+  dirs <- map snd `fmap` projectDirs
+  exists <- liftIO $ doesDirectoryExist dir
+  if exists
+     then do dir' <- liftIO $ makeRelativeToCurrentDirectory dir
+             cmdError $ "directory `" ++ dir' ++ "' already exists"
+     else liftIO $ do putStrLn "Creating directory structure ..."
+                      mapM_ createDir dirs
+                      putStrLn "Finished creating directory structure."
+  where createDir dir = do putStrLn $ "  " ++ dir
+                           createDirectoryIfMissing True dir
+
+-- | Set the current project in the state
+newProject :: String -> Command ()
+newProject name = do
+  pwd <- liftIO $ getCurrentDirectory
+  let project = KibroProject { projName     = name
+                             , projDirs     = defaultDirs 
+                             , projOutDir   = "public" 
+                             , projMainIs   = "src" </> "Main.hs"
+                             , projLighttpd = True }
+  modify $ \s -> s { kibProjDir = Just $ pwd </> name
+                   , kibProject = Just project }
+
+-- | Write default Main.hs file
+writeDefMain :: Command ()
+writeDefMain = do
+  dir <- projectDir
+  main <- projectMain
+  liftIO $ do
+    putStr $ "Writing Main.hs ... "
+    writeFile (dir </> main) mainSrc
+    putStrLn "done."
+
+-- | Write the lighttpd.conf file
+writeLightyConf :: Command ()
+writeLightyConf = onlyIfLighttpd $ do
+  dir <- projectDir
+  dirs <- projectDirs
+  conf <- lighttpdDotConf
+  case lookup "lighttpd" dirs of
+    Nothing   -> cmdError "lighttpd config path not found in project config"
+    Just path -> do liftIO $ do
+                      putStr $ "Writing lighttpd.conf ... "
+                      writeFile (path </> "lighttpd.conf") conf
+                      putStrLn "done."
+                    writeCustom path
+
+writeCustom :: FilePath -> Command ()
+writeCustom path = onlyIfLighttpd $ liftIO $ do
+  let custom = path </> "custom.conf"
+  exists <- doesFileExist custom
+  putStr "Writing custom.conf ... "
+  if exists
+     then putStrLn "already exists, skipping."
+     else do writeFile custom customDotConf
+             putStrLn "done."
+
+-- | Write the Kibro configuration to .kibro file
+writeProjConfig :: Command ()
+writeProjConfig = do
+  dir <- projectDir
+  proj <- fromJust `fmap` gets kibProject
+  let name = projName proj
+  liftIO $ do
+    putStr $ "Writing " ++ name ++ ".kibro ... "
+    writeFile (dir </> name ++ ".kibro") $ show proj
+    putStrLn "done."
+
+-- | Initialise the Kibro project by reading the configuration file
+initProject :: Command ()
+initProject = do
+  proj <- gets kibProject
+  when (not $ isJust proj) $ do
+    pwd <- liftIO $ getCurrentDirectory
+    configs <- liftIO $ getDirectoryContents pwd
+    let config = filter (isJust . match "^[a-z][a-z0-9_-]+\\.kibro$") configs
+    case config of
+      [config] -> do liftIO $ putStr $ "Reading config file " ++ config ++ " ... "
+                     config_ <- liftIO $ SIO.readFile config
+                     let config' = read config_ 
+                     modify $ \s -> s { kibProject = Just config' 
+                                      , kibProjDir = Just pwd }
+                     liftIO $ putStrLn "done."
+      -- TODO: --config option
+      []       -> cmdError "no kibro file found. try the `new' command"
+      _        -> cmdError "more than one kibro file found"
+
+----------------
+-- Command types
+
+-- Throw an error, prefixing the command that threw it to the message
+cmdError :: [Char] -> Command a
+cmdError err = do
+  name <- gets $ cmdName . kibCmd
+  throwError $ name ++ ": " ++ err
+
+data Cmd = Cmd 
+    { cmdName  :: String
+    , cmdDesc  :: String
+    , cmdFlags :: [(String,String)]
+    , cmdAct   :: [String] -> Command ()
+    }
+instance Show Cmd where 
+    show (Cmd name desc _ _) = "Cmd { cmdName = " ++ show name ++
+                               ", cmdDesc = " ++ show desc ++ " }"
+
+type Command = ErrorT String Kibro
+
+----------------
+-- Kibro types
+
+-- | Kibro monad
+type Kibro = StateT KibroSt IO
+
+-- | Kibro running state
+data KibroSt = KibroSt 
+    { kibProject :: Maybe KibroProject
+    , kibProjDir :: Maybe FilePath
+    , kibCmd     :: Cmd
+    , kibArgs    :: [String]
+    , kibAppName :: String
+    } deriving Show
+
+-- Helper functions
+projectMain = gets $ projMainIs . fromJust . kibProject
+projectName = gets $ projName . fromJust . kibProject
+projectDir  = gets $ fromJust . kibProjDir
+projectLighttpd = gets $ projLighttpd . fromJust . kibProject
+onlyIfLighttpd :: Command () -> Command ()
+onlyIfLighttpd m = do doIt <- projectLighttpd
+                      when doIt m
+projectDirs = do 
+  dir <- projectDir
+  gets (map (second (dir </>)) . projDirs . fromJust . kibProject)
+
+-- | Project type
+data KibroProject = KibroProject 
+    { projName     :: String 
+    , projDirs     :: [(String,FilePath)]
+    , projOutDir   :: FilePath
+    , projMainIs   :: FilePath
+    , projLighttpd :: Bool
+    } deriving (Eq,Show,Read)
+
+-----------------------------------------------------------------------------
+-- Default values
+
+mainSrc :: String
+mainSrc = "module Main where\n\
+          \\n\
+          \import Kibro\n\
+          \\n\
+          \main = startKibro pages\n\
+          \\n\
+          \pages = [(\".\", example)]\n\
+          \\n\
+          \example = output \"Change me! :-)\"\n"
+
+lighttpdDotConf :: Command String
+lighttpdDotConf = do
+  root <- projectDir
+  name <- projectName
+  dirs <- gets $ projDirs . fromJust . kibProject
+  let appDir = fromJust $ lookup "app" dirs
+      fastCGIDir = fromJust $ lookup "fastcgi" dirs
+      lightDir = fromJust $ lookup "lighttpd" dirs
+      pubDir = fromJust $ lookup "public" dirs
+  return $ showSettings
+    [("Do not modify this file. You should modify custom.conf" #)
+    ,"var.k_base_dir"      .=. dir root
+    ,"var.k_app_dir"       .=. var "k_base_dir" <+> dir appDir
+    ,"var.k_fastcgi_dir"   .=. var "k_base_dir" <+> dir fastCGIDir
+    ,"var.k_lighttpd_dir"  .=. var "k_base_dir" <+> dir lightDir
+    ,"var.k_public_dir"    .=. var "k_base_dir" <+> dir pubDir
+    ,"var.k_fcgi_filename" .=. name ++ ".fcgi"
+    ,"var.k_fcgi_path"     .=. var "k_public_dir" <+> var "k_fcgi_filename"
+    ,"var.k_socket_path"   .=. var "k_fastcgi_dir" <+> name ++ ".sock"
+    ,"var.k_error_log"     .=. var "k_lighttpd_dir" <+> "error.log"
+    ,"var.k_port"          .=. (3000 :: Int)
+    ,("This value must not be changed, Kibro depends on it for stopping" #)
+    ,"server.pid-file"     .=. var "k_lighttpd_dir" <+> "lighttpd.pid"
+    ,include "custom.conf"]
+                  where dir = init . (</> " ")
+
+customDotConf :: String
+customDotConf = showSettings
+  [("Only change these if you know what you are doing" #)
+  ,"fastcgi.server" .=. [var "k_fcgi_path" .=>. [["socket" .=>. var "k_socket_path"]]]
+  ,"server.error-handler-404" .=. var "k_fcgi_filename"
+  ,"index-file.names" .=. [var "k_fcgi_filename"]
+  ,("Shouldn't need to change these" #)
+  ,"server.document-root" .=. var "k_public_dir"
+  ,"server.errorlog" .=. var "k_error_log"
+  ,("Feel free" #)
+  ,"server.modules" .=. ["mod_rewrite","mod_redirect","mod_fastcgi"]
+  ,"server.port" .=. var "k_port"
+  ,"server.dir-listing" .=."enable"
+  ,"dir-listing.encoding" .=."utf-8"
+  ,"mimetype.assign" .=. ["" .=>. "text/plain"]]
+
+-- | Default directory structure
+defaultDirs :: [(String,FilePath)]
+defaultDirs =
+    [("app","app")
+    ,("lighttpd","app" </> "lighttpd")
+    ,("fastcgi","app" </> "fastcgi")
+    ,("public","public")
+    ,("src","src")]
+
+------------------------------------------------------------------------------
+-- Lighttpd config
+
+-- | Class for generalising the properties.
+class LightyProperty a where toProp :: a -> Prop
+
+-- | Necessary instances.
+instance LightyProperty [[Char]] where toProp = List
+instance LightyProperty [Char] where toProp = String
+instance LightyProperty Int where toProp = Number
+instance LightyProperty [Prop] where toProp = Props
+instance LightyProperty [[Prop]] where toProp = Props . map Props
+instance LightyProperty Prop where toProp = id
+
+-- | A property.
+data Prop = String String
+          | Number Int
+          | List [String]
+          | Assign Prop Prop
+          | Variable String
+          | Props [Prop]
+          | Concat Prop Prop
+-- | A property "setting".
+data LightyLine = Set String Prop | Comment String | Include String
+
+instance Show Prop where
+    show (String s) = show s
+    show (Number n) = show n
+    show (List xs)  = "(" ++ commasShow xs ++ ")" where
+    show (Assign p v) = show p ++ " => " ++ show v
+    show (Props ps) = "(" ++ commasShow ps ++ ")"
+    show (Variable v) = v
+    show (Concat p1 p2) = show p1 ++ " + " ++ show p2
+
+instance Show LightyLine where
+    show (Set s p) = s ++ " = " ++ show p
+    show (Comment s) = "# " ++ s
+    show (Include s) = "include " ++ show s
+
+-- | Print a list of settings in the lighttpd config format.
+showSettings :: [LightyLine] -> String
+showSettings = unlines . map show
+
+commasShow :: Show a => [a] -> String
+commasShow = commas . map show
+
+---------------------------------------
+-- Combinators
+
+-- | "Set" a property.
+(.=.) :: LightyProperty a => String -> a -> LightyLine
+p .=. v = Set p (toProp v)
+infixr 0 .=.
+
+-- | "Assign" a value to something.
+(.=>.) :: (LightyProperty a,LightyProperty b) => a -> b -> Prop
+(.=>.) a b = Assign (toProp a) (toProp b)
+infixr 0 .=>.
+
+var = Variable
+(<+>) :: (LightyProperty a,LightyProperty b) => a -> b -> Prop
+a <+> b = Concat (toProp a) (toProp b)
+infixr 1 <+>
+(#) = Comment
+include = Include
+
+------------------------------------------------------------------------------
+-- Generic utilities
+
+-- Perform some action if a given file doesn't exist, otherwise print message
+performIfNotExists :: FilePath -> Maybe String -> Command () -> Command ()
+performIfNotExists path msg m = do
+  exists <- liftIO $ doesFileExist path
+  if not exists then m else maybe (return ()) (liftIO . putStrLn) msg
+
+-- Run shell command
+runShellCmd :: String -> Command ()
+runShellCmd cmd = do
+  id <- liftIO $ runCommand cmd
+  status <- liftIO $ waitForProcess id
+  case status of
+    ExitSuccess   -> return ()
+    ExitFailure _ -> cmdError $ "the following command failed:\n  " ++ cmd
+
+-- Stricter command runner
+runShellCmd' :: String -> Command ()
+runShellCmd' cmd = do
+  out <- liftIO $ run cmd ""
+  case out of
+    Right (ExitSuccess,err,_) | null err  -> return ()
+                              | otherwise -> fail err
+    Right (_,err,_) -> fail err
+    Left err -> fail err
+  where fail err = cmdError $ "there were errors with the \
+                              \following command:\n  " ++ cmd ++ "\n\n" ++ 
+                              err
+
+-- Silent runner
+runShellCmdSilent :: String -> Command ()
+runShellCmdSilent cmd = do
+  liftIO $ run cmd ""
+  return ()
+
+-- Big-ass-but-stable process launcher
+run :: String -> String -> IO (Either String (ExitCode,String,String))
+run cmd input = do
+  pipe <- catch (Right `fmap` runInteractiveCommand cmd)
+                (const $ return $ Left "")
+  case pipe of
+    Right (inp,out,err,pid) -> do
+                  catch (do hSetBuffering inp NoBuffering
+                            hPutStr inp input 
+                            hClose inp
+                            errv <- newEmptyMVar
+                            outv <- newEmptyMVar
+                            output <- hGetContents out
+                            errput <- hGetContents err
+                            forkIO $ evaluate (length output) >> putMVar outv ()
+                            forkIO $ evaluate (length errput) >> putMVar errv ()
+                            takeMVar errv
+                            takeMVar outv
+                            e <- catch (waitForProcess pid)
+                                       (const $ return $ ExitFailure 1)
+                            return $ Right (e,errput,output))
+                        (const $ return $ Left "Broken pipe")
+    _ -> return $ Left "Unable to launch process"
+
+fill c len text = take len $ text ++ repeat c
+match = matchRegex . mkRegex
+commas = concat . intersperse ","
+
+endDaemon pid = do runShellCmdSilent $ "kill `cat \"" ++ pid ++ "\"`"
+                   runShellCmdSilent $ "rm \"" ++ pid ++ "\""
+                   return ()
diff --git a/kibro.cabal b/kibro.cabal
--- a/kibro.cabal
+++ b/kibro.cabal
@@ -1,5 +1,5 @@
 name:          kibro
-version:       0.1
+version:       0.3
 synopsis:      Web development framework.
 description:   Web development framework.
 category:      Web
@@ -12,12 +12,12 @@
 cabal-Version: >= 1.2
 
 library
-   build-depends: base,HDBC,mtl,regex-compat,random,safe,xhtml,containers,fastcgi,cgi,HDBC-sqlite3,data-default
-   exposed-modules: Kibro,Kibro.DB,Kibro.DB.Sqlite3
+   build-depends: base,mtl,regex-compat,regexpr,random,safe,xhtml,containers,fastcgi,cgi,data-default
+   exposed-modules: Kibro
    hs-source-dirs: library/
    GHC-Prof-options: -auto-all
 
 executable kibro
   main-is: Main.hs
-  build-depends: base,regex-compat,directory,filepath,haskell98,validate,process
+  build-depends: base,filepath,directory,haskell98,process,strict,unix
   hs-source-dirs: executable/
diff --git a/library/Kibro.hs b/library/Kibro.hs
--- a/library/Kibro.hs
+++ b/library/Kibro.hs
@@ -1,198 +1,297 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-}
-module Kibro 
-    (
-      module Network.CGI
-    , kibro
-    , Kibro, KibroT
-    , Page
-    , PageList
-    , gets
-    , con
-    , getParams
-    , getSess
-    , readSess
-    , putSess
-    , writeSess
-    , getSessDef
+
+module Kibro
+    ( -- * Start Kibro
+      startKibro
+    , startKibro'
+      -- * Value which the Kibro monad holds
+    , getValue
+      -- * Input utilities
+    , getURIMatch
     , getInputDef
-    , readSessDef
     , readInputDef
+      -- * Session utilities
+    , getSess
+    , putSess
     , deleteSess
-    , outputHtml
-    , (<<$)
-    , io
+    , modifySess
+    , getSessDef
+    , modifySessDef
+    , readSess
+    , writeSess
+    , modifyRSess
+    , modifyRSessDef
+      -- * HTML utilities
     , stylesheet
-    )
-    where
+    , (<<$)
+    , PageAssign
+      -- * Module re-exports
+    , module Network.CGI)
+ where
 
-import Network.CGI hiding (Html)
-import Network.FastCGI
-import Network.CGI.Monad
-import qualified Data.Map as M
+import Control.Exception
+import Control.Applicative
+import Control.Arrow
+import Control.Monad.Reader
 import Control.Monad.State
-import Database.HDBC
 import Control.Concurrent
-import Text.Regex
-import Data.Maybe
 import Data.List
-import System.Random
+import Data.Map (Map)
+import Data.Maybe
+import qualified Data.Map as M
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Network.FastCGI
+import Network.CGI
+import Network.CGI.Monad
 import Safe
+import System.IO
+import System.Random
+import Text.RegexPR
 import Text.XHtml.Strict
-import Control.Applicative
-import Control.Arrow
-import Data.Function
 
-------------------------------------------------------------------------------
--- Main Kibro entry point
---
+---------------------------------------------------------------------------
+-- Server start up
 
-kibro :: IConnection c => IO c -> PageList c -> IO ()
-kibro getDb ps = do
-  ss  <- newMVar M.empty
-  ids <- newMVar [0..]
-  runFastCGIConcurrent' forkOS 1000 (handleErrors (kibroMain getDb ss ids ps))
+-- | Same as startKibro', but with value as () and uses forkIO to fork
+startKibro :: [PageAssign ()] -> IO ()
+startKibro = startKibro' () forkOS
 
--- TODO: use applicative on mvar
-kibroMain :: IConnection c => (IO c) -> SessionsVar -> IdsVar -> PageList c -> CGI CGIResult
-kibroMain getDb ssvar ids ps = do
-  -- Connect to the database for this session
-  db <- io $ getDb
-  -- Get or create a new session
-  (id,session) <- getSession ids ssvar
-  -- Get the page to run
-  (params,page) <- pageMatch ps <$> fromMaybe "" <$> getVar "REQUEST_URI"
-  -- Run a page, returning a new session and result
-  (session',result) <- runKibro page (KibroSt db session params)
-  -- Update the session
-  io $ modifyMVar_ ssvar (return . M.insert id session')
-  --  ...
-  return result
+-- | Start Kibro FastCGI server
+startKibro' :: v                       -- ^ The value to be passed to pages
+            -> (IO () -> IO ThreadId)  -- ^ How to fork threads
+            -> [PageAssign v]          -- ^ Page list of (regex,page action)
+            -> IO ()
+startKibro' value fork pages = do
+  ids <- genIds
+  state <- newMVar (ids,M.empty)
+  let cgiMain = handleErrors $ runReaderT (kibroCGIMain value pages) state
+  runFastCGIConcurrent' fork 1000 cgiMain
 
-pageMatch :: IConnection c => PageList c -> String -> ([String],Page c)
-pageMatch ps path = extract $ look $ map (first match) ps where
-    match regex = matchRegex (mkRegex regex) path
-    look = find (isJust . fst)
-    extract = maybe ([],notFound) (first fromJust)
+----------------------------------------------------------------------------
+-- Page request handler
 
-runKibro :: IConnection c => Kibro c CGIResult -> KibroSt c -> CGI (Session,CGIResult)
+-- | Main CGI action for Kibro
+kibroCGIMain :: v -> [PageAssign v] -> Manager CGIResult
+kibroCGIMain value ps = do
+  var <- ask
+  (_,sessions) <- liftIO $ readMVar var
+  (params,page) <- lift $ pageMatch ps <$> fromMaybe "" <$> getVar "REQUEST_URI"
+  session <- getSession
+  (session',result) <- lift $ runKibro page (KibroSt session params value)
+  updateSession session'
+  return result
+
+-- | Run a Kibro action, returning the new session and result
+runKibro :: Kibro v CGIResult -> KibroSt v -> CGI (Session,CGIResult)
 runKibro p st = evalStateT (unKibro (getSess p)) st where
     getSess a = do r <- a
                    ss <- gets session
                    return (ss,r)
 
-notFound :: IConnection c => Page c
+-- | Match a uri against a regex, returning the parameters from the regex
+--   and the page action
+pageMatch :: [PageAssign v] -> String -> (MatchResult,Page v)
+pageMatch ps path = extract $ look $ map (first match) ps where
+    match regex = matchRegexPR regex path
+    look = find (isJust . fst)
+    extract = maybe (undefined,notFound) (first fromJust)
+
+-- | Simple 404 page
+notFound :: Kibro v CGIResult
 notFound = getVar "REQUEST_URI" >>= outputNotFound . fromMaybe ""
 
-type PageList c = [(String, Page c)]
-type Page c = Kibro c CGIResult
+---------------------------------------------------------------------------
+-- Session manager monad
 
-------------------------------------------------------------------------------
+-- | Manager monad
+type Manager = ReaderT SessionState (CGIT IO)
+-- | List of (regular expression,page action) pairs
+type PageAssign v = (String,Page v)
+-- | Page action
+type Page v = Kibro v CGIResult
+-- | Session state; session ids and associated data
+type SessionState = MVar ([Integer],Map Integer Session)
+-- | Browser instance session
+data Session = Session
+    { sessId     :: Integer
+    , sessValues :: Map String String
+    } deriving (Eq,Show)
+
+---------------------------------------------------------------------------
+-- Kibro monad
+
+type Kibro = KibroT IO
+
+-- | A state containing the current session and a database connection.
+data KibroSt v = KibroSt { session    :: Session
+                         , match      :: MatchResult 
+                         , kibroValue :: v }
+
+type MatchResult = ((String, (String, String)), [(Int, String)])
+
+newtype KibroT m v a = Kibro { unKibro :: (StateT (KibroSt v) (CGIT m) a) }
+    deriving (Monad, MonadIO, MonadState (KibroSt v), Functor)
+
+instance Monad m => Applicative (KibroT m v) where
+    pure = return
+    (<*>) = ap
+
+instance MonadCGI (KibroT IO v) where
+    cgiAddHeader n v = Kibro $ lift $ cgiAddHeader n v
+    cgiGet x = Kibro $ lift $ cgiGet x
+
+---------------------------------------------------------------------------
 -- Sessions
---
-getSession :: IdsVar -> SessionsVar -> CGI (SessID,Session)
-getSession ids ssvar = readCookie "sid" >>= maybe new fromId where
-    fromId id = do ss <- io $ readMVar ssvar
-                   maybe new (\s -> return (id,s)) (M.lookup id ss)
-    new = newSession ids ssvar
 
-newSession :: IdsVar -> SessionsVar -> CGI (SessID,Session)
-newSession ids ssvar = do
-  id <- newId ids
-  io $ modifyMVar ssvar $ \m ->
-      let e = M.insert "key" (show id) M.empty 
-      in return (M.insert id e m,(id,e))
+-- | Update a session in the MVar
+updateSession :: Session -> Manager ()
+updateSession session@(Session id _) = do
+  var <- ask
+  liftIO $ modifyMVar_ var $ \(ids,sessions) -> do
+    return (ids,M.insert id session sessions)
 
-newId :: IdsVar -> CGI SessID
-newId ids = do
-  id <- io $ modifyMVar ids $ \(x:xs) -> do
-              r <- getStdRandom random
-              return (xs,(x,r))
-  setCookie (newCookie "sid" $ show id) { cookiePath = Just "/" }
-  return id
+-- | Get the current session or make a new one and return it
+getSession :: Manager Session
+getSession = do
+  var <- ask
+  sId <- lift $ readCookie "sid"
+  sess <- liftIO $ modifyMVar var $ \state@(ids,sessions) -> do
+    case sId >>= flip M.lookup sessions of
+      Just session -> return (state,(False,session))
+      Nothing      -> let sId' = head ids
+                          session = Session sId' M.empty
+                          newState = (tail ids,M.insert sId' session sessions)
+                      in return (newState,(True,session))
+  when (fst sess) $ lift $ setCookie (newCookie "sid" $ show (sessId $ snd sess)) { cookiePath = Just "/" }
+  return $ snd sess
+                         
 
-getSess :: IConnection c => String -> Kibro c (Maybe String)
-getSess k = do s <- gets session
-               return $ M.lookup k s
+-- | Generate an infinite list of session ids
+genIds :: IO [SessionId]
+genIds = nub . randomRs (1,1000^(20::Int)) <$> betterStdGen
 
-readSess :: (IConnection c, Read a) => String -> Kibro c (Maybe a)
-readSess k = getSess k >>= return . (>>= readMay)
+-- | A better random number generator which uses /dev/random when entropy
+--   is available
+betterStdGen :: IO StdGen
+betterStdGen = alloca $ \p -> do
+    h <- openBinaryFile "/dev/urandom" ReadMode
+    hGetBuf h p $ sizeOf (undefined :: Int)
+    hClose h
+    mkStdGen <$> peek p
 
-putSess :: (IConnection c) => String -> String -> Kibro c ()
-putSess k v = do st <- get
-                 let news = M.insert k v (session st)
-                 put st { session = news }
+-- | Session identity per browser instance
+type SessionId = Integer
 
-deleteSess :: (IConnection c) => String -> Kibro c ()
-deleteSess k = do st <- get
-                  let news = M.delete k (session st)
-                  put st { session = news }
+---------------------------------------------------------------------------
+-- Kibro utilities
 
-writeSess :: (IConnection c, Show a) => String -> a -> Kibro c ()
-writeSess k v = putSess k (show v)
-  
-type SessionsVar = MVar Sessions
-type IdsVar = MVar [Integer]
+----------------------------------------
+-- Value utilities
 
-------------------------------------------------------------------------------
--- The Kibro monad
---
+getValue :: Kibro v v
+getValue = gets kibroValue
 
--- | A state containing the current session and a database connection.
-data KibroSt c = KibroSt
-    { con     :: c
-    , session :: Session
-    , params  :: [String] }
+----------------------------------------
+-- URL utilities
 
-type Session = M.Map String String
-type Sessions = M.Map SessID Session
-type SessID = (Integer,Int)
+getURIMatch :: Kibro v MatchResult
+getURIMatch = gets match
 
-newtype KibroT m c a = Kibro { unKibro :: (StateT (KibroSt c) (CGIT m) a) }
-    deriving (Monad, MonadIO, MonadState (KibroSt c), Functor)
+----------------------------------------
+-- Input utilities
 
-instance (Monad m, IConnection c) => Applicative (KibroT m c) where
-    pure = return
-    (<*>) = ap
+getInputDef :: String -> String -> Kibro v String
+getInputDef k v = fromMaybe v <$> getInput k
 
-instance IConnection c => MonadCGI (KibroT IO c) where
-    cgiAddHeader n v = Kibro $ lift $ cgiAddHeader n v
-    cgiGet x = Kibro $ lift $ cgiGet x
+readInputDef :: String -> String -> Kibro v String
+readInputDef k v = fromMaybe v <$> readInput k
 
-type Kibro c a = KibroT IO c a
+----------------------------------------
+-- Session utilities
 
-------------------------------------------------------------------------------
--- Kibro utilities
---
+-- | Get session value or return default value
+getSessDef :: String -> String -> Kibro v String
+getSessDef k v = fromMaybe v <$> getSess k
 
-getParams :: IConnection c => Kibro c [String] 
-getParams = gets params
+-- | Read session value or return default value
+readSessDef :: (Read a) => String -> a -> Kibro v a
+readSessDef k v = fromMaybe v <$> readSess k
 
-outputHtml :: (HTML a, IConnection c) => a -> Kibro c CGIResult
-outputHtml = output . html . showHtmlFragment where
-    html c = "<html>" ++ c ++ "</html>"
+-- | Same as modifySessDef, but with Read/Show instance values
+modifyRSessDef :: (Read a,Show a) => String -> (a -> a) -> a -> Kibro v a
+modifyRSessDef k f v = do 
+  v <- readSessDef k v
+  let v' = f v
+  writeSess k v'
+  return v'
 
-defGet n = liftM (fromMaybe n)
+-- | Same as modifySess, but with Read/Show instance values
+modifyRSess :: (Read a,Show a) => String -> (a -> a) -> Kibro v (Maybe a)
+modifyRSess k f = do
+  v <- readSess k
+  case v of
+    Just v  -> do writeSess k $ f v
+                  return $ Just v
+    Nothing -> return Nothing
 
--- Simply utilities
+-- | Read a session value
+readSess :: (Read a) => String -> Kibro v (Maybe a)
+readSess k = getSess k >>= return . (>>= readMay)
 
-readSessDef  s v = defGet v $ readSess s
-readInputDef s v = defGet v $ readInput s
-getSessDef   s v = defGet v $ getSess s
-getInputDef  s v = defGet v $ getInput s
+-- | Show a session value and put it
+writeSess :: (Show a) => String -> a -> Kibro v ()
+writeSess k v = putSess k (show v)
 
--- HTML utilities
+-- | Modify a session value, if the value does not exist, no change occurs
+modifySess :: String -> (String -> String) -> Kibro v (Maybe String)
+modifySess k f = do 
+  v <- getSess k
+  case v of
+    Nothing -> return Nothing
+    Just v  -> do let v' = f v
+                  putSess k v'
+                  return $ Just v'
+
+-- | Modify a session value, if the value does not exist, the default value
+--   is modified and inserted
+modifySessDef :: String -> (String -> String) -> String -> Kibro v String
+modifySessDef k f v = do
+  v <- getSessDef k v
+  let v' = f v
+  putSess k v'
+  return $ v'
+
+-- | Get a session value
+getSess :: String -> Kibro v (Maybe String)
+getSess k = do (Session _ s) <- gets session
+               return $ M.lookup k s
+
+-- | Put a session value
+putSess :: String -> String -> Kibro v ()
+putSess k v = sessMod (M.insert k v)
+
+-- | Delete a session value
+deleteSess :: String -> Kibro v ()
+deleteSess = sessMod . M.delete
+
+-- | Modify a session value
+sessMod :: (Map String String -> Map String String) -> Kibro v ()
+sessMod mod = do (Session id s) <- gets session
+                 modify $ \state -> state { session = Session id (mod s) }
+
+----------------------------------------
+-- Some HTML utilities
+
+-- | Simple stylesheet element
+stylesheet :: String -> Html
+stylesheet url = thelink ! [rel "stylesheet",thetype "text/css",href url] << ""
+
+-- | <a href='x'>y</a>
+ahref :: HTML a => String -> a -> HotLink
 ahref url = hotlink url . toHtml
 
 -- | Nice operator for removing parentheses.
 (<<$) :: (HTML a) => (Html -> b) -> a -> b
 a <<$ b = a << b
 infixr 0 <<$
-
-stylesheet url = thelink ! [rel "stylesheet",thetype "text/css",href url] << ""
-
-------------------------------------------------------------------------------
--- Utilities for this file
---
-
-io :: MonadIO m => IO a -> m a
-io = liftIO
diff --git a/library/Kibro/DB.hs b/library/Kibro/DB.hs
deleted file mode 100644
--- a/library/Kibro/DB.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Kibro.DB
-    (query,exec,Kibro.DB.commit
-    ,module Database.HDBC)
-    where
-
-import Kibro hiding (handleErrors)
-import Database.HDBC hiding (commit)
-import qualified Database.HDBC as HDBC
-import Control.Exception
-
-runSql :: IConnection c 
-       => (c -> String -> [SqlValue] -> IO a) -- ^ SQL function.
-       -> c                                   -- ^ SQL connection.
-       -> String                              -- ^ Query.
-       -> [SqlValue]                          -- ^ Parameters.
-       -> Kibro c a                           -- ^ Result.
-runSql f dbh s vs = io $ handleSql throwSqlError $ f dbh s vs where
-    throwSqlError (SqlError _ _ e) =
-        throwIO $ AssertionFailed $
-                    "SQL error: " ++ show s ++ " " ++ show vs ++ e
-
-query :: IConnection c => String -> [SqlValue] -> Kibro c [[SqlValue]]
-query sql values = do
-  dbh <- gets con
-  runSql quickQuery' dbh sql values
-
-exec :: IConnection c => String -> [SqlValue] -> Kibro c Integer
-exec sql values = do
-  dbh <- gets con
-  runSql run dbh sql values
-
-commit :: IConnection c => Kibro c ()
-commit = do
-  dbh <- gets con
-  io $ HDBC.commit dbh
diff --git a/library/Kibro/DB/Sqlite3.hs b/library/Kibro/DB/Sqlite3.hs
deleted file mode 100644
--- a/library/Kibro/DB/Sqlite3.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module Kibro.DB.Sqlite3 
-    (db,Connection)
-    where
-
-import Database.HDBC.Sqlite3
-
-db :: String -> IO Connection
-db = connectSqlite3