@@ -85,12 +85,15 @@ module Distribution.Simple.Command
8585import Distribution.Compat.Prelude hiding (get )
8686import Prelude ()
8787
88+ import Control.Exception (try )
8889import qualified Data.Array as Array
8990import qualified Data.List as List
9091import Distribution.Compat.Lens (ALens' , (#~) , (^#) )
9192import qualified Distribution.GetOpt as GetOpt
9293import Distribution.ReadE
9394import Distribution.Simple.Utils
95+ import System.Directory (findExecutable )
96+ import System.Process (callProcess )
9497
9598data CommandUI flags = CommandUI
9699 { commandName :: String
@@ -596,11 +599,13 @@ data CommandParse flags
596599 | CommandList [String ]
597600 | CommandErrors [String ]
598601 | CommandReadyToGo flags
602+ | CommandDelegate
599603instance Functor CommandParse where
600604 fmap _ (CommandHelp help) = CommandHelp help
601605 fmap _ (CommandList opts) = CommandList opts
602606 fmap _ (CommandErrors errs) = CommandErrors errs
603607 fmap f (CommandReadyToGo flags) = CommandReadyToGo (f flags)
608+ fmap _ CommandDelegate = CommandDelegate
604609
605610data CommandType = NormalCommand | HiddenCommand
606611data Command action
@@ -631,25 +636,38 @@ commandsRun
631636 :: CommandUI a
632637 -> [Command action ]
633638 -> [String ]
634- -> CommandParse (a , CommandParse action )
639+ -> IO ( CommandParse (a , CommandParse action ) )
635640commandsRun globalCommand commands args =
636641 case commandParseArgs globalCommand True args of
637- CommandHelp help -> CommandHelp help
638- CommandList opts -> CommandList (opts ++ commandNames)
639- CommandErrors errs -> CommandErrors errs
642+ CommandDelegate -> pure CommandDelegate
643+ CommandHelp help -> pure $ CommandHelp help
644+ CommandList opts -> pure $ CommandList (opts ++ commandNames)
645+ CommandErrors errs -> pure $ CommandErrors errs
640646 CommandReadyToGo (mkflags, args') -> case args' of
641- (" help" : cmdArgs) -> handleHelpCommand cmdArgs
647+ (" help" : cmdArgs) -> pure $ handleHelpCommand cmdArgs
642648 (name : cmdArgs) -> case lookupCommand name of
643649 [Command _ _ action _] ->
644- CommandReadyToGo (flags, action cmdArgs)
645- _ -> CommandReadyToGo (flags, badCommand name)
646- [] -> CommandReadyToGo (flags, noCommand)
650+ pure $ CommandReadyToGo (flags, action cmdArgs)
651+ _ -> do
652+ mCommand <- findExecutable $ " cabal-" <> name
653+ case mCommand of
654+ Just exec -> callExternal flags exec cmdArgs
655+ Nothing -> pure $ CommandReadyToGo (flags, badCommand name)
656+ [] -> pure $ CommandReadyToGo (flags, noCommand)
647657 where
648658 flags = mkflags (commandDefaultFlags globalCommand)
649659 where
650660 lookupCommand cname =
651661 [ cmd | cmd@ (Command cname' _ _ _) <- commands', cname' == cname
652662 ]
663+
664+ callExternal :: a -> String -> [String ] -> IO (CommandParse (a , CommandParse action ))
665+ callExternal flags exec cmdArgs = do
666+ result <- try $ callProcess exec cmdArgs
667+ case result of
668+ Left ex -> pure $ CommandErrors [" Error executing external command: " ++ show (ex :: SomeException )]
669+ Right _ -> pure $ CommandReadyToGo (flags, CommandDelegate )
670+
653671 noCommand = CommandErrors [" no command given (try --help)\n " ]
654672
655673 -- Print suggested command if edit distance is < 5
@@ -679,6 +697,7 @@ commandsRun globalCommand commands args =
679697 -- furthermore, support "prog help command" as "prog command --help"
680698 handleHelpCommand cmdArgs =
681699 case commandParseArgs helpCommandUI True cmdArgs of
700+ CommandDelegate -> CommandDelegate
682701 CommandHelp help -> CommandHelp help
683702 CommandList list -> CommandList (list ++ commandNames)
684703 CommandErrors _ -> CommandHelp globalHelp
0 commit comments