Make --relocatable accept a path

Author: fgaz-scrive

docs/Install.md

@@ -31,8 +31,8 @@ Run `hoogle generate --local=mydir1 --local=mydir2` to generate an index for the
 
 ### Index a directory, producing a relocatable database
 
-Run `hoogle generate --relocatable --local=mydir` to generate an index that supports moving the Haddock directory to a different path without breaking the Haddock links.
-This mode only supports one `--local` directory.
+Run `hoogle generate --relocatable=mydir` to generate an index that supports moving the Haddock directory to a different path without breaking the Haddock links.
+This mode acts like `--local` but only supports one directory.
 
 ## Searching a Hoogle database
 

src/Action/CmdLine.hs

@@ -45,7 +45,7 @@ data CmdLine
         ,haddock :: Maybe FilePath
         ,debug :: Bool
         ,language :: Language
-        ,relocatable :: Bool
+        ,relocatable :: Maybe FilePath
         }
     | Server
         {port :: Int
@@ -152,7 +152,7 @@ generate = Generate
     ,count = Nothing &= name "n" &= help "Maximum number of packages to index (defaults to all)"
     ,haddock = def &= help "Use local haddocks"
     ,debug = def &= help "Generate debug information"
-    ,relocatable = False &= help "Generate a relocatable database"
+    ,relocatable = Nothing &= help "Index local packages and link to local haddock docs, producing a relocatable database"
     } &= help "Generate Hoogle databases"
 
 server = Server

src/Action/Generate.hs

@@ -246,17 +246,17 @@ actionGenerate g@Generate{..} = withTiming (if debug then Just $ replaceExtensio
         Haskell | Just dir <- haddock -> do
                     warnFlagIgnored "--haddock" "set" (local_ /= []) "--local"
                     warnFlagIgnored "--haddock" "set" (isJust download) "--download"
-                    warnFlagIgnored "--haddock" "set" relocatable "--relocatable"
+                    warnFlagIgnored "--haddock" "set" (isJust relocatable) "--relocatable"
                     readHaskellHaddock timing settings dir
                 | [""] <- local_ -> do
                     warnFlagIgnored "--local" "used as flag (no paths)" (isJust download) "--download"
                     readHaskellGhcpkg timing settings
+                | Just _ <- relocatable, _:_ <- local_ ->
+                    exitFail "Error: --relocatable and --local are mutually exclusive"
+                | Just relocatable' <- relocatable -> do
+                    prefix <- traverse canonicalizePath relocatable
+                    readHaskellDirs timing settings prefix [relocatable']
                 | [] <- local_ -> do readHaskellOnline timing settings doDownload
-                | relocatable, _:_:_ <- local_ ->
-                    exitFail "Error: --relocatable needs exactly one --local, or the paths will be ambiguous"
-                | relocatable -> do
-                    prefix <- traverse canonicalizePath $ listToMaybe local_
-                    readHaskellDirs timing settings prefix local_
                 | otherwise -> readHaskellDirs timing settings Nothing local_
         Frege | [] <- local_ -> readFregeOnline timing doDownload
               | otherwise -> errorIO "No support for local Frege databases"