git-annex/Assistant/WebApp/OtherRepos.hs

36 lines
1 KiB
Haskell

{- git-annex assistant webapp switching to other repos
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- 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
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 doesDirectoryExist $
filter (\d -> not $ d `dirContains` pwd) dirs
names <- mapM relHome gooddirs
return $ sort $ zip names gooddirs
getSwitchToRepositoryR :: FilePath -> Handler Html
getSwitchToRepositoryR repo = do
liftIO $ addAutoStartFile repo -- make this the new default repo
redirect =<< liftIO (newAssistantUrl repo)