From 3ad08b3b6f81cbf5d548b3837e5c18ab7b9522bc Mon Sep 17 00:00:00 2001
From: PRESFIL <PRESFIL@users.noreply.github.com>
Date: Thu, 12 Jan 2023 11:39:09 +0000
Subject: [PATCH 1/2] getStackSubdir: support $STACK_ROOT env variable

Add support of `$STACK_ROOT` environment variable to follow `stack`'s
behaviour. It allows to override the Stack Root location.

Ref: https://docs.haskellstack.org/en/stable/environment_variables/#stack_root
---
 ChangeLog.md       |  4 ++++
 README.md          | 10 +++++++---
 src/Directories.hs | 13 +++++++++++--
 3 files changed, 22 insertions(+), 5 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index b5ee37a..dd0a237 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,9 @@
 # Release history for stack-clean-old
 
+## Unreleased
+- add support for `${STACK_ROOT}` environment variable to override the Stack
+  Root location
+
 ## 0.4.6 (2022-02-03)
 - fix --recursive and --subdirs to work again
 - show --recursive dir paths
diff --git a/README.md b/README.md
index 1fcbd04..8f062b6 100644
--- a/README.md
+++ b/README.md
@@ -6,13 +6,17 @@ snapshot builds and ghc versions to recover diskspace.
 ## Usage
 `stack-clean-old [size|list|remove|keep-minor|purge-older|delete-work] [(-P|--project)|(-G|--global)] [(-s|--subdirs)|(-r|--recursive)] [-d|--delete] [GHCVER]`
 
-In a project directory it acts on `.stack-work/install/` by default,
-otherwise on `~/.stack/{snapshots,programs}/`.
+In a project directory it acts on `.stack-work/install/` by default, otherwise
+on the *Stack Root location* `${STACK_ROOT}/{snapshots,programs}/`. If
+`${STACK_ROOT}` is unset, the *Stack Root location* is `~/.stack/`. See
+[official documentation][stack_root].
+
+[stack_root]: https://docs.haskellstack.org/en/stable/environment_variables/#stack_root
 
 Subcommands:
 
 `size`:
-    prints the total size of `.stack-work/` or `~/.stack/`
+    prints the total size of `.stack-work/` of project(s) or the *Stack Root location*.
     (`size` does not take a GHCVER argument).
 
 `list`:
diff --git a/src/Directories.hs b/src/Directories.hs
index 0b825ed..5fc3be9 100644
--- a/src/Directories.hs
+++ b/src/Directories.hs
@@ -8,6 +8,7 @@ where
 import Data.List.Extra
 import SimpleCmd (error')
 import System.Directory
+import System.Environment
 import System.FilePath
 import System.FilePath.Glob
 
@@ -15,10 +16,18 @@ globDirs :: String -> IO [FilePath]
 globDirs pat = do
   map (dropPrefix "./") <$> namesMatching (pat ++ "/")
 
+getStackRootDir :: IO FilePath
+getStackRootDir = do
+  home <- getHomeDirectory
+  env <- lookupEnv "STACK_ROOT"
+  case env of
+    Just path | isAbsolute path -> return path
+    _                           -> return $ home </> ".stack"
+
 getStackSubdir :: FilePath -> IO FilePath
 getStackSubdir subdir = do
-  home <- getHomeDirectory
-  return $ home </> ".stack" </> subdir
+  stackRoot <- getStackRootDir
+  return $ stackRoot </> subdir
 
 switchToSystemDirUnder :: Maybe String -> FilePath -> IO ()
 switchToSystemDirUnder msystem dir = do

From b0208b9eaf78bd4253479ed53ff1d8ef9f313c82 Mon Sep 17 00:00:00 2001
From: PRESFIL <PRESFIL@users.noreply.github.com>
Date: Thu, 12 Jan 2023 20:45:17 +0000
Subject: [PATCH 2/2] chore: Update `~/.stack` in arg parse help

---
 src/Main.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 90b302f..6509e3e 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -72,9 +72,9 @@ main = do
   where
     modeOpt =
       flagWith' Project 'P' "project" "Act on current project's .stack-work/ [default in project dir]" <|>
-      flagWith' GHC 'G' "global" "Act on both ~/.stack/{programs,snapshots}/ [default outside project dir]" <|>
-      flagWith' Snapshots 'S' "snapshots" "Act on ~/.stack/snapshots/" <|>
-      flagWith Default Compilers 'C' "compilers" "Act on ~/.stack/programs/"
+      flagWith' GHC 'G' "global" "Act on both ${STACK_ROOT}/{programs,snapshots}/ [default outside project dir]" <|>
+      flagWith' Snapshots 'S' "snapshots" "Act on ${STACK_ROOT}/snapshots/" <|>
+      flagWith Default Compilers 'C' "compilers" "Act on ${STACK_ROOT}/programs/"
 
     deleteOpt = flagWith Dryrun Delete 'd' "delete" "Do deletion [default is dryrun]"