on master help sign in
Added overwritten files check
c41caa6Ilya Murzinov
src/Init.hs+40−16
@@ -8,10 +8,10 @@ module Main
8import Control.Arrow (first)
8import Control.Arrow (first)
9import Control.Monad (forM_)
9import Control.Monad (forM_)
10import Data.Char (isAlphaNum, isNumber)
10import Data.Char (isAlphaNum, isNumber)
11−import Data.List (foldl')
11+import Data.List (foldl', intercalate, isPrefixOf)
12−import Data.List (intercalate, isPrefixOf)
13import Data.Version (Version (..))
12import Data.Version (Version (..))
14−import System.Directory (canonicalizePath, copyFile)
13+import System.Directory (canonicalizePath, copyFile,
14+ doesFileExist)
15import System.Environment (getArgs, getProgName)
15import System.Environment (getArgs, getProgName)
16import System.Exit (exitFailure)
16import System.Exit (exitFailure)
17import System.FilePath (splitDirectories, (</>))
17import System.FilePath (splitDirectories, (</>))
@@ -37,21 +37,45 @@ main = do
37 -- If dstDir begins with hyphens, the guard will prevent it from creating
37 -- If dstDir begins with hyphens, the guard will prevent it from creating
38 -- directory with that name so we can fall to the second alternative
38 -- directory with that name so we can fall to the second alternative
39 -- which prints a usage info for user.
39 -- which prints a usage info for user.
40− [dstDir] | not ("-" `isPrefixOf` dstDir) -> do
40+ [dstDir] | not ("-" `isPrefixOf` dstDir) ->
41− forM_ files $ \file -> do
41+ createFiles False srcDir files dstDir
42− let dst = dstDir </> file
42+ ["-f", dstDir] ->
43− src = srcDir </> file
43+ createFiles True srcDir files dstDir
44− putStrLn $ "Creating " ++ dst
44+ _ -> do
45− makeDirectories dst
45+ putStrLn $ "Usage: " ++ progName ++ "[-f] <directory>"
46− copyFile src dst
46+ exitFailure
47
47
48+ where
49+ createFiles force srcDir files dstDir = do
48 name <- makeName dstDir
50 name <- makeName dstDir
49 let cabalPath = dstDir </> name ++ ".cabal"
51 let cabalPath = dstDir </> name ++ ".cabal"
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
50− putStrLn $ "Creating " ++ cabalPath
61+ putStrLn $ "Creating " ++ dst
62+ makeDirectories dst
63+ copyFile src dst
64+
65+ putStrLn $ "Creating " ++ cabalPath
51− createCabal cabalPath name
66+ createCabal cabalPath name
52− _ -> do
67+ fs -> do
53− putStrLn $ "Usage: " ++ progName ++ " <directory>"
68+ putStrLn $ "The following files will be overwritten:"
69+ foldMap putStrLn fs
70+ putStrLn $ "Use -f to overwrite them"
54− exitFailure
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+
55
79
56-- | Figure out a good cabal package name from the given (existing) directory
80-- | Figure out a good cabal package name from the given (existing) directory
57-- name
81-- name
@@ -77,7 +101,7 @@ makeName dstDir = do
77 safeLast = foldl' (\_ x -> Just x) Nothing
101 safeLast = foldl' (\_ x -> Just x) Nothing
78
102
79createCabal :: FilePath -> String -> IO ()
103createCabal :: FilePath -> String -> IO ()
80−createCabal path name = do
104+createCabal path name =
81 writeFile path $ unlines [
105 writeFile path $ unlines [
82 "name: " ++ name
106 "name: " ++ name
83 , "version: 0.1.0.0"
107 , "version: 0.1.0.0"