bamboo-launcher-2009.5.22: src/Launcher.hs

module Main where

import Bamboo
import Hack
import Hack.Handler.Happstack hiding (port)

import Hack.Contrib.Utils
import Hack.Contrib.Middleware.ContentType
import Hack.Contrib.Middleware.ContentLength
import Hack.Contrib.Middleware.ShowExceptions
import Hack.Contrib.Middleware.Static

import Hack.Contrib.Middleware.BounceFavicon
import qualified Hack.Contrib.Middleware.Head as H


import Prelude hiding ((.))
import MPSUTF8
import System
import System.Cmd
import System.IO

middleware_stack :: [Middleware]
middleware_stack = 
  [  dummy_middleware
  
  -- filter
  ,  bounce_favicon

  -- completeness
  ,  content_length
  ,  content_type default_content_type

  -- debuging
  ,  show_exceptions Nothing
  
  -- optimization
  ,  H.head
  
  -- static serve
  ,  static (Just "db/public") ["/theme", "/images", "/plugin", "/favicon.ico"]
  
  -- real app
  ,  bamboo
  ]
  
  where
    default_content_type = "text/plain; charset=UTF-8"
  
-- test_app = \env -> return $ def .set_body (env.inputs.show)

app :: Application
app = use middleware_stack dummy_app

main :: IO ()
main = do
  args <- getArgs
  let port = if args.length == 1 then args.first.read else 3456
  paths <- ls "."
  if paths.has "db"
    then start port
    else do
      sep
      putStrLn $
        "I'm about to download a template from " ++ repo ++ " into ./db"
      putStrLn "Do you want to continue?   y or n"
      putStr $ u2b "❂ "
      hFlush stdout
      r <- getLine
      if r.is "y"
        then do
          system $ "git clone " ++ repo ++ " db"
          sep
          putStrLn "Template download complete!"
          putStrLn "You might want to remove db/.git manually."
          sep
          start port
        else
          putStrLn "Cya!"
  where
    start port = do 
      putStrLn $ "server started on port " ++ port.show ++ "..."
      runWithConfig (ServerConf port "localhost") app
    sep = putStrLn $ 70.times '-'
    repo = "git://github.com/nfjinjing/bamboo-template.git"