From 067a21c60f498cd2c870399ae8bcca3f9fc831ac Mon Sep 17 00:00:00 2001
From: Ilya Smelkov <triplepointfive@gmail.com>
Date: Sat, 9 May 2015 00:04:04 +0300
Subject: [PATCH] yesod init accepts app name

---
 yesod-bin/Scaffolding/Scaffolder.hs | 26 ++++++++++++++++++++------
 yesod-bin/input/project_name.cg     |  4 ++++
 yesod-bin/input/welcome.cg          |  3 ---
 yesod-bin/main.hs                   | 13 +++++++++----
 4 files changed, 33 insertions(+), 13 deletions(-)
 create mode 100644 yesod-bin/input/project_name.cg

diff --git a/yesod-bin/Scaffolding/Scaffolder.hs b/yesod-bin/Scaffolding/Scaffolder.hs
index ec2d1da2..c46e8c38 100644
--- a/yesod-bin/Scaffolding/Scaffolder.hs
+++ b/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
diff --git a/yesod-bin/input/project_name.cg b/yesod-bin/input/project_name.cg
new file mode 100644
index 00000000..f5f25e85
--- /dev/null
+++ b/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: 
diff --git a/yesod-bin/input/welcome.cg b/yesod-bin/input/welcome.cg
index efff79c0..ab9e1d8e 100644
--- a/yesod-bin/input/welcome.cg
+++ b/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: 
diff --git a/yesod-bin/main.hs b/yesod-bin/main.hs
index a241c262..b48c5ec6 100755
--- a/yesod-bin/main.hs
+++ b/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" )