c730d00b6e
Builds with and without OsPath build flag. Unfortunately, the test suite fails. Sponsored-by: unqueued on Patreon
39 lines
1.2 KiB
Haskell
39 lines
1.2 KiB
Haskell
{- git-annex assistant webapp switching to other repos
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
|
|
|
|
module Assistant.WebApp.OtherRepos where
|
|
|
|
import Assistant.Common
|
|
import Assistant.WebApp.Types
|
|
import Assistant.WebApp.Page
|
|
import Config.Files.AutoStart
|
|
import Utility.Yesod
|
|
import Assistant.Restart
|
|
|
|
getRepositorySwitcherR :: Handler Html
|
|
getRepositorySwitcherR = page "Switch repository" Nothing $ do
|
|
repolist <- liftIO listOtherRepos
|
|
$(widgetFile "control/repositoryswitcher")
|
|
|
|
listOtherRepos :: IO [(String, String)]
|
|
listOtherRepos = do
|
|
dirs <- readAutoStartFile
|
|
pwd <- getCurrentDirectory
|
|
gooddirs <- filterM isrepo $
|
|
filter (\d -> not $ d `dirContains` pwd) dirs
|
|
names <- mapM relHome gooddirs
|
|
return $ sort $ zip (map fromOsPath names) (map fromOsPath gooddirs)
|
|
where
|
|
isrepo d = doesDirectoryExist (d </> literalOsPath ".git")
|
|
|
|
getSwitchToRepositoryR :: FilePath -> Handler Html
|
|
getSwitchToRepositoryR repo = do
|
|
let repo' = toOsPath repo
|
|
liftIO $ addAutoStartFile repo' -- make this the new default repo
|
|
redirect =<< liftIO (newAssistantUrl repo')
|