Commit 5f3afe6c authored by Maciek Makowski's avatar Maciek Makowski

refactored new command-related types to D.S.Command

parent 43be49e3
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP, ExistentialQuantification #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Simple.Command
......@@ -6,7 +6,7 @@
-- License : BSD3
--
-- Maintainer : cabal-devel@haskell.org
-- Portability : portable
-- Portability : non-portable (ExistentialQuantification)
--
-- This is to do with command line handling. The Cabal command line is
-- organised into a number of named sub-commands (much like darcs). The
......@@ -38,6 +38,11 @@ module Distribution.Simple.Command (
commandAddAction,
noExtraFlags,
-- ** Building lists of commands
CommandType(..),
CommandSpec(..),
commandFromSpec,
-- ** Running commands
commandsRun,
......@@ -605,3 +610,13 @@ helpCommandUI =
++ " " ++ pname ++ " help help\n"
++ " Oh, appararently you already know this.\n"
}
-- | wraps a @CommandUI@ together with a function that turns it into a @Command@.
-- By hiding the type of flags for the UI allows construction of a list of all UIs at the
-- top level of the program. That list can then be used for generation of manual page
-- as well as for executing the selected command.
data CommandSpec action
= forall flags. CommandSpec (CommandUI flags) (CommandUI flags -> Command action) CommandType
commandFromSpec :: CommandSpec a -> Command a
commandFromSpec (CommandSpec ui action _) = action ui
{-# LANGUAGE CPP, ExistentialQuantification #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.Manpage
......@@ -7,17 +7,13 @@
--
-- Maintainer : cabal-devel@haskell.org
-- Stability : provisional
-- Portability : non-portable (ExistentialQuantification)
-- Portability : portable
--
-- Functions and types for building the manual page.
-- Functions for building the manual page.
module Distribution.Client.Manpage
( -- * Command list
CommandVisibility (..)
, CommandSpec (..)
, commandFromSpec
-- * Manual page generation
, manpage
( -- * Manual page generation
manpage
) where
import Distribution.Simple.Command
......@@ -26,18 +22,6 @@ import Distribution.Client.Setup (globalCommand)
import Data.Char (toUpper)
import Data.List (intercalate)
data CommandVisibility = Visible | Hidden
-- | wraps a @CommandUI@ together with a function that turns it into a @Command@.
-- By hiding the type of flags for the UI allows construction of a list of all UIs at the
-- top level of the program. That list can then be used for generation of manual page
-- as well as for executing the selected command.
data CommandSpec action
= forall flags. CommandSpec (CommandUI flags) (CommandUI flags -> Command action) CommandVisibility
commandFromSpec :: CommandSpec a -> Command a
commandFromSpec (CommandSpec ui action _) = action ui
data FileInfo = FileInfo String String -- ^ path, description
-- | A list of files that should be documented in the manual page.
......@@ -91,15 +75,15 @@ manpage pname commands = unlines $
]
commandSynopsisLines :: String -> CommandSpec action -> [String]
commandSynopsisLines pname (CommandSpec ui _ Visible) =
commandSynopsisLines pname (CommandSpec ui _ NormalCommand) =
[ ".B " ++ pname ++ " " ++ (commandName ui)
, ".R - " ++ commandSynopsis ui
, ".br"
]
commandSynopsisLines _ (CommandSpec _ _ Hidden) = []
commandSynopsisLines _ (CommandSpec _ _ HiddenCommand) = []
commandDetailsLines :: String -> CommandSpec action -> [String]
commandDetailsLines pname (CommandSpec ui _ Visible) =
commandDetailsLines pname (CommandSpec ui _ NormalCommand) =
[ ".B " ++ pname ++ " " ++ (commandName ui)
, ""
, commandUsage ui pname
......@@ -119,7 +103,7 @@ commandDetailsLines pname (CommandSpec ui _ Visible) =
case field ui of
Just text -> [text pname, ""]
Nothing -> []
commandDetailsLines _ (CommandSpec _ _ Hidden) = []
commandDetailsLines _ (CommandSpec _ _ HiddenCommand) = []
optionsLines :: CommandUI flags -> [String]
optionsLines command = concatMap optionLines (concatMap optionDescr (commandOptions command ParseArgs))
......
......@@ -110,10 +110,7 @@ import Distribution.Client.Sandbox.Timestamp (maybeAddCompilerTimestampRecord)
import Distribution.Client.Sandbox.Types (UseSandbox(..), whenUsingSandbox)
import Distribution.Client.Types (Password (..))
import Distribution.Client.Init (initCabal)
import Distribution.Client.Manpage (CommandVisibility(..)
,CommandSpec(..)
,commandFromSpec
,manpage)
import Distribution.Client.Manpage (manpage)
import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade
import Distribution.Client.Utils (determineNumJobs
#if defined(mingw32_HOST_OS)
......@@ -133,8 +130,8 @@ import qualified Distribution.Make as Make
import Distribution.Simple.Build
( startInterpreter )
import Distribution.Simple.Command
( CommandParse(..), CommandUI(..), Command
, commandsRun, commandAddAction, hiddenCommand )
( CommandParse(..), CommandUI(..), Command, CommandSpec(..), CommandType(..)
, commandsRun, commandAddAction, hiddenCommand, commandFromSpec)
import Distribution.Simple.Compiler
( Compiler(..) )
import Distribution.Simple.Configure
......@@ -274,11 +271,11 @@ mainWorker args = topHandler $
type Action = GlobalFlags -> IO ()
regularCmd :: CommandUI flags -> (flags -> [String] -> action) -> CommandSpec action
regularCmd ui action = CommandSpec ui ((flip commandAddAction) action) Visible
regularCmd ui action = CommandSpec ui ((flip commandAddAction) action) NormalCommand
hiddenCmd :: CommandUI flags -> (flags -> [String] -> action) -> CommandSpec action
hiddenCmd ui action = CommandSpec ui (\ui' -> hiddenCommand (commandAddAction ui' action)) Hidden
hiddenCmd ui action = CommandSpec ui (\ui' -> hiddenCommand (commandAddAction ui' action)) HiddenCommand
wrapperCmd :: Monoid flags => CommandUI flags -> (flags -> Flag Verbosity) -> (flags -> Flag String) -> CommandSpec Action
wrapperCmd ui verbosity distPref = CommandSpec ui (\ui' -> wrapperAction ui' verbosity distPref) Visible
wrapperCmd ui verbosity distPref = CommandSpec ui (\ui' -> wrapperAction ui' verbosity distPref) NormalCommand
wrapperAction :: Monoid flags
=> CommandUI flags
......
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