got configure working after Utility.Path ByteString conversion
Had to split out some modules because getWorkingDirectory needs unix, which is not a build-dep of configure. This commit was sponsored by Brock Spratlen on Patreon.
This commit is contained in:
parent
e219aadbab
commit
d6e94a6b2e
10 changed files with 301 additions and 231 deletions
|
@ -22,40 +22,6 @@ userConfigFile file = do
|
|||
autoStartFile :: IO FilePath
|
||||
autoStartFile = userConfigFile "autostart"
|
||||
|
||||
{- Returns anything listed in the autostart file (which may not exist). -}
|
||||
readAutoStartFile :: IO [FilePath]
|
||||
readAutoStartFile = do
|
||||
f <- autoStartFile
|
||||
filter valid . nub . map dropTrailingPathSeparator . lines
|
||||
<$> catchDefaultIO "" (readFile f)
|
||||
where
|
||||
-- Ignore any relative paths; some old buggy versions added eg "."
|
||||
valid = isAbsolute
|
||||
|
||||
modifyAutoStartFile :: ([FilePath] -> [FilePath]) -> IO ()
|
||||
modifyAutoStartFile func = do
|
||||
dirs <- readAutoStartFile
|
||||
let dirs' = nubBy equalFilePath $ func dirs
|
||||
when (dirs' /= dirs) $ do
|
||||
f <- autoStartFile
|
||||
createDirectoryIfMissing True (parentDir f)
|
||||
viaTmp writeFile f $ unlines dirs'
|
||||
|
||||
{- Adds a directory to the autostart file. If the directory is already
|
||||
- present, it's moved to the top, so it will be used as the default
|
||||
- when opening the webapp. -}
|
||||
addAutoStartFile :: FilePath -> IO ()
|
||||
addAutoStartFile path = do
|
||||
path' <- absPath path
|
||||
modifyAutoStartFile $ (:) path'
|
||||
|
||||
{- Removes a directory from the autostart file. -}
|
||||
removeAutoStartFile :: FilePath -> IO ()
|
||||
removeAutoStartFile path = do
|
||||
path' <- absPath path
|
||||
modifyAutoStartFile $
|
||||
filter (not . equalFilePath path')
|
||||
|
||||
{- The path to git-annex is written here; which is useful when something
|
||||
- has installed it to some awful non-PATH location. -}
|
||||
programFile :: IO FilePath
|
||||
|
|
50
Config/Files/AutoStart.hs
Normal file
50
Config/Files/AutoStart.hs
Normal file
|
@ -0,0 +1,50 @@
|
|||
{- git-annex autostart file
|
||||
-
|
||||
- Copyright 2012-2019 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
||||
|
||||
module Config.Files.AutoStart where
|
||||
|
||||
import Common
|
||||
import Config.Files
|
||||
import Utility.Tmp
|
||||
import Utility.FreeDesktop
|
||||
import Utility.Directory.AbsRel
|
||||
|
||||
{- Returns anything listed in the autostart file (which may not exist). -}
|
||||
readAutoStartFile :: IO [FilePath]
|
||||
readAutoStartFile = do
|
||||
f <- autoStartFile
|
||||
filter valid . nub . map dropTrailingPathSeparator . lines
|
||||
<$> catchDefaultIO "" (readFile f)
|
||||
where
|
||||
-- Ignore any relative paths; some old buggy versions added eg "."
|
||||
valid = isAbsolute
|
||||
|
||||
modifyAutoStartFile :: ([FilePath] -> [FilePath]) -> IO ()
|
||||
modifyAutoStartFile func = do
|
||||
dirs <- readAutoStartFile
|
||||
let dirs' = nubBy equalFilePath $ func dirs
|
||||
when (dirs' /= dirs) $ do
|
||||
f <- autoStartFile
|
||||
createDirectoryIfMissing True (parentDir f)
|
||||
viaTmp writeFile f $ unlines dirs'
|
||||
|
||||
{- Adds a directory to the autostart file. If the directory is already
|
||||
- present, it's moved to the top, so it will be used as the default
|
||||
- when opening the webapp. -}
|
||||
addAutoStartFile :: FilePath -> IO ()
|
||||
addAutoStartFile path = do
|
||||
path' <- absPath path
|
||||
modifyAutoStartFile $ (:) path'
|
||||
|
||||
{- Removes a directory from the autostart file. -}
|
||||
removeAutoStartFile :: FilePath -> IO ()
|
||||
removeAutoStartFile path = do
|
||||
path' <- absPath path
|
||||
modifyAutoStartFile $
|
||||
filter (not . equalFilePath path')
|
Loading…
Add table
Add a link
Reference in a new issue