diff options
| -rw-r--r-- | Assistant/Threads/WebApp.hs | 9 | ||||
| -rw-r--r-- | Assistant/WebApp/Configurators.hs | 1 | ||||
| -rw-r--r-- | Utility/Path.hs | 8 |
3 files changed, 12 insertions, 6 deletions
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs index e8de408a1..7ea7314e0 100644 --- a/Assistant/Threads/WebApp.hs +++ b/Assistant/Threads/WebApp.hs @@ -64,12 +64,9 @@ webAppThread mst dstatus transferqueue postfirstrun onstartup = do Just st -> go port webapp =<< runThreadState st (fromRepo gitAnnexHtmlShim) where getreldir Nothing = return Nothing - getreldir (Just st) = do - dir <- absPath =<< runThreadState st (fromRepo repoPath) - home <- myHomeDir - return $ Just $ if dirContains home dir - then relPathDirToFile home dir - else dir + getreldir (Just st) = Just <$> + (relHome =<< absPath + =<< runThreadState st (fromRepo repoPath)) go port webapp htmlshim = do writeHtmlShim webapp port htmlshim maybe noop (\a -> a (myUrl webapp port "/") htmlshim) onstartup diff --git a/Assistant/WebApp/Configurators.hs b/Assistant/WebApp/Configurators.hs index 1c7ea7cf4..08a1f60d3 100644 --- a/Assistant/WebApp/Configurators.hs +++ b/Assistant/WebApp/Configurators.hs @@ -22,6 +22,7 @@ import qualified Git.Construct import qualified Git.Config import qualified Annex import Locations.UserConfig +import Utility.FreeDesktop import Yesod import Data.Text (Text) diff --git a/Utility/Path.hs b/Utility/Path.hs index 76fbc6c4a..209ff1b0f 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -132,6 +132,14 @@ runPreserveOrder a files = preserveOrder files <$> a files myHomeDir :: IO FilePath myHomeDir = homeDirectory <$> (getUserEntryForID =<< getEffectiveUserID) +{- Converts paths in the home directory to use ~/ -} +relHome :: FilePath -> IO String +relHome path = do + home <- myHomeDir + return $ if dirContains home path + then "~/" ++ relPathDirToFile home path + else path + {- Checks if a command is available in PATH. -} inPath :: String -> IO Bool inPath command = getSearchPath >>= anyM indir |