diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs index a5d73e4c8c..47478d6425 100644 --- a/src/Stack/Init.hs +++ b/src/Stack/Init.hs @@ -13,15 +13,15 @@ import Control.Monad import Control.Monad.Catch (MonadMask, throwM) import Control.Monad.IO.Class import Control.Monad.Logger -import Control.Monad.Reader (asks, MonadReader) +import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.ByteString.Builder as B -import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy as L +import qualified Data.Foldable as F import Data.Function (on) import qualified Data.HashMap.Strict as HM import qualified Data.IntMap as IntMap -import qualified Data.Foldable as F import Data.List (intersect, maximumBy) import Data.List.Extra (nubOrd) import Data.Map (Map) @@ -35,13 +35,13 @@ import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.IO import Stack.BuildPlan +import Stack.Config (getSnapshots, + makeConcreteResolver) import Stack.Constants import Stack.Solver import Stack.Types -import Stack.Types.Internal ( HasTerminal, HasReExec - , HasLogLevel) -import Stack.Config ( getSnapshots - , makeConcreteResolver) +import Stack.Types.Internal (HasLogLevel, HasReExec, + HasTerminal) import qualified System.FilePath as FP -- | Generate stack.yaml @@ -57,8 +57,8 @@ initProject initProject currDir initOpts mresolver = do let dest = currDir stackDotYaml + dirs <- mapM (resolveDir' . T.unpack) (searchDirs initOpts) reldest <- toFilePath `liftM` makeRelativeToCurrentDir dest - exists <- doesFileExist dest when (not (forceOverwrite initOpts) && exists) $ do error ("Stack configuration file " <> reldest <> @@ -67,8 +67,12 @@ initProject currDir initOpts mresolver = do let noPkgMsg = "In order to init, you should have an existing .cabal \ \file. Please try \"stack new\" instead." - - cabalfps <- findCabalFiles (includeSubDirs initOpts) currDir + let findCabalFiles' = findCabalFiles (includeSubDirs initOpts) + cabalfps <- if null dirs + then + findCabalFiles' currDir + else + liftM concat $ mapM findCabalFiles' dirs (bundle, dupPkgs) <- cabalPackagesCheck cabalfps noPkgMsg Nothing (r, flags, extraDeps, rbundle) <- getDefaultResolver dest initOpts @@ -435,12 +439,14 @@ getRecommendedSnapshots snapshots = do ] data InitOpts = InitOpts - { useSolver :: Bool + { useSolver :: Bool -- ^ Use solver to determine required external dependencies - , omitPackages :: Bool + , omitPackages :: Bool -- ^ Exclude conflicting or incompatible user packages , forceOverwrite :: Bool -- ^ Overwrite existing stack.yaml , includeSubDirs :: Bool -- ^ If True, include all .cabal files found in any sub directories + , searchDirs :: ![T.Text] + -- ^ List of sub directories to search for .cabal files } diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs index dcf94cedef..5dbf481e76 100644 --- a/src/Stack/Options.hs +++ b/src/Stack/Options.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings,RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Stack.Options (BuildCommand(..) @@ -26,32 +27,32 @@ module Stack.Options ,globalOptsFromMonoid ) where -import Control.Monad.Logger (LogLevel(..)) -import Data.Char (isSpace, toLower) -import Data.List (intercalate) -import Data.List.Split (splitOn) -import qualified Data.Map as Map -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as M +import Control.Monad.Logger (LogLevel (..)) +import Data.Char (isSpace, toLower) +import Data.List (intercalate) +import Data.List.Split (splitOn) +import qualified Data.Map as Map +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid -import qualified Data.Set as Set -import qualified Data.Text as T -import Data.Text.Read (decimal) -import Distribution.Version (anyVersion) +import qualified Data.Set as Set +import qualified Data.Text as T +import Data.Text.Read (decimal) +import Distribution.Version (anyVersion) import Options.Applicative import Options.Applicative.Args import Options.Applicative.Builder.Extra -import Options.Applicative.Types (fromM, oneM, readerAsk) -import Stack.Clean (CleanOpts(..)) -import Stack.Config (packagesParser) +import Options.Applicative.Types (fromM, oneM, readerAsk) +import Stack.Clean (CleanOpts (..)) +import Stack.Config (packagesParser) import Stack.ConfigCmd -import Stack.Constants (stackProgName) -import Stack.Coverage (HpcReportOpts(..)) +import Stack.Constants (stackProgName) +import Stack.Coverage (HpcReportOpts (..)) import Stack.Docker -import qualified Stack.Docker as Docker +import qualified Stack.Docker as Docker import Stack.Dot -import Stack.Ghci (GhciOpts(..)) +import Stack.Ghci (GhciOpts (..)) import Stack.Init import Stack.New import Stack.Nix @@ -682,7 +683,12 @@ initOptsParser :: Parser InitOpts initOptsParser = InitOpts <$> solver <*> omitPackages <*> overwrite <*> fmap not ignoreSubDirs + <*> searchDirs where + searchDirs = + many (textArgument + (metavar "DIRS" <> + help "Directories to include, default is current directory.")) ignoreSubDirs = switch (long "ignore-subdirs" <> help "Do not search for .cabal files in sub directories") overwrite = switch (long "force" <> diff --git a/src/main/Main.hs b/src/main/Main.hs index 27e745b531..ee5819e582 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -1173,8 +1173,10 @@ withMiniConfigAndLock go inner = -- | Project initialization initCmd :: InitOpts -> GlobalOpts -> IO () initCmd initOpts go = do - pwd <- getCurrentDir - withMiniConfigAndLock go (initProject pwd initOpts (globalResolver go)) + workDir <- getCurrentDir + withMiniConfigAndLock go $ + initProject workDir initOpts $ + globalResolver go -- | Create a project directory structure and initialize the stack config. newCmd :: (NewOpts,InitOpts) -> GlobalOpts -> IO ()