add "configure" link to each repository in the webapp's repo list
This commit is contained in:
parent
a5781fd9ba
commit
b6a3f03f82
5 changed files with 67 additions and 7 deletions
|
@ -17,6 +17,7 @@ import Assistant.WebApp.DashBoard
|
||||||
import Assistant.WebApp.SideBar
|
import Assistant.WebApp.SideBar
|
||||||
import Assistant.WebApp.Notifications
|
import Assistant.WebApp.Notifications
|
||||||
import Assistant.WebApp.Configurators
|
import Assistant.WebApp.Configurators
|
||||||
|
import Assistant.WebApp.Configurators.Edit
|
||||||
import Assistant.WebApp.Configurators.Local
|
import Assistant.WebApp.Configurators.Local
|
||||||
import Assistant.WebApp.Configurators.Ssh
|
import Assistant.WebApp.Configurators.Ssh
|
||||||
import Assistant.WebApp.Configurators.Pairing
|
import Assistant.WebApp.Configurators.Pairing
|
||||||
|
|
|
@ -44,8 +44,18 @@ getRepositoriesR = bootstrap (Just Config) $ do
|
||||||
repolist <- lift $ repoList False
|
repolist <- lift $ repoList False
|
||||||
$(widgetFile "configurators/repositories")
|
$(widgetFile "configurators/repositories")
|
||||||
|
|
||||||
|
data SetupRepo = EnableRepo (Route WebApp) | EditRepo (Route WebApp)
|
||||||
|
|
||||||
|
needsEnabled :: SetupRepo -> Bool
|
||||||
|
needsEnabled (EnableRepo _) = True
|
||||||
|
needsEnabled _ = False
|
||||||
|
|
||||||
|
setupRepoLink :: SetupRepo -> Route WebApp
|
||||||
|
setupRepoLink (EnableRepo r) = r
|
||||||
|
setupRepoLink (EditRepo r) = r
|
||||||
|
|
||||||
{- A numbered list of known repositories, including the current one. -}
|
{- A numbered list of known repositories, including the current one. -}
|
||||||
repoList :: Bool -> Handler [(String, String, Maybe (Route WebApp))]
|
repoList :: Bool -> Handler [(String, String, SetupRepo)]
|
||||||
repoList onlyconfigured
|
repoList onlyconfigured
|
||||||
| onlyconfigured = list =<< configured
|
| onlyconfigured = list =<< configured
|
||||||
| otherwise = list =<< (++) <$> configured <*> unconfigured
|
| otherwise = list =<< (++) <$> configured <*> unconfigured
|
||||||
|
@ -55,7 +65,9 @@ repoList onlyconfigured
|
||||||
(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
|
(liftIO . getDaemonStatus =<< daemonStatus <$> getYesod)
|
||||||
runAnnex [] $ do
|
runAnnex [] $ do
|
||||||
u <- getUUID
|
u <- getUUID
|
||||||
return $ zip (u : map Remote.uuid rs) (repeat Nothing)
|
let l = u : map Remote.uuid rs
|
||||||
|
return $ zip l (map editlink l)
|
||||||
|
editlink = EditRepo . EditRepositoryR
|
||||||
unconfigured = runAnnex [] $ do
|
unconfigured = runAnnex [] $ do
|
||||||
m <- readRemoteLog
|
m <- readRemoteLog
|
||||||
catMaybes . map (findtype m) . snd
|
catMaybes . map (findtype m) . snd
|
||||||
|
@ -67,7 +79,7 @@ repoList onlyconfigured
|
||||||
Just "directory" -> u `enableswith` EnableDirectoryR
|
Just "directory" -> u `enableswith` EnableDirectoryR
|
||||||
Just "S3" -> u `enableswith` EnableS3R
|
Just "S3" -> u `enableswith` EnableS3R
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
u `enableswith` r = Just (u, Just $ r u)
|
u `enableswith` r = Just (u, EnableRepo $ r u)
|
||||||
list l = runAnnex [] $ do
|
list l = runAnnex [] $ do
|
||||||
let l' = nubBy (\x y -> fst x == fst y) l
|
let l' = nubBy (\x y -> fst x == fst y) l
|
||||||
zip3
|
zip3
|
||||||
|
|
43
Assistant/WebApp/Configurators/Edit.hs
Normal file
43
Assistant/WebApp/Configurators/Edit.hs
Normal file
|
@ -0,0 +1,43 @@
|
||||||
|
{- git-annex assistant webapp configurator for editing existing repos
|
||||||
|
-
|
||||||
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU AGPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
|
||||||
|
|
||||||
|
module Assistant.WebApp.Configurators.Edit where
|
||||||
|
|
||||||
|
import Assistant.Common
|
||||||
|
import Assistant.WebApp
|
||||||
|
import Assistant.WebApp.Types
|
||||||
|
import Assistant.WebApp.SideBar
|
||||||
|
import Assistant.Sync
|
||||||
|
import Assistant.MakeRemote
|
||||||
|
import Utility.Yesod
|
||||||
|
import Init
|
||||||
|
import qualified Git
|
||||||
|
import qualified Git.Construct
|
||||||
|
import qualified Git.Config
|
||||||
|
import qualified Annex
|
||||||
|
import Locations.UserConfig
|
||||||
|
import Utility.FreeDesktop
|
||||||
|
import Utility.Mounts
|
||||||
|
import Utility.DiskFree
|
||||||
|
import Utility.DataUnits
|
||||||
|
import Utility.Network
|
||||||
|
import Remote (prettyListUUIDs)
|
||||||
|
import Logs.Group
|
||||||
|
import Annex.UUID
|
||||||
|
|
||||||
|
import Yesod
|
||||||
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Data.Set as S
|
||||||
|
import Data.Char
|
||||||
|
import System.Posix.Directory
|
||||||
|
import qualified Control.Exception as E
|
||||||
|
|
||||||
|
getEditRepositoryR :: UUID -> Handler RepHtml
|
||||||
|
getEditRepositoryR u = error "TODO"
|
|
@ -10,6 +10,7 @@
|
||||||
/config/repository/new/first FirstRepositoryR GET
|
/config/repository/new/first FirstRepositoryR GET
|
||||||
/config/repository/new NewRepositoryR GET
|
/config/repository/new NewRepositoryR GET
|
||||||
/config/repository/switchto/#FilePath SwitchToRepositoryR GET
|
/config/repository/switchto/#FilePath SwitchToRepositoryR GET
|
||||||
|
/config/repository/edit/#UUID EditRepositoryR GET
|
||||||
|
|
||||||
/config/repository/add/drive AddDriveR GET
|
/config/repository/add/drive AddDriveR GET
|
||||||
/config/repository/add/ssh AddSshR GET
|
/config/repository/add/ssh AddSshR GET
|
||||||
|
|
|
@ -3,21 +3,24 @@
|
||||||
Your repositories
|
Your repositories
|
||||||
<table .table .table-condensed>
|
<table .table .table-condensed>
|
||||||
<tbody>
|
<tbody>
|
||||||
$forall (num, name, needsenabled) <- repolist
|
$forall (num, name, setuprepo) <- repolist
|
||||||
<tr>
|
<tr>
|
||||||
<td>
|
<td>
|
||||||
#{num}
|
#{num}
|
||||||
<td>
|
<td>
|
||||||
$if isJust needsenabled
|
$if needsEnabled setuprepo
|
||||||
<i>#{name}
|
<i>#{name}
|
||||||
$else
|
$else
|
||||||
#{name}
|
#{name}
|
||||||
<td>
|
<td>
|
||||||
$maybe enable <- needsenabled
|
$if needsEnabled setuprepo
|
||||||
<i>not enabled here #
|
<i>not enabled here #
|
||||||
→ #
|
→ #
|
||||||
<a href="@{enable}">
|
<a href="@{setupRepoLink setuprepo}">
|
||||||
enable
|
enable
|
||||||
|
$else
|
||||||
|
<a href="@{setupRepoLink setuprepo}">
|
||||||
|
configure
|
||||||
<div .row-fluid>
|
<div .row-fluid>
|
||||||
<div .span6>
|
<div .span6>
|
||||||
<h2>
|
<h2>
|
||||||
|
|
Loading…
Add table
Reference in a new issue