Allow specifying both --packages and --package. (#31)

This can be useful if you've stored the dependencies of your application in one directory, but have your application in another directory.

1 files changed, 25 insertions, 16 deletions

diff --git a/app/Server.hs b/app/Server.hs
index 2304f27..9544539 100644
--- a/app/Server.hs
+++ b/app/Server.hs
@@ -184,10 +184,12 @@ data ServerConfig = ServerConfig
   , configUseHoogleApi :: !Bool
   } deriving (Show, Eq)
 
-data PackagesPath
-  = DirectoryWithPackages FilePath
-  | Directories [FilePath]
-  deriving (Show, Eq)
+data PackagesPath = PackagesPath
+  { pathDirWithPackages :: !(Maybe FilePath)
+    -- ^ Path to a directory containing Cabal package subdirectories.
+  , pathPackages :: ![FilePath]
+    -- ^ Paths to Cabal packages.
+  } deriving (Show, Eq)
 
 data Store
   = CreateStore FilePath
@@ -198,16 +200,14 @@ data Store
 configParser :: Parser ServerConfig
 configParser =
   ServerConfig <$>
-  ((DirectoryWithPackages <$>
-    strOption
+  parsePackagesPath
+    (strOption
       (long "packages" <> metavar "PATH" <>
-       help "Path to a directory with Cabal packages")) <|>
-   Directories <$>
-   some
-     (strOption
+       help "Path to a directory with Cabal packages"))
+    (some
+      (strOption
         (long "package" <> short 'p' <> metavar "PATH" <>
-         help "Path to a Cabal package (Default: '.')"))
-   <|> pure (Directories ["."])) <*>
+         help "Path to a Cabal package (defaults to '.' if 'packages' not provided either)"))) <*>
   (pure 8080 <|>
    option
      auto
@@ -263,6 +263,11 @@ configParser =
      help
        "Use public Hoogle JSON API (https://github.com/ndmitchell/hoogle/blob/3dbf68bfd701f942d3af2e6debb74a0a78cd392e/docs/API.md#json-api) to get documentation for not indexed packages (disabled by default)")
 
+parsePackagesPath :: Parser FilePath -> Parser [FilePath] -> Parser PackagesPath
+parsePackagesPath parseDir parsePaths =
+      (PackagesPath <$> fmap Just parseDir <*> parsePaths)
+  <|> pure (PackagesPath Nothing ["."])
+
 --------------------------------------------------------------------------------
 -- Loading packages
 --------------------------------------------------------------------------------
@@ -708,10 +713,14 @@ addExternalIdInfo packageId packageInfo = do
 
 findDirectories :: PackagesPath -> IO [FilePath]
 findDirectories p =
-  case p of
-    DirectoryWithPackages dir ->
-      find (depth ==? 0) (fileType ==? Directory &&? filePath /=? dir) dir
-    Directories dirs -> return dirs
+  fmap (pathPackages p <>) packagesInPackageDir
+  where
+    packagesInPackageDir :: IO [FilePath]
+    packagesInPackageDir =
+      case pathDirWithPackages p of
+        Nothing -> return []
+        Just dir ->
+          find (depth ==? 0) (fileType ==? Directory &&? filePath /=? dir) dir
 
 loadPackages ::
      ServerConfig