From ad95fb24184717c6c43acd1818ce22eccf5ea4e2 Mon Sep 17 00:00:00 2001
From: "(cdep)illabout" <cdep.illabout@gmail.com>
Date: Thu, 19 Mar 2015 00:35:47 +0900
Subject: [PATCH] Make `cabal init` create Main.hs if it doesn't exist.

`cabal init` will create Main.hs if the following conditions hold:
	- creating an executable (not a library)
	- the mainIs flag has been specified
	- the file the mainIs flag is pointing to doesn't exist
---
 cabal-install/Distribution/Client/Init.hs | 35 ++++++++++++++++++++++-
 1 file changed, 34 insertions(+), 1 deletion(-)

diff --git a/cabal-install/Distribution/Client/Init.hs b/cabal-install/Distribution/Client/Init.hs
index 39b07071c22..8d9f6dc320a 100644
--- a/cabal-install/Distribution/Client/Init.hs
+++ b/cabal-install/Distribution/Client/Init.hs
@@ -111,6 +111,7 @@ initCabal verbosity packageDBs comp conf initFlags = do
   writeSetupFile initFlags'
   writeChangeLog initFlags'
   createSourceDirectories initFlags'
+  createMainHs initFlags'
   success <- writeCabalFile initFlags'
 
   when success $ generateWarnings initFlags'
@@ -293,7 +294,7 @@ getMainFile flags =
   return (flagToMaybe $ mainIs flags)
   ?>> do
     candidates <- guessMainFileCandidates flags
-    let showCandidate = either (++" (does not yet exist)") id
+    let showCandidate = either (++" (does not yet exist, but will be created)") id
         defaultFile = listToMaybe candidates
     maybePrompt flags (either id (either id id) `fmap`
                        promptList "What is the main module of the executable"
@@ -677,6 +678,38 @@ createSourceDirectories flags = case sourceDirs flags of
                                   Just dirs -> forM_ dirs (createDirectoryIfMissing True)
                                   Nothing   -> return ()
 
+-- | Create Main.hs, but only if we are init'ing an executable and
+--   the mainIs flag has been provided.
+createMainHs :: InitFlags -> IO ()
+createMainHs flags@InitFlags{ sourceDirs = Just (srcPath:_)
+                            , packageType = Flag Executable
+                            , mainIs = Flag mainFile } =
+  writeMainHs flags (srcPath </> mainFile)
+createMainHs flags@InitFlags{ sourceDirs = _
+                            , packageType = Flag Executable
+                            , mainIs = Flag mainFile } =
+  writeMainHs flags mainFile
+createMainHs _ = return ()
+
+-- | Write a main file if it doesn't already exist.
+writeMainHs :: InitFlags -> FilePath -> IO ()
+writeMainHs flags mainPath = do
+  dir <- maybe getCurrentDirectory return (flagToMaybe $ packageDir flags)
+  let mainFullPath = dir </> mainPath
+  exists <- doesFileExist mainFullPath
+  unless exists $ do
+      message flags $ "Generating " ++ mainPath ++ "..."
+      writeFileSafe flags mainFullPath mainHs
+
+-- | Default Main.hs file.  Used when no Main.hs exists.
+mainHs :: String
+mainHs = unlines
+  [ "module Main where"
+  , ""
+  , "main :: IO ()"
+  , "main = putStrLn \"Hello, World!\""
+  ]
+
 -- | Move an existing file, if there is one, and the overwrite flag is
 --   not set.
 moveExistingFile :: InitFlags -> FilePath -> IO ()