mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

simplify

Browse source
This commit is contained in:
Joey Hess 2012-11-25 00:38:11 -04:00
parent 59733456ed
commit 3dfc9cadb0
20 changed files with 28 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

13
Assistant/WebApp.hs
View file

@ -11,13 +11,11 @@ module Assistant.WebApp where
import Assistant.WebApp.Types import Assistant.WebApp.Types
import Assistant.Common import Assistant.Common
import Assistant.Alert
import Utility.NotificationBroadcaster import Utility.NotificationBroadcaster
import Utility.Yesod import Utility.Yesod
import Locations.UserConfig import Locations.UserConfig
import Yesod import Yesod
import Text.Hamlet
import Data.Text (Text) import Data.Text (Text)
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent import Control.Concurrent
@ -115,14 +113,3 @@ listOtherRepos = do
dirs <- nub <$> ifM (doesFileExist f) ( lines <$> readFile f, return []) dirs <- nub <$> ifM (doesFileExist f) ( lines <$> readFile f, return [])
names <- mapM relHome dirs names <- mapM relHome dirs
return $ sort $ zip names dirs return $ sort $ zip names dirs
htmlIcon :: AlertIcon -> GWidget sub master ()
htmlIcon ActivityIcon = bootstrapIcon "refresh"
htmlIcon InfoIcon = bootstrapIcon "info-sign"
htmlIcon SuccessIcon = bootstrapIcon "ok"
htmlIcon ErrorIcon = bootstrapIcon "exclamation-sign"
-- utf-8 umbrella (utf-8 cloud looks too stormy)
htmlIcon TheCloud = [whamlet|&#9730;|]
bootstrapIcon :: Text -> GWidget sub master ()
bootstrapIcon name = [whamlet|<i .icon-#{name}></i>|]

9
Assistant/WebApp/Configurators/AWS.hs
View file

@ -102,9 +102,7 @@ getAddS3R = awsConfigurator $ do
, ("datacenter", T.unpack $ datacenter input) , ("datacenter", T.unpack $ datacenter input)
, ("storageclass", show $ storageClass input) , ("storageclass", show $ storageClass input)
] ]
_ -> do _ -> $(widgetFile "configurators/adds3")
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/adds3")
where where
setgroup r = runAnnex () $ setgroup r = runAnnex () $
setStandardGroup (Remote.uuid r) TransferGroup setStandardGroup (Remote.uuid r) TransferGroup
@ -124,9 +122,7 @@ getAddGlacierR = glacierConfigurator $ do
, ("type", "glacier") , ("type", "glacier")
, ("datacenter", T.unpack $ datacenter input) , ("datacenter", T.unpack $ datacenter input)
] ]
_ -> do _ -> $(widgetFile "configurators/addglacier")
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/addglacier")
where where
setgroup r = runAnnex () $ setgroup r = runAnnex () $
setStandardGroup (Remote.uuid r) SmallArchiveGroup setStandardGroup (Remote.uuid r) SmallArchiveGroup
@ -152,7 +148,6 @@ enableAWSRemote remotetype uuid = do
fromJust $ M.lookup uuid m fromJust $ M.lookup uuid m
makeAWSRemote remotetype creds name (const noop) M.empty makeAWSRemote remotetype creds name (const noop) M.empty
_ -> do _ -> do
let authtoken = webAppFormAuthToken
description <- lift $ runAnnex "" $ description <- lift $ runAnnex "" $
T.pack . concat <$> Remote.prettyListUUIDs [uuid] T.pack . concat <$> Remote.prettyListUUIDs [uuid]
$(widgetFile "configurators/enableaws") $(widgetFile "configurators/enableaws")

1
Assistant/WebApp/Configurators/Edit.hs
View file

@ -126,7 +126,6 @@ editForm new uuid = page "Configure repository" (Just Config) $ do
where where
showform form enctype curr = do showform form enctype curr = do
let istransfer = repoGroup curr == RepoGroupStandard TransferGroup let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/editrepository") $(widgetFile "configurators/editrepository")
{- Makes a toplevel archive directory, so the user can get on with {- Makes a toplevel archive directory, so the user can get on with

4
Assistant/WebApp/Configurators/Local.hs
View file

@ -184,9 +184,7 @@ getAddDriveR = page "AAdd a removable drive" (Just Config) $ do
case res of case res of
FormSuccess (RemovableDrive { mountPoint = d }) -> lift $ FormSuccess (RemovableDrive { mountPoint = d }) -> lift $
make (T.unpack d) >>= redirect . EditNewRepositoryR make (T.unpack d) >>= redirect . EditNewRepositoryR
_ -> do _ -> $(widgetFile "configurators/adddrive")
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/adddrive")
where where
make mountpoint = do make mountpoint = do
liftIO $ makerepo dir liftIO $ makerepo dir

1
Assistant/WebApp/Configurators/Pairing.hs
View file

@ -259,7 +259,6 @@ promptSecret msg cont = pairPage $ do
(verifiableVal . fromPairMsg <$> msg) (verifiableVal . fromPairMsg <$> msg)
u <- T.pack <$> liftIO myUserName u <- T.pack <$> liftIO myUserName
let sameusername = username == u let sameusername = username == u
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/pairing/local/prompt") $(widgetFile "configurators/pairing/local/prompt")
{- This counts unicode characters as more than one character, {- This counts unicode characters as more than one character,

8
Assistant/WebApp/Configurators/Ssh.hs
View file

@ -100,9 +100,7 @@ getAddSshR = sshConfigurator $ do
Right sshdata -> lift $ redirect $ ConfirmSshR sshdata Right sshdata -> lift $ redirect $ ConfirmSshR sshdata
_ -> showform form enctype UntestedServer _ -> showform form enctype UntestedServer
where where
showform form enctype status = do showform form enctype status = $(widgetFile "configurators/ssh/add")
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/ssh/add")
{- To enable an existing rsync special remote, parse the SshInput from {- To enable an existing rsync special remote, parse the SshInput from
- its rsyncurl, and display a form whose only real purpose is to check - its rsyncurl, and display a form whose only real purpose is to check
@ -135,7 +133,6 @@ getEnableRsyncR u = do
showform form enctype status = do showform form enctype status = do
description <- lift $ runAnnex "" $ description <- lift $ runAnnex "" $
T.pack . concat <$> prettyListUUIDs [u] T.pack . concat <$> prettyListUUIDs [u]
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/ssh/enable") $(widgetFile "configurators/ssh/enable")
enable sshdata = lift $ redirect $ ConfirmSshR $ enable sshdata = lift $ redirect $ ConfirmSshR $
sshdata { rsyncOnly = True } sshdata { rsyncOnly = True }
@ -237,8 +234,7 @@ showSshErr msg = sshConfigurator $
$(widgetFile "configurators/ssh/error") $(widgetFile "configurators/ssh/error")
getConfirmSshR :: SshData -> Handler RepHtml getConfirmSshR :: SshData -> Handler RepHtml
getConfirmSshR sshdata = sshConfigurator $ do getConfirmSshR sshdata = sshConfigurator $
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/ssh/confirm") $(widgetFile "configurators/ssh/confirm")
getMakeSshGitR :: SshData -> Handler RepHtml getMakeSshGitR :: SshData -> Handler RepHtml

5
Assistant/WebApp/Configurators/WebDAV.hs
View file

@ -62,9 +62,7 @@ getAddBoxComR = boxConfigurator $ do
-- performance. -- performance.
, ("chunksize", "10mb") , ("chunksize", "10mb")
] ]
_ -> do _ -> $(widgetFile "configurators/addbox.com")
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/addbox.com")
where where
setgroup r = runAnnex () $ setgroup r = runAnnex () $
setStandardGroup (Remote.uuid r) TransferGroup setStandardGroup (Remote.uuid r) TransferGroup
@ -88,7 +86,6 @@ getEnableWebDAVR uuid = do
FormSuccess creds -> lift $ FormSuccess creds -> lift $
makeWebDavRemote name creds (const noop) M.empty makeWebDavRemote name creds (const noop) M.empty
_ -> do _ -> do
let authtoken = webAppFormAuthToken
description <- lift $ runAnnex "" $ description <- lift $ runAnnex "" $
T.pack . concat <$> Remote.prettyListUUIDs [uuid] T.pack . concat <$> Remote.prettyListUUIDs [uuid]
$(widgetFile "configurators/enablewebdav") $(widgetFile "configurators/enablewebdav")

4
Assistant/WebApp/Configurators/XMPP.hs
View file

@ -70,9 +70,7 @@ getXMPPR' redirto = xmppPage $ do
oldcreds <- runAnnex Nothing getXMPPCreds oldcreds <- runAnnex Nothing getXMPPCreds
runFormGet $ renderBootstrap $ xmppAForm $ runFormGet $ renderBootstrap $ xmppAForm $
creds2Form <$> oldcreds creds2Form <$> oldcreds
let showform problem = do let showform problem = $(widgetFile "configurators/xmpp")
let authtoken = webAppFormAuthToken
$(widgetFile "configurators/xmpp")
case result of case result of
FormSuccess f -> either (showform . Just . show) (lift . storecreds) FormSuccess f -> either (showform . Just . show) (lift . storecreds)
=<< liftIO (validateForm f) =<< liftIO (validateForm f)

10
Assistant/WebApp/SideBar.hs
View file

@ -88,3 +88,13 @@ getClickAlert i = do
redirect $ buttonUrl b redirect $ buttonUrl b
_ -> redirectBack _ -> redirectBack
htmlIcon :: AlertIcon -> GWidget sub master ()
htmlIcon ActivityIcon = bootstrapIcon "refresh"
htmlIcon InfoIcon = bootstrapIcon "info-sign"
htmlIcon SuccessIcon = bootstrapIcon "ok"
htmlIcon ErrorIcon = bootstrapIcon "exclamation-sign"
-- utf-8 umbrella (utf-8 cloud looks too stormy)
htmlIcon TheCloud = [whamlet|&#9730;|]
bootstrapIcon :: Text -> GWidget sub master ()
bootstrapIcon name = [whamlet|<i .icon-#{name}></i>|]

2
templates/configurators/addbox.com.hamlet
View file

@ -13,7 +13,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Add repository Add repository

2
templates/configurators/adddrive.hamlet
View file

@ -25,7 +25,7 @@
<form enctype=#{enctype}> <form enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<button .btn .btn-primary type=submit onclick="$('#clonemodal').modal('show');">Use this drive</button> # <button .btn .btn-primary type=submit onclick="$('#clonemodal').modal('show');">Use this drive</button> #
<a .btn href="@{AddDriveR}"> <a .btn href="@{AddDriveR}">
Rescan for removable drives Rescan for removable drives

2
templates/configurators/addglacier.hamlet
View file

@ -27,7 +27,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Add Glacier repository Add Glacier repository

2
templates/configurators/adds3.hamlet
View file

@ -25,7 +25,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Add S3 repository Add S3 repository

2
templates/configurators/editrepository.hamlet
View file

@ -16,7 +16,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit> <button .btn .btn-primary type=submit>
Save Changes Save Changes

2
templates/configurators/enableaws.hamlet
View file

@ -17,7 +17,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Enable Amazon repository Enable Amazon repository

2
templates/configurators/enablewebdav.hamlet
View file

@ -9,7 +9,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Enable repository Enable repository

2
templates/configurators/pairing/local/prompt.hamlet
View file

@ -29,7 +29,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit> <button .btn .btn-primary type=submit>
$if start $if start

2
templates/configurators/ssh/add.hamlet
View file

@ -19,7 +19,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');"> <button .btn .btn-primary type=submit onclick="$('#testmodal').modal('show');">
Check this server Check this server

2
templates/configurators/ssh/enable.hamlet
View file

@ -18,7 +18,7 @@
<i .icon-warning-sign></i> #{msg} <i .icon-warning-sign></i> #{msg}
$of _ $of _
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .modal .fade #testmodal> <div .modal .fade #testmodal>
<div .modal-header> <div .modal-header>
<h3> <h3>

2
templates/configurators/xmpp.hamlet
View file

@ -21,7 +21,7 @@
<form .form-horizontal enctype=#{enctype}> <form .form-horizontal enctype=#{enctype}>
<fieldset> <fieldset>
^{form} ^{form}
^{authtoken} ^{webAppFormAuthToken}
<div .form-actions> <div .form-actions>
<button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');"> <button .btn .btn-primary type=submit onclick="$('#workingmodal').modal('show');">
Use this account Use this account