Commit 47b8a8b3 authored by Brent Yorgey's avatar Brent Yorgey

cabal init: simple heuristic for guessing common extra-source-files

parent 3f721272
......@@ -24,12 +24,15 @@ module Distribution.Client.Init (
import System.IO
( hSetBuffering, stdout, BufferMode(..) )
import System.Directory
( getCurrentDirectory, doesDirectoryExist, doesFileExist, copyFile )
( getCurrentDirectory, doesDirectoryExist, doesFileExist, copyFile
, getDirectoryContents )
import System.FilePath
( (</>), (<.>) )
( (</>), (<.>), takeBaseName )
import Data.Time
( getCurrentTime, utcToLocalTime, toGregorian, localDay, getCurrentTimeZone )
import Data.Char
( toUpper )
import Data.List
( intercalate, nub, groupBy, (\\) )
import Data.Maybe
......@@ -125,6 +128,7 @@ extendFlags pkgIx =
>=> getHomepage
>=> getSynopsis
>=> getCategory
>=> getExtraSourceFiles
>=> getLibOrExec
>=> getLanguage
>=> getGenComments
......@@ -231,6 +235,30 @@ getCategory flags = do
(promptListOptional "Project category" [Codec ..]))
return $ flags { category = maybeToFlag cat }
-- | Try to guess extra source files (don't prompt the user).
getExtraSourceFiles :: InitFlags -> IO InitFlags
getExtraSourceFiles flags = do
extraSrcFiles <- return (extraSrc flags)
?>> Just `fmap` guessExtraSourceFiles flags
return $ flags { extraSrc = extraSrcFiles }
-- | Try to guess things to include in the extra-source-files field.
-- For now, we just look for things in the root directory named
-- 'readme', 'changes', or 'changelog', with any sort of
-- capitalization and any extension.
guessExtraSourceFiles :: InitFlags -> IO [FilePath]
guessExtraSourceFiles flags = do
dir <-
maybe getCurrentDirectory return . flagToMaybe $ packageDir flags
files <- getDirectoryContents dir
return $ filter isExtra files
where
isExtra = (`elem` ["README", "CHANGES", "CHANGELOG"])
. map toUpper
. takeBaseName
-- | Ask whether the project builds a library or executable.
getLibOrExec :: InitFlags -> IO InitFlags
getLibOrExec flags = do
......@@ -653,9 +681,9 @@ generateCabalFile fileName c =
Nothing
True
, fieldS "extra-source-files" NoFlag
, fieldS "extra-source-files" (listFieldS (extraSrc c))
(Just "Extra files to be distributed with the package, such as examples or a README.")
False
True
, field "cabal-version" (Flag $ orLaterVersion (Version [1,10] []))
(Just "Constraint on the version of Cabal needed to build this package.")
......
......@@ -52,6 +52,7 @@ data InitFlags =
, synopsis :: Flag String
, category :: Flag (Either String Category)
, extraSrc :: Maybe [String]
, packageType :: Flag PackageType
, language :: Flag Language
......@@ -68,6 +69,10 @@ data InitFlags =
}
deriving (Show)
-- the Monoid instance for Flag has later values override earlier
-- ones, which is why we want Maybe [foo] for collecting foo values,
-- not Flag [foo].
data PackageType = Library | Executable
deriving (Show, Read, Eq)
......@@ -91,6 +96,7 @@ instance Monoid InitFlags where
, homepage = mempty
, synopsis = mempty
, category = mempty
, extraSrc = mempty
, packageType = mempty
, language = mempty
, exposedModules = mempty
......@@ -116,6 +122,7 @@ instance Monoid InitFlags where
, homepage = combine homepage
, synopsis = combine synopsis
, category = combine category
, extraSrc = combine extraSrc
, packageType = combine packageType
, language = combine language
, exposedModules = combine exposedModules
......
......@@ -1094,6 +1094,12 @@ initCommand = CommandUI {
(reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s))
(flagToList . fmap (either id show)))
, option ['x'] ["extra-source-file"]
"Extra source file to be distributed with tarball."
IT.extraSrc (\v flags -> flags { IT.extraSrc = v })
(reqArg' "FILE" (Just . (:[]))
(fromMaybe []))
, option [] ["is-library"]
"Build a library."
IT.packageType (\v flags -> flags { IT.packageType = v })
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment