Commit 4081112c authored by Brent Yorgey's avatar Brent Yorgey

add 'init' subcommand for initializing project cabalisation

parent 9f5c37a6
This diff is collapsed.
......@@ -8,8 +8,8 @@
-- Stability : provisional
-- Portability : portable
--
-- Heuristics for creating initial cabal files
-- XXX: module name is preliminary, merge into Client.Init ?
-- Heuristics for creating initial cabal files.
--
-----------------------------------------------------------------------------
module Distribution.Client.Init.Heuristics (
guessPackageName,
......
This diff is collapsed.
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Init.Types
-- Copyright : (c) Brent Yorgey, Benedikt Huber 2009
-- License : BSD-like
--
-- Maintainer : cabal-devel@haskell.org
-- Stability : provisional
-- Portability : portable
--
-- Some types used by the 'cabal init' command.
--
-----------------------------------------------------------------------------
module Distribution.Client.Init.Types where
import Distribution.Simple.Setup
( Flag(..) )
import Distribution.Version
import qualified Distribution.Package as P
import Distribution.License
import Distribution.ModuleName
import qualified Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Text
import Data.Monoid
-- | InitFlags is really just a simple type to represent certain
-- portions of a .cabal file. Rather than have a flag for EVERY
-- possible field, we just have one for each field that the user is
-- likely to want and/or that we are likely to be able to
-- intelligently guess.
data InitFlags =
InitFlags { nonInteractive :: Flag Bool
, quiet :: Flag Bool
, packageDir :: Flag FilePath
, noComments :: Flag Bool
, minimal :: Flag Bool
, packageName :: Flag String
, version :: Flag Version
, cabalVersion :: Flag VersionRange
, license :: Flag License
, author :: Flag String
, email :: Flag String
, stability :: Flag (Either String Stability)
, homepage :: Flag String
, synopsis :: Flag String
, category :: Flag (Either String Category)
, packageType :: Flag PackageType
, exposedModules :: Maybe [ModuleName]
, otherModules :: Maybe [ModuleName]
, dependencies :: Maybe [P.Dependency]
, sourceDirs :: Maybe [String]
, buildTools :: Maybe [String]
}
deriving (Show)
data PackageType = Library | Executable
deriving (Show, Read, Eq)
instance Text PackageType where
disp = Disp.text . show
parse = Parse.choice $ map (fmap read . Parse.string . show) [Library, Executable]
instance Monoid InitFlags where
mempty = InitFlags
{ nonInteractive = mempty
, quiet = mempty
, packageDir = mempty
, noComments = mempty
, minimal = mempty
, packageName = mempty
, version = mempty
, cabalVersion = mempty
, license = mempty
, author = mempty
, email = mempty
, stability = mempty
, homepage = mempty
, synopsis = mempty
, category = mempty
, packageType = mempty
, exposedModules = mempty
, otherModules = mempty
, dependencies = mempty
, sourceDirs = mempty
, buildTools = mempty
}
mappend a b = InitFlags
{ nonInteractive = combine nonInteractive
, quiet = combine quiet
, packageDir = combine packageDir
, noComments = combine noComments
, minimal = combine minimal
, packageName = combine packageName
, version = combine version
, cabalVersion = combine cabalVersion
, license = combine license
, author = combine author
, email = combine email
, stability = combine stability
, homepage = combine homepage
, synopsis = combine synopsis
, category = combine category
, packageType = combine packageType
, exposedModules = combine exposedModules
, otherModules = combine otherModules
, dependencies = combine dependencies
, sourceDirs = combine sourceDirs
, buildTools = combine buildTools
}
where combine field = field a `mappend` field b
-- | Some common package categories.
data Category
= Codec
| Concurrency
| Control
| Data
| Database
| Development
| Distribution
| Game
| Graphics
| Language
| Math
| Network
| Sound
| System
| Testing
| Text
| Web
deriving (Read, Show, Eq, Ord, Bounded, Enum)
instance Text Category where
disp = Disp.text . show
parse = Parse.choice $ map (fmap read . Parse.string . show) [Codec .. ]
-- | Some common package stability indicators.
data Stability
= Stable
| Provisional
| Experimental
| Alpha
deriving (Read, Show, Eq, Ord, Bounded, Enum)
instance Text Stability where
disp = Disp.text . show
parse = Parse.choice $ map (fmap read . Parse.string . show) [Stable .. ]
......@@ -25,6 +25,7 @@ module Distribution.Client.Setup
, uploadCommand, UploadFlags(..)
, reportCommand
, unpackCommand, UnpackFlags(..)
, initCommand, IT.InitFlags(..)
, parsePackageArgs
--TODO: stop exporting these:
......@@ -36,6 +37,8 @@ import Distribution.Client.Types
( Username(..), Password(..), Repo(..), RemoteRepo(..), LocalRepo(..) )
import Distribution.Client.BuildReports.Types
( ReportLevel(..) )
import qualified Distribution.Client.Init.Types as IT
( InitFlags(..), PackageType(..) )
import Distribution.Simple.Program
( defaultProgramConfiguration )
......@@ -66,7 +69,7 @@ import Distribution.Verbosity
import Data.Char
( isSpace, isAlphaNum )
import Data.Maybe
( listToMaybe, maybeToList )
( listToMaybe, maybeToList, fromMaybe )
import Data.Monoid
( Monoid(..) )
import Control.Monad
......@@ -659,6 +662,164 @@ instance Monoid UploadFlags where
}
where combine field = field a `mappend` field b
-- ------------------------------------------------------------
-- * Init flags
-- ------------------------------------------------------------
emptyInitFlags :: IT.InitFlags
emptyInitFlags = mempty
defaultInitFlags :: IT.InitFlags
defaultInitFlags = emptyInitFlags
initCommand :: CommandUI IT.InitFlags
initCommand = CommandUI {
commandName = "init",
commandSynopsis = "Interactively create a .cabal file.",
commandUsage = \pname -> unlines
[ "Usage: " ++ pname ++ " init [FLAGS]"
, ""
, "Cabalise a project by creating a .cabal, Setup.lhs, and"
, "optionally a LICENSE file."
, ""
, "Calling init with no arguments (recommended) uses an"
, "interactive mode, which will try to guess as much as"
, "possible and prompt you for the rest. Command-line"
, "arguments are provided for scripting purposes."
, "If you don't want interactive mode, be sure to pass"
, "the -n flag."
, ""
, "Flags for init:"
],
commandDescription = Nothing,
commandDefaultFlags = defaultInitFlags,
commandOptions = \_ ->
[ option ['n'] ["nonInteractive"]
"Non-interactive mode."
IT.nonInteractive (\v flags -> flags { IT.nonInteractive = v })
trueArg
, option ['q'] ["quiet"]
"Do not generate log messages to stdout."
IT.quiet (\v flags -> flags { IT.quiet = v })
trueArg
, option [] ["noComments"]
"Do not generate explanatory comments in the .cabal file."
IT.noComments (\v flags -> flags { IT.noComments = v })
trueArg
, option ['m'] ["minimal"]
"Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --noComments."
IT.minimal (\v flags -> flags { IT.minimal = v })
trueArg
, option [] ["packageDir"]
"Root directory of the package (default = current directory)."
IT.packageDir (\v flags -> flags { IT.packageDir = v })
(reqArgFlag "DIRECTORY")
, option ['p'] ["packageName"]
"Name of the Cabal package to create."
IT.packageName (\v flags -> flags { IT.packageName = v })
(reqArgFlag "PACKAGE")
, option [] ["version"]
"Initial version of the package."
IT.version (\v flags -> flags { IT.version = v })
(reqArg "VERSION" (readP_to_E ("Cannot parse package version: "++)
(toFlag `fmap` parse))
(flagToList . fmap display))
, option [] ["cabalVersion"]
"Required version of the Cabal library."
IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v })
(reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal version range: "++)
(toFlag `fmap` parse))
(flagToList . fmap display))
, option ['l'] ["license"]
"Project license."
IT.license (\v flags -> flags { IT.license = v })
(reqArg "LICENSE" (readP_to_E ("Cannot parse license: "++)
(toFlag `fmap` parse))
(flagToList . fmap display))
, option ['a'] ["author"]
"Name of the project's author."
IT.author (\v flags -> flags { IT.author = v })
(reqArgFlag "NAME")
, option ['e'] ["email"]
"Email address of the maintainer."
IT.email (\v flags -> flags { IT.email = v })
(reqArgFlag "EMAIL")
, option [] ["stability"]
"Package stability."
IT.stability (\v flags -> flags { IT.stability = v })
(reqArg' "STABILITY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s))
(flagToList . fmap (either id show)))
, option ['u'] ["homepage"]
"Project homepage and/or repository."
IT.homepage (\v flags -> flags { IT.homepage = v })
(reqArgFlag "URL")
, option ['s'] ["synopsis"]
"Short project synopsis."
IT.synopsis (\v flags -> flags { IT.synopsis = v })
(reqArgFlag "TEXT")
, option ['c'] ["category"]
"Project category."
IT.category (\v flags -> flags { IT.category = v })
(reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s))
(flagToList . fmap (either id show)))
, option [] ["isLibrary"]
"Build a library."
IT.packageType (\v flags -> flags { IT.packageType = v })
(noArg (Flag IT.Library))
, option [] ["isExecutable"]
"Build an executable."
IT.packageType
(\v flags -> flags { IT.packageType = v })
(noArg (Flag IT.Executable))
, option ['o'] ["exposeModule"]
"Export a module from the package."
IT.exposedModules
(\v flags -> flags { IT.exposedModules = v })
(reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++)
((Just . (:[])) `fmap` parse))
(fromMaybe [] . fmap (fmap display)))
, option ['d'] ["dependency"]
"Package dependency."
IT.dependencies (\v flags -> flags { IT.dependencies = v })
(reqArg "PACKAGE" (readP_to_E ("Cannot parse dependency: "++)
((Just . (:[])) `fmap` parse))
(fromMaybe [] . fmap (fmap display)))
, option [] ["sourceDir"]
"Directory containing package source."
IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v })
(reqArg' "DIR" (Just . (:[]))
(fromMaybe []))
, option [] ["buildTool"]
"Required external build tool."
IT.buildTools (\v flags -> flags { IT.buildTools = v })
(reqArg' "TOOL" (Just . (:[]))
(fromMaybe []))
]
}
where readMaybe s = case reads s of
[(x,"")] -> Just x
otherwise -> Nothing
-- ------------------------------------------------------------
-- * GetOpt Utils
-- ------------------------------------------------------------
......
......@@ -24,6 +24,7 @@ import Distribution.Client.Setup
, ListFlags(..), listCommand
, InfoFlags(..), infoCommand
, UploadFlags(..), uploadCommand
, InitFlags, initCommand
, reportCommand
, unpackCommand, UnpackFlags(..)
, parsePackageArgs )
......@@ -54,6 +55,7 @@ import Distribution.Client.Check as Check (check)
import Distribution.Client.Upload as Upload (upload, check, report)
import Distribution.Client.SrcDist (sdist)
import Distribution.Client.Unpack (unpack)
import Distribution.Client.Init (initCabal)
import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
import Distribution.Simple.Compiler
......@@ -133,6 +135,7 @@ mainWorker args = topHandler $
,sdistCommand `commandAddAction` sdistAction
,reportCommand `commandAddAction` reportAction
,unpackCommand `commandAddAction` unpackAction
,initCommand `commandAddAction` initAction
,wrapperAction (buildCommand defaultProgramConfiguration)
buildVerbosity buildDistPref
,wrapperAction copyCommand
......@@ -343,6 +346,10 @@ unpackAction flags extraArgs globalFlags = do
config <- loadConfig verbosity (globalConfigFile globalFlags) mempty
unpack flags (globalRepos (savedGlobalFlags config)) pkgs
initAction :: InitFlags -> [String] -> GlobalFlags -> IO ()
initAction flags _extraArgs _globalFlags = do
initCabal flags
win32SelfUpgradeAction :: [String] -> IO ()
win32SelfUpgradeAction (pid:path:rest) =
Win32SelfUpgrade.deleteOldExeFile verbosity (read pid) path
......
......@@ -91,7 +91,8 @@ Executable cabal
random >= 1 && < 1.1,
containers >= 0.1 && < 0.3,
array >= 0.1 && < 0.3,
old-time >= 1 && < 1.1
old-time >= 1 && < 1.1,
time >= 1.1 && < 1.2
if flag(bytestring-in-base)
build-depends: base >= 2.0 && < 2.2
......
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