kibro 0.3 → 0.4
raw patch · 2 files changed
+88/−17 lines, 2 filesdep +ConfigFilePVP ok
version bump matches the API change (PVP)
Dependencies added: ConfigFile
API changes (from Hackage documentation)
Files
- executable/Main.hs +86/−15
- kibro.cabal +2/−2
executable/Main.hs view
@@ -6,14 +6,17 @@ module Main where import System.Posix.Signals (installHandler, sigPIPE, Handler(Ignore))- import Prelude hiding (catch)+import Control.Applicative import Control.Arrow hiding ((<+>)) import Control.Concurrent import Control.Exception import Control.Monad.Error import Control.Monad.State import Control.Monad.Reader+import Data.Char+import Data.ConfigFile (CPError,ConfigParser)+import qualified Data.ConfigFile as C import Data.List import Data.Maybe import System@@ -21,6 +24,7 @@ import qualified System.IO.Strict as SIO import System.FilePath import System.Directory+import System.Posix.Files import System.Process import Text.Printf import Text.Regex@@ -189,11 +193,18 @@ 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."+ main <- gets $ projMainIs . fromJust . kibProject+ let main = dir </> main+ fcgi = out </> name ++ ".fcgi"+ fcgiExists <- liftIO $ doesFileExist fcgi+ if fcgiExists+ then do [mainTime,fcgiTime] <- mapM modTime [main,fcgi]+ if mainTime > fcgiTime+ then build+ else return ()+ else build+ where modTime p = liftIO $ modificationTime <$> getFileStatus p+ build = cmdAct buildCmd [] ---------------------------------------- -- `help' command@@ -253,12 +264,19 @@ buildProject :: Command () buildProject = do+ dirs <- projectDirs+ let src = fromJust . lookup "src" $ dirs+ public = fromJust . lookup "public" $ dirs dir <- projectDir main <- projectMain name <- projectName- let cmd = "ghc --make " ++ dir </> main ++ " -o public" </> fcgi ++ " -threaded"- fcgi = name ++ ".fcgi"+ opts <- gets $ projGHCOpts . fromJust . kibProject+ let cmd = "ghc --make " ++ dir </> main ++ " -o " ++ fcgi ++ " -threaded " ++ opts+ fcgi = dir </> public </> name ++ ".fcgi"+ curDir <- liftIO $ getCurrentDirectory+ liftIO $ setCurrentDirectory $ dir </> src runShellCmd cmd+ liftIO $ setCurrentDirectory curDir ---------------------------------------- -- `new' command@@ -309,7 +327,8 @@ , projDirs = defaultDirs , projOutDir = "public" , projMainIs = "src" </> "Main.hs"- , projLighttpd = True }+ , projLighttpd = True+ , projGHCOpts = "" } modify $ \s -> s { kibProjDir = Just $ pwd </> name , kibProject = Just project } @@ -351,11 +370,10 @@ writeProjConfig :: Command () writeProjConfig = do dir <- projectDir- proj <- fromJust `fmap` gets kibProject- let name = projName proj+ name <- projectName liftIO $ do putStr $ "Writing " ++ name ++ ".kibro ... "- writeFile (dir </> name ++ ".kibro") $ show proj+ writeFile (dir </> name ++ ".kibro") $ C.to_string $ buildConfig name putStrLn "done." -- | Initialise the Kibro project by reading the configuration file@@ -368,9 +386,8 @@ 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' + config' <- readConfig config+ modify $ \s -> s { kibProject = Just config' , kibProjDir = Just pwd } liftIO $ putStrLn "done." -- TODO: --config option@@ -432,7 +449,61 @@ , projOutDir :: FilePath , projMainIs :: FilePath , projLighttpd :: Bool+ , projGHCOpts :: String } deriving (Eq,Show,Read)++----------------+-- Configuration parser and shower++buildConfig :: String -> ConfigParser+buildConfig name = fromEither $ foldM setOpt C.emptyCP (addName $ opts) where+ setOpt cp (name,opt) = C.set cp "DEFAULT" name opt+ fromEither (Right x) = x+ addName = (("name",name) :) . filter ((/="name") . fst)++readConfig :: String -> Command KibroProject+readConfig config = do + rv <- runErrorT $+ do cp <- join $ liftIO $ C.readfile C.emptyCP config+ let x = cp+ options <- mapM (\e -> (,) e <$> C.get x "DEFAULT" e) optNames+ return (options :: [(String,String)])+ case rv of+ Left (C.NoOption entry, _) -> configError $ "`" ++ entry ++ "' was not provided in the config"+ Left (e,_) -> configError $ show e+ Right vs -> return $ optsToProject vs+ where configError e = cmdError $ config ++ ": " ++ e++optsToProject :: [(String,String)] -> KibroProject+optsToProject ls = KibroProject + { projName = get "name"+ , projDirs = [("fastcgi",get "fastcgi-dir")+ ,("app", get "app-dir")+ ,("lighttpd",get "lighttpd-dir")+ ,("public", get "public-dir")+ ,("src", get "src-dir")]+ , projOutDir = get "fcgi-out-dir" + , projMainIs = get "main-is"+ , projLighttpd = readBool $ get "manage-lighttpd" + , projGHCOpts = get "ghc-options" }+ where get = fromJust . flip lookup ls+ readBool = readBool' . map toLower+ readBool' "yes" = True+ readBool' "no" = False+ readBool' "true" = True+ readBool' "false" = False++optNames = map fst opts+opts = [("name","jboborei")+ ,("app-dir","app")+ ,("lighttpd-dir", "app/lighttpd")+ ,("fastcgi-dir", "app/fastcgi")+ ,("public-dir", "public")+ ,("src-dir", "src")+ ,("fcgi-out-dir", "public")+ ,("main-is", "src/Main.hs")+ ,("ghc-options", "")+ ,("manage-lighttpd", "yes")] ----------------------------------------------------------------------------- -- Default values
kibro.cabal view
@@ -1,5 +1,5 @@ name: kibro-version: 0.3+version: 0.4 synopsis: Web development framework. description: Web development framework. category: Web@@ -19,5 +19,5 @@ executable kibro main-is: Main.hs- build-depends: base,filepath,directory,haskell98,process,strict,unix+ build-depends: base,filepath,directory,haskell98,process,strict,unix,ConfigFile hs-source-dirs: executable/