init accepts list of directories to search

commercialhaskell · Jan 30, 2016 · cbb5d34 · cbb5d34
1 parent 0306810
commit cbb5d34
Show file tree

Hide file tree

Showing 3 changed files with 49 additions and 30 deletions.
diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs
@@ -13,15 +13,15 @@ import           Control.Monad                   (when)
 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,14 +35,14 @@ 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.Types.Internal            (HasLogLevel, HasReExec,
+                                                  HasTerminal)
 import           System.Directory                (makeRelativeToCurrentDirectory)
-import           Stack.Config                    ( getSnapshots
-                                                 , makeConcreteResolver)
 import qualified System.FilePath                 as FP
 
 -- | Generate stack.yaml
@@ -437,12 +437,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
@@ -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
@@ -676,7 +677,12 @@ initOptsParser :: Parser InitOpts
 initOptsParser =
     InitOpts <$> solver <*> omitPackages
              <*> overwrite <*> fmap not ignoreSubDirs
+             <*> searchDirs
   where
+    searchDirs =
+      many (textArgument
+              (metavar "SEARCH-DIRECTORIES" <>
+               help "Directories which are searched for cabal files. If non specified, uses 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
@@ -1175,8 +1175,19 @@ withMiniConfigAndLock go inner =
 -- | Project initialization
 initCmd :: InitOpts -> GlobalOpts -> IO ()
 initCmd initOpts go = do
-    pwd <- getWorkingDir
-    withMiniConfigAndLock go (initProject pwd initOpts (globalResolver go))
+    let selectedDirs = searchDirs initOpts
+    if null selectedDirs
+    then do
+      pwd <- getWorkingDir
+      checkDir pwd
+    else checkSubDirs selectedDirs
+    where checkSubDirs = mapM_ (liftM checkDir . parseRelAsAbsDir . T.unpack)
+          checkDir dir =
+            withMiniConfigAndLock go $
+            initProject dir initOpts $
+            globalResolver go
+
+
 
 -- | Create a project directory structure and initialize the stack config.
 newCmd :: (NewOpts,InitOpts) -> GlobalOpts -> IO ()