@@ -8,10 +8,10 @@ module Main
88import Control.Arrow (first)
99import Control.Monad (forM_)
1010import Data.Char (isAlphaNum, isNumber)
11−import Data.List (foldl')
12−import Data.List (intercalate, isPrefixOf)
11+import Data.List (foldl', intercalate, isPrefixOf)
1312import Data.Version (Version (..))
14−import System.Directory (canonicalizePath, copyFile)
13+import System.Directory (canonicalizePath, copyFile,
14+ doesFileExist)
1515import System.Environment (getArgs, getProgName)
1616import System.Exit (exitFailure)
1717import System.FilePath (splitDirectories, (</>))
@@ -37,21 +37,45 @@ main = do
3737 -- If dstDir begins with hyphens, the guard will prevent it from creating
3838 -- directory with that name so we can fall to the second alternative
3939 -- which prints a usage info for user.
40− [dstDir] | not ("-" `isPrefixOf` dstDir) -> do
41− forM_ files $ \file -> do
42− let dst = dstDir </> file
43− src = srcDir </> file
44− putStrLn $ "Creating " ++ dst
45− makeDirectories dst
46− copyFile src dst
40+ [dstDir] | not ("-" `isPrefixOf` dstDir) ->
41+ createFiles False srcDir files dstDir
42+ ["-f", dstDir] ->
43+ createFiles True srcDir files dstDir
44+ _ -> do
45+ putStrLn $ "Usage: " ++ progName ++ "[-f] <directory>"
46+ exitFailure
4747
48+ where
49+ createFiles force srcDir files dstDir = do
4850 name <- makeName dstDir
4951 let cabalPath = dstDir </> name ++ ".cabal"
50− putStrLn $ "Creating " ++ cabalPath
51− createCabal cabalPath name
52− _ -> do
53− putStrLn $ "Usage: " ++ progName ++ " <directory>"
54− exitFailure
52+
53+ diff <- if force then return []
54+ else existingFiles dstDir (cabalPath : files)
55+
56+ case diff of
57+ [] -> do
58+ forM_ files $ \file -> do
59+ let dst = dstDir </> file
60+ src = srcDir </> file
61+ putStrLn $ "Creating " ++ dst
62+ makeDirectories dst
63+ copyFile src dst
64+
65+ putStrLn $ "Creating " ++ cabalPath
66+ createCabal cabalPath name
67+ fs -> do
68+ putStrLn $ "The following files will be overwritten:"
69+ foldMap putStrLn fs
70+ putStrLn $ "Use -f to overwrite them"
71+ exitFailure
72+
73+existingFiles :: FilePath -> [FilePath] -> IO [FilePath]
74+existingFiles dstDir = foldMap $ \file -> do
75+ let dst = dstDir </> file
76+ exists <- doesFileExist dst
77+ return $ if exists then [dst] else []
78+
5579
5680-- | Figure out a good cabal package name from the given (existing) directory
5781-- name
@@ -77,7 +101,7 @@ makeName dstDir = do
77101 safeLast = foldl' (\_ x -> Just x) Nothing
78102
79103createCabal :: FilePath -> String -> IO ()
80−createCabal path name = do
104+createCabal path name =
81105 writeFile path $ unlines [
82106 "name: " ++ name
83107 , "version: 0.1.0.0"