{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils.Dirs
( getDirs
, ghcupConfigFile
, ghcupGHCBaseDir
, ghcupGHCDir
, mkGhcupTmpDir
, parseGHCupGHCDir
, relativeSymlink
, withGHCupTmpDir
)
where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.JSON ( )
import GHCup.Utils.MegaParsec
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.Bifunctor
import Data.ByteString ( ByteString )
import Data.Maybe
import GHC.IO.Exception ( IOErrorType(NoSuchThing) )
import Haskus.Utils.Variant.Excepts
import HPath
import HPath.IO
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import System.Posix.Env.ByteString ( getEnv
, getEnvDefault
)
import System.Posix.FilePath hiding ( (</>) )
import System.Posix.Temp.ByteString ( mkdtemp )
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y
import qualified System.Posix.FilePath as FP
import qualified System.Posix.User as PU
import qualified Text.Megaparsec as MP
ghcupBaseDir :: IO (Path Abs)
ghcupBaseDir :: IO (Path Abs)
ghcupBaseDir = do
Bool
xdg <- IO Bool
useXDG
if Bool
xdg
then do
Path Abs
bdir <- ByteString -> IO (Maybe ByteString)
getEnv ByteString
"XDG_DATA_HOME" IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ByteString
r -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
r
Maybe ByteString
Nothing -> do
Path Abs
home <- IO (Path Abs) -> IO (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
getHomeDirectory
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
home Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|.local/share|])
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|ghcup|])
else do
Path Abs
bdir <- ByteString -> IO (Maybe ByteString)
getEnv ByteString
"GHCUP_INSTALL_BASE_PREFIX" IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ByteString
r -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
r
Maybe ByteString
Nothing -> IO (Path Abs) -> IO (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
getHomeDirectory
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|.ghcup|])
ghcupConfigDir :: IO (Path Abs)
ghcupConfigDir :: IO (Path Abs)
ghcupConfigDir = do
Bool
xdg <- IO Bool
useXDG
if Bool
xdg
then do
Path Abs
bdir <- ByteString -> IO (Maybe ByteString)
getEnv ByteString
"XDG_CONFIG_HOME" IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ByteString
r -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
r
Maybe ByteString
Nothing -> do
Path Abs
home <- IO (Path Abs) -> IO (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
getHomeDirectory
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
home Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|.config|])
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|ghcup|])
else do
Path Abs
bdir <- ByteString -> IO (Maybe ByteString)
getEnv ByteString
"GHCUP_INSTALL_BASE_PREFIX" IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ByteString
r -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
r
Maybe ByteString
Nothing -> IO (Path Abs) -> IO (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
getHomeDirectory
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|.ghcup|])
ghcupBinDir :: IO (Path Abs)
ghcupBinDir :: IO (Path Abs)
ghcupBinDir = do
Bool
xdg <- IO Bool
useXDG
if Bool
xdg
then do
ByteString -> IO (Maybe ByteString)
getEnv ByteString
"XDG_BIN_HOME" IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ByteString
r -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
r
Maybe ByteString
Nothing -> do
Path Abs
home <- IO (Path Abs) -> IO (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
getHomeDirectory
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
home Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|.local/bin|])
else IO (Path Abs)
ghcupBaseDir IO (Path Abs) -> (Path Abs -> Path Abs) -> IO (Path Abs)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|bin|])
ghcupCacheDir :: IO (Path Abs)
ghcupCacheDir :: IO (Path Abs)
ghcupCacheDir = do
Bool
xdg <- IO Bool
useXDG
if Bool
xdg
then do
Path Abs
bdir <- ByteString -> IO (Maybe ByteString)
getEnv ByteString
"XDG_CACHE_HOME" IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ByteString
r -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
r
Maybe ByteString
Nothing -> do
Path Abs
home <- IO (Path Abs) -> IO (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
getHomeDirectory
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
home Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|.cache|])
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|ghcup|])
else IO (Path Abs)
ghcupBaseDir IO (Path Abs) -> (Path Abs -> Path Abs) -> IO (Path Abs)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cache|])
ghcupLogsDir :: IO (Path Abs)
ghcupLogsDir :: IO (Path Abs)
ghcupLogsDir = do
Bool
xdg <- IO Bool
useXDG
if Bool
xdg
then do
Path Abs
bdir <- ByteString -> IO (Maybe ByteString)
getEnv ByteString
"XDG_CACHE_HOME" IO (Maybe ByteString)
-> (Maybe ByteString -> IO (Path Abs)) -> IO (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just ByteString
r -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
r
Maybe ByteString
Nothing -> do
Path Abs
home <- IO (Path Abs) -> IO (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
getHomeDirectory
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
home Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|.cache|])
Path Abs -> IO (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|ghcup/logs|])
else IO (Path Abs)
ghcupBaseDir IO (Path Abs) -> (Path Abs -> Path Abs) -> IO (Path Abs)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|logs|])
getDirs :: IO Dirs
getDirs :: IO Dirs
getDirs = do
Path Abs
baseDir <- IO (Path Abs)
ghcupBaseDir
Path Abs
binDir <- IO (Path Abs)
ghcupBinDir
Path Abs
cacheDir <- IO (Path Abs)
ghcupCacheDir
Path Abs
logsDir <- IO (Path Abs)
ghcupLogsDir
Path Abs
confDir <- IO (Path Abs)
ghcupConfigDir
Dirs -> IO Dirs
forall (f :: * -> *) a. Applicative f => a -> f a
pure Dirs :: Path Abs -> Path Abs -> Path Abs -> Path Abs -> Path Abs -> Dirs
Dirs { Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
.. }
ghcupConfigFile :: (MonadIO m)
=> Excepts '[JSONError] m UserSettings
ghcupConfigFile :: Excepts '[JSONError] m UserSettings
ghcupConfigFile = do
Path Abs
confDir <- IO (Path Abs) -> Excepts '[JSONError] m (Path Abs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs)
ghcupConfigDir
let file :: Path Abs
file = Path Abs
confDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|config.yaml|]
Maybe ByteString
bs <- IO (Maybe ByteString) -> Excepts '[JSONError] m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString)
-> Excepts '[JSONError] m (Maybe ByteString))
-> IO (Maybe ByteString)
-> Excepts '[JSONError] m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> (IOException -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
-> IO (Maybe ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
NoSuchThing (\IOException
_ -> Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing) (IO (Maybe ByteString) -> IO (Maybe ByteString))
-> IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile Path Abs
file
case Maybe ByteString
bs of
Maybe ByteString
Nothing -> UserSettings -> Excepts '[JSONError] m UserSettings
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserSettings
defaultUserSettings
Just ByteString
bs' -> (String -> JSONError)
-> Either String UserSettings
-> Excepts '[JSONError] m UserSettings
forall e' e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
(e' -> e) -> Either e' a -> Excepts es m a
lE' String -> JSONError
JSONDecodeError (Either String UserSettings -> Excepts '[JSONError] m UserSettings)
-> (ByteString -> Either String UserSettings)
-> ByteString
-> Excepts '[JSONError] m UserSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseException -> String)
-> Either ParseException UserSettings -> Either String UserSettings
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> String
forall a. Show a => a -> String
show (Either ParseException UserSettings -> Either String UserSettings)
-> (ByteString -> Either ParseException UserSettings)
-> ByteString
-> Either String UserSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ParseException UserSettings
forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' (ByteString -> Either ParseException UserSettings)
-> (ByteString -> ByteString)
-> ByteString
-> Either ParseException UserSettings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict (ByteString -> Excepts '[JSONError] m UserSettings)
-> ByteString -> Excepts '[JSONError] m UserSettings
forall a b. (a -> b) -> a -> b
$ ByteString
bs'
ghcupGHCBaseDir :: (MonadReader AppState m) => m (Path Abs)
ghcupGHCBaseDir :: m (Path Abs)
ghcupGHCBaseDir = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
Path Abs -> m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
baseDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|ghc|])
ghcupGHCDir :: (MonadReader AppState m, MonadThrow m)
=> GHCTargetVersion
-> m (Path Abs)
ghcupGHCDir :: GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
ver = do
Path Abs
ghcbasedir <- m (Path Abs)
forall (m :: * -> *). MonadReader AppState m => m (Path Abs)
ghcupGHCBaseDir
Path Rel
verdir <- ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString -> m (Path Rel)) -> ByteString -> m (Path Rel)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 (GHCTargetVersion -> Text
tVerToText GHCTargetVersion
ver)
Path Abs -> m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
ghcbasedir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
verdir)
parseGHCupGHCDir :: MonadThrow m => Path Rel -> m GHCTargetVersion
parseGHCupGHCDir :: Path Rel -> m GHCTargetVersion
parseGHCupGHCDir (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath -> ByteString
f) = do
Text
fp <- Either UnicodeException Text -> m Text
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either UnicodeException Text -> m Text)
-> Either UnicodeException Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
E.decodeUtf8' ByteString
f
Either (ParseErrorBundle Text Void) GHCTargetVersion
-> m GHCTargetVersion
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either (ParseErrorBundle Text Void) GHCTargetVersion
-> m GHCTargetVersion)
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
-> m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ Parsec Void Text GHCTargetVersion
-> String
-> Text
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text GHCTargetVersion
ghcTargetVerP String
"" Text
fp
mkGhcupTmpDir :: (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir :: m (Path Abs)
mkGhcupTmpDir = do
ByteString
tmpdir <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> IO ByteString
getEnvDefault ByteString
"TMPDIR" ByteString
"/tmp"
ByteString
tmp <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
mkdtemp (ByteString
tmpdir ByteString -> ByteString -> ByteString
FP.</> ByteString
"ghcup-")
ByteString -> m (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
tmp
withGHCupTmpDir :: (MonadResource m, MonadThrow m, MonadIO m) => m (Path Abs)
withGHCupTmpDir :: m (Path Abs)
withGHCupTmpDir = (ReleaseKey, Path Abs) -> Path Abs
forall a b. (a, b) -> b
snd ((ReleaseKey, Path Abs) -> Path Abs)
-> m (ReleaseKey, Path Abs) -> m (Path Abs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Path Abs) -> (Path Abs -> IO ()) -> m (ReleaseKey, Path Abs)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate IO (Path Abs)
forall (m :: * -> *). (MonadThrow m, MonadIO m) => m (Path Abs)
mkGhcupTmpDir Path Abs -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive
getHomeDirectory :: IO (Path Abs)
getHomeDirectory :: IO (Path Abs)
getHomeDirectory = do
Maybe ByteString
e <- ByteString -> IO (Maybe ByteString)
getEnv ByteString
"HOME"
case Maybe ByteString
e of
Just ByteString
fp -> ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ByteString
fp
Maybe ByteString
Nothing -> do
String
h <- UserEntry -> String
PU.homeDirectory (UserEntry -> String) -> IO UserEntry -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO UserID
PU.getEffectiveUserID IO UserID -> (UserID -> IO UserEntry) -> IO UserEntry
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserID -> IO UserEntry
PU.getUserEntryForID)
ByteString -> IO (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs (ByteString -> IO (Path Abs)) -> ByteString -> IO (Path Abs)
forall a b. (a -> b) -> a -> b
$ String -> ByteString
UTF8.fromString String
h
useXDG :: IO Bool
useXDG :: IO Bool
useXDG = Maybe ByteString -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ByteString -> Bool) -> IO (Maybe ByteString) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> IO (Maybe ByteString)
getEnv ByteString
"GHCUP_USE_XDG_DIRS"
relativeSymlink :: Path Abs
-> Path Abs
-> ByteString
relativeSymlink :: Path Abs -> Path Abs -> ByteString
relativeSymlink (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath -> ByteString
p1) (Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath -> ByteString
p2) =
let d1 :: [ByteString]
d1 = ByteString -> [ByteString]
splitDirectories ByteString
p1
d2 :: [ByteString]
d2 = ByteString -> [ByteString]
splitDirectories ByteString
p2
common :: [(ByteString, ByteString)]
common = ((ByteString, ByteString) -> Bool)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(ByteString
x, ByteString
y) -> ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
y) ([(ByteString, ByteString)] -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString] -> [(ByteString, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString]
d1 [ByteString]
d2
cPrefix :: [ByteString]
cPrefix = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop ([(ByteString, ByteString)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ByteString, ByteString)]
common) [ByteString]
d1
in [ByteString] -> ByteString
joinPath (Int -> ByteString -> [ByteString]
forall a. Int -> a -> [a]
replicate ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
cPrefix) ByteString
"..")
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
joinPath (ByteString
"/" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop ([(ByteString, ByteString)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ByteString, ByteString)]
common) [ByteString]
d2)