Add -flocal-ghci-history flag (#9089).

Reviewers: thomie, bgamari, austin

Reviewed By: thomie, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2461

GHC Trac Issues: #9089

5 files changed, 33 insertions, 4 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 4081ac4684..17386ab0ae 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -476,6 +476,7 @@ data GeneralFlag
    | Opt_IgnoreDotGhci
    | Opt_GhciSandbox
    | Opt_GhciHistory
+   | Opt_LocalGhciHistory
    | Opt_HelpfulErrors
    | Opt_DeferTypeErrors
    | Opt_DeferTypedHoles
@@ -3381,6 +3382,7 @@ fFlagsDeps = [
   flagSpec "fun-to-thunk"                     Opt_FunToThunk,
   flagSpec "gen-manifest"                     Opt_GenManifest,
   flagSpec "ghci-history"                     Opt_GhciHistory,
+  flagGhciSpec "local-ghci-history"           Opt_LocalGhciHistory,
   flagSpec "ghci-sandbox"                     Opt_GhciSandbox,
   flagSpec "helpful-errors"                   Opt_HelpfulErrors,
   flagSpec "hpc"                              Opt_Hpc,
@@ -3668,6 +3670,7 @@ defaultFlags settings
       Opt_FlatCache,
       Opt_GenManifest,
       Opt_GhciHistory,
+      Opt_LocalGhciHistory,
       Opt_GhciSandbox,
       Opt_HelpfulErrors,
       Opt_KeepHiFiles,
diff --git a/docs/users_guide/8.2.1-notes.rst b/docs/users_guide/8.2.1-notes.rst
index fdd8f5c35a..1b4b34ed7b 100644
--- a/docs/users_guide/8.2.1-notes.rst
+++ b/docs/users_guide/8.2.1-notes.rst
@@ -43,6 +43,8 @@ GHCi
 
 -  TODO FIXME.
 
+- Added :ghc-flag:`-flocal-ghci-history` which uses current directory for `.ghci-history`.
+
 Template Haskell
 ~~~~~~~~~~~~~~~~
 
diff --git a/docs/users_guide/ghci.rst b/docs/users_guide/ghci.rst
index 783059fe17..468f39edfe 100644
--- a/docs/users_guide/ghci.rst
+++ b/docs/users_guide/ghci.rst
@@ -1901,6 +1901,17 @@ Most of the command-line options accepted by GHC (see :ref:`using-ghc`)
 also make sense in interactive mode. The ones that don't make sense are
 mostly obvious.
 
+.. ghc-flag:: -flocal-ghci-history
+
+  By default, GHCi keeps global history in ``~/.ghc/ghci_history`` or
+  ``%APPDATA%/<app>/ghci_history``, but you can use current directory, e.g.:
+
+  .. code-block:: none
+
+      $ ghci -flocal-ghci-history
+
+  It will create ``.ghci-history`` in current folder where GHCi is launched.
+
 Packages
 ~~~~~~~~
 
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 1e27c7a861..e3a56d6a06 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -613,10 +613,16 @@ runGHCi paths maybe_exprs = do
 runGHCiInput :: InputT GHCi a -> GHCi a
 runGHCiInput f = do
     dflags <- getDynFlags
-    histFile <- if gopt Opt_GhciHistory dflags
-                then liftIO $ withGhcAppData (\dir -> return (Just (dir </> "ghci_history")))
-                                             (return Nothing)
-                else return Nothing
+    let ghciHistory = gopt Opt_GhciHistory dflags
+    let localGhciHistory = gopt Opt_LocalGhciHistory dflags
+    currentDirectory <- liftIO $ getCurrentDirectory
+
+    histFile <- case (ghciHistory, localGhciHistory) of
+      (True, True) -> return (Just (currentDirectory </> ".ghci_history"))
+      (True, _) -> liftIO $ withGhcAppData
+        (\dir -> return (Just (dir </> "ghci_history"))) (return Nothing)
+      _ -> return Nothing
+
     runInputT
         (setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile})
         f
diff --git a/utils/mkUserGuidePart/Options/Misc.hs b/utils/mkUserGuidePart/Options/Misc.hs
index 0bb504a2fd..57e8808655 100644
--- a/utils/mkUserGuidePart/Options/Misc.hs
+++ b/utils/mkUserGuidePart/Options/Misc.hs
@@ -36,4 +36,11 @@ miscOptions =
          , flagType = DynamicFlag
          , flagReverse = "-fno-reverse-errors"
          }
+  , flag { flagName = "-flocal-ghci-history"
+         , flagDescription =
+           "Use current directory for the GHCi command history "++
+           "file ``.ghci-history``."
+         , flagType = DynamicFlag
+         , flagReverse = "-fno-local-ghci-history"
+         }
   ]