kibro-0.0: executable/New.hs

------------------------------------------------------------------------------
-- New project command

module New where

import System
import System.IO
import System.Directory
import Text.Printf
import Data.Maybe
import Data.List
import System.FilePath
import Data.Validate
import Control.Applicative

import Utils
import Help
import Data.Lighttpd

new :: [String] -> IO ()
new []     = do todo "interactive mode"; showHelp
new [name] = name .->. validName $ do
               doing $ "Creating project " ++ name
               dir <- getCurrentDirectory
               exists <- any (==name) <$> getDirectoryContents dir
               exists .->. (test "project must not exist" (==False)) $ do
                 makeDirStructure dir name

-- | Valid project name.
validName = pattern "project name" "[a-z][a-z0-9]+"

-----------------------
-- Directory structure

makeDirStructure :: String -> String -> IO ()
makeDirStructure dir name = do
  doing $ "Creating directory structure"
  mapM_ create (dirs name)
  mapM_ ($ name) [writeLighttpd,writeMain]
  doing $ "Writing " ++ conf; touch $ conf
      where conf = name ./. (name ++ ".kibro")

touch p = openFile p WriteMode >>= hClose

create f = do doing $ "Creating " ++ f
              createDirectoryIfMissing True f

dirs = (.//. ("app" .//. ["lighttpd","fastcgi","memcached"]
              ++
              ["db","public","src"]))
    where sup .//. sub = map (sup ./.) sub

-----------------------
-- Lighttpd config

writeLighttpd :: String -> IO ()
writeLighttpd name = do
  doing $ "Writing " ++ path
  root <- (./. name) <$> getCurrentDirectory
  h <- openFile path WriteMode
  hPutStrLn h (lighttpdconf root name)
  hClose h
  where path = name ./. "app" ./. "lighttpd" ./. "lighttpd.conf"

-----------------------
-- Default Main.hs

writeMain :: String -> IO ()
writeMain name = do
  doing $ "Writing " ++ path
  h <- openFile path WriteMode
  hPutStrLn h mainSrc
  hClose h
  where path = name ./. "src" ./. "Main.hs"

------------------------------------------------------------------------------
-- Lighttpd template

lighttpdconf :: String -> String -> String
lighttpdconf root name = showSettings
    ["server.modules"           .=. ["mod_rewrite","mod_redirect","mod_fastcgi"]
    ,"server.document-root"     .=. root ./. "public"
    ,"server.port"              .=. (3000 :: Int)
    ,"server.pid-file"          .=. root ./. "app" ./. "lighttpd" ./. "lighttpd.pid"
    ,"server.errorlog"          .=. root ./. "app" ./. "lighttpd" ./. "error.log"
    ,"server.dir-listing"       .=. "enable"
    ,"dir-listing.encoding"     .=. "utf-8"
    ,"mimetype.assign"          .=. ["" .=>. "text/plain"]
    ,"server.error-handler-404" .=. name ++ ".fcgi"
    ,"index-file.names"         .=. [name ++ ".fcgi"]
    ,"fastcgi.server"           .=.
     [(root ./. "public" ./. (name ++ ".fcgi")) .=>.
      [["socket" .=>. root ./. "app" ./. "fastcgi" ./. (name ++ ".sock")]]]
    ]

------------------------------------------------------------------------------
-- Main.hs template

mainSrc = "module Main where\n\
          \import Kibro\n\
          \import Kibro.DB.Sqlite3\n\
          \\n\
          \main = kibro (db \"\") pages\n\
          \\n\
          \pages = [(\".\", example)]\n\
          \\n\
          \example = output \"Change me! :-)\""