yesod init accepts app name

yesod-bin/Scaffolding/Scaffolder.hs

@@ -66,16 +66,14 @@ backendBS Simple = $(embedFile "hsfiles/simple.hsfiles")
 backendBS Minimal = $(embedFile "hsfiles/minimal.hsfiles")
 
 validPackageName :: String -> Bool
-validPackageName s = isJust (simpleParse s :: Maybe PackageName)
+validPackageName s = isJust (simpleParse s :: Maybe PackageName) && s /= "test"
 
 scaffold :: Bool -- ^ bare directory instead of a new subdirectory?
+         -> Maybe String -- ^ application name
          -> IO ()
-scaffold isBare = do
+scaffold isBare appName = do
     puts $ renderTextUrl undefined $(textFile "input/welcome.cg")
-    project <- prompt $ \s ->
-        if validPackageName s && s /= "test"
-            then Just s
-            else Nothing
+    project <- projectName appName
 
     puts $ renderTextUrl undefined $(textFile "input/database.cg")
 
@@ -106,3 +104,19 @@ scaffold isBare = do
                                 else LT.replace "PROJECTNAME" (LT.pack project)
 
     TLIO.putStr $ projectnameReplacer $ renderTextUrl undefined $(textFile "input/done.cg")
+
+projectName :: Maybe String -- ^ application name
+            -> IO String
+projectName appName = case appName of
+    Nothing   -> askForProjectName
+    Just name ->
+        if validPackageName name
+            then return name
+            else do
+                 putStr "Given application name is not valid, please choose another one"
+                 hFlush stdout
+                 askForProjectName
+  where
+    askForProjectName = do
+        puts $ renderTextUrl undefined $(textFile "input/project_name.cg")
+        prompt $ \s -> if validPackageName s then Just s else Nothing

yesod-bin/input/project_name.cg

@@ -0,0 +1,4 @@
+
+What do you want to call your project? We'll use this for the cabal name.
+
+Project name: 

yesod-bin/input/welcome.cg

@@ -1,6 +1,3 @@
 Welcome to the Yesod scaffolder.
 I'm going to be creating a skeleton Yesod project for you.
 
-What do you want to call your project? We'll use this for the cabal name.
-
-Project name: 

yesod-bin/main.hs

@@ -41,7 +41,7 @@ data Options = Options
                }
   deriving (Show, Eq)
 
-data Command = Init { _initBare :: Bool }
+data Command = Init { _initBare :: Bool, _initName :: Maybe String }
              | HsFiles
              | Configure
              | Build { buildExtraArgs   :: [String] }
@@ -99,7 +99,7 @@ main = do
          ] optParser'
   let cabal = rawSystem' (cabalCommand o)
   case optCommand o of
-    Init bare       -> scaffold bare
+    Init bare name  -> scaffold bare name
     HsFiles         -> mkHsFile
     Configure       -> cabal ["configure"]
     Build es        -> touch' >> cabal ("build":es)
@@ -136,8 +136,7 @@ optParser :: Parser Options
 optParser = Options
         <$> flag Cabal CabalDev ( long "dev"     <> short 'd' <> help "use cabal-dev" )
         <*> switch              ( long "verbose" <> short 'v' <> help "More verbose output" )
-        <*> subparser ( command "init"
-                            (info (Init <$> (switch (long "bare" <> help "Create files in current folder")))
+        <*> subparser ( command "init"         (info initOptions
                             (progDesc "Scaffold a new site"))
                       <> command "hsfiles" (info (pure HsFiles)
                             (progDesc "Create a hsfiles file for the current folder"))
@@ -160,6 +159,12 @@ optParser = Options
                             (progDesc "Print the version of Yesod"))
                       )
 
+initOptions :: Parser Command
+initOptions = Init
+    <$> switch (long "bare" <> help "Create files in current folder")
+    <*> optStr (long "name" <> short 'n' <> metavar "APP_NAME"
+            <> help "Set the application name")
+
 keterOptions :: Parser Command
 keterOptions = Keter
     <$> switch ( long "nobuild" <> short 'n' <> help "Skip rebuilding" )