better ~/ handling

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
+		getreldir (Just st) = Just <$>
-			dir <- absPath =<< runThreadState st (fromRepo repoPath)
+			(relHome =<< absPath
-			home <- myHomeDir
+				=<< runThreadState st (fromRepo repoPath))
-			return $ Just $ if dirContains home dir
-				then relPathDirToFile home dir
-				else dir
 		go port webapp htmlshim = do
 			writeHtmlShim webapp port htmlshim
 			maybe noop (\a -> a (myUrl webapp port "/") htmlshim) onstartup

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)

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