ghcup-hs/lib/GHCup/Utils/Dirs.hs

92 lines
2.6 KiB
Haskell
Raw Normal View History

2020-03-21 21:19:37 +00:00
{-# LANGUAGE OverloadedStrings #-}
2020-01-11 20:15:05 +00:00
{-# LANGUAGE QuasiQuotes #-}
module GHCup.Utils.Dirs where
import GHCup.Types.JSON ( )
import GHCup.Utils.Prelude
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Maybe
import Data.Versions
import HPath
import HPath.IO
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import System.Posix.Env.ByteString ( getEnv
, getEnvDefault
)
import System.Posix.Temp.ByteString ( mkdtemp )
import qualified Data.ByteString.UTF8 as UTF8
import qualified System.Posix.FilePath as FP
import qualified System.Posix.User as PU
-------------------------
--[ GHCup directories ]--
-------------------------
ghcupBaseDir :: IO (Path Abs)
ghcupBaseDir = do
2020-03-21 21:19:37 +00:00
getEnv "GHCUP_INSTALL_BASE_PREFIX" >>= \case
2020-01-11 20:15:05 +00:00
Just r -> parseAbs r
Nothing -> do
home <- liftIO getHomeDirectory
2020-03-16 09:47:09 +00:00
pure (home </> [rel|.ghcup|])
2020-01-11 20:15:05 +00:00
ghcupGHCBaseDir :: IO (Path Abs)
2020-03-16 09:47:09 +00:00
ghcupGHCBaseDir = ghcupBaseDir <&> (</> [rel|ghc|])
2020-01-11 20:15:05 +00:00
ghcupGHCDir :: Version -> IO (Path Abs)
ghcupGHCDir ver = do
ghcbasedir <- ghcupGHCBaseDir
verdir <- parseRel (verToBS ver)
pure (ghcbasedir </> verdir)
ghcupBinDir :: IO (Path Abs)
2020-03-16 09:47:09 +00:00
ghcupBinDir = ghcupBaseDir <&> (</> [rel|bin|])
2020-01-11 20:15:05 +00:00
ghcupCacheDir :: IO (Path Abs)
2020-03-16 09:47:09 +00:00
ghcupCacheDir = ghcupBaseDir <&> (</> [rel|cache|])
2020-01-11 20:15:05 +00:00
ghcupLogsDir :: IO (Path Abs)
2020-03-16 09:47:09 +00:00
ghcupLogsDir = ghcupBaseDir <&> (</> [rel|logs|])
2020-01-11 20:15:05 +00:00
mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir = do
2020-03-21 21:19:37 +00:00
tmpdir <- liftIO $ getEnvDefault "TMPDIR" "/tmp"
tmp <- liftIO $ mkdtemp $ (tmpdir FP.</> "ghcup-")
2020-01-11 20:15:05 +00:00
parseAbs tmp
withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
withGHCupTmpDir = snd <$> allocate mkGhcupTmpDir deleteDirRecursive
--------------
--[ Others ]--
--------------
getHomeDirectory :: IO (Path Abs)
getHomeDirectory = do
2020-03-21 21:19:37 +00:00
e <- getEnv "HOME"
2020-01-11 20:15:05 +00:00
case e of
Just fp -> parseAbs fp
Nothing -> do
h <- PU.homeDirectory <$> (PU.getEffectiveUserID >>= PU.getUserEntryForID)
parseAbs $ UTF8.fromString h -- this is a guess