refactor
This commit is contained in:
parent
3bd354ab84
commit
59733456ed
15 changed files with 129 additions and 172 deletions
|
@ -9,13 +9,9 @@
|
|||
|
||||
module Assistant.WebApp.Configurators.AWS where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.MakeRemote
|
||||
import Assistant.Sync
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.SideBar
|
||||
import Utility.Yesod
|
||||
#ifdef WITH_S3
|
||||
import qualified Remote.S3 as S3
|
||||
#endif
|
||||
|
@ -28,15 +24,11 @@ import Types.StandardGroups
|
|||
import Logs.PreferredContent
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
||||
awsConfigurator :: Widget -> Handler RepHtml
|
||||
awsConfigurator a = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add an Amazon repository"
|
||||
a
|
||||
awsConfigurator = page "Add an Amazon repository" (Just Config)
|
||||
|
||||
glacierConfigurator :: Widget -> Handler RepHtml
|
||||
glacierConfigurator a = do
|
||||
|
|
|
@ -9,15 +9,11 @@
|
|||
|
||||
module Assistant.WebApp.Configurators.Edit where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.SideBar
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.WebApp.Utility
|
||||
import Assistant.DaemonStatus
|
||||
import Assistant.MakeRemote (uniqueRemoteName)
|
||||
import Assistant.WebApp.Configurators.XMPP (xmppNeeded)
|
||||
import Utility.Yesod
|
||||
import qualified Remote
|
||||
import qualified Remote.List as Remote
|
||||
import Logs.UUID
|
||||
|
@ -30,7 +26,6 @@ import qualified Git.Command
|
|||
import qualified Git.Config
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
@ -116,10 +111,7 @@ getEditNewCloudRepositoryR :: UUID -> Handler RepHtml
|
|||
getEditNewCloudRepositoryR uuid = xmppNeeded >> editForm True uuid
|
||||
|
||||
editForm :: Bool -> UUID -> Handler RepHtml
|
||||
editForm new uuid = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Configure repository"
|
||||
|
||||
editForm new uuid = page "Configure repository" (Just Config) $ do
|
||||
(repo, mremote) <- lift $ runAnnex undefined $ Remote.repoFromUUID uuid
|
||||
curr <- lift $ runAnnex undefined $ getRepoConfig uuid repo mremote
|
||||
lift $ checkarchivedirectory curr
|
||||
|
|
|
@ -9,13 +9,9 @@
|
|||
|
||||
module Assistant.WebApp.Configurators.Local where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.SideBar
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.WebApp.Utility
|
||||
import Assistant.MakeRemote
|
||||
import Utility.Yesod
|
||||
import Init
|
||||
import qualified Git
|
||||
import qualified Git.Construct
|
||||
|
@ -35,7 +31,6 @@ import Logs.PreferredContent
|
|||
import Utility.UserInfo
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Char
|
||||
import System.Posix.Directory
|
||||
|
@ -133,9 +128,7 @@ newRepositoryForm defpath msg = do
|
|||
|
||||
{- Making the first repository, when starting the webapp for the first time. -}
|
||||
getFirstRepositoryR :: Handler RepHtml
|
||||
getFirstRepositoryR = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Getting started"
|
||||
getFirstRepositoryR = page "Getting started" (Just Config) $ do
|
||||
path <- liftIO . defaultRepositoryPath =<< lift inFirstRun
|
||||
((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm path
|
||||
case res of
|
||||
|
@ -145,9 +138,7 @@ getFirstRepositoryR = bootstrap (Just Config) $ do
|
|||
|
||||
{- Adding a new, separate repository. -}
|
||||
getNewRepositoryR :: Handler RepHtml
|
||||
getNewRepositoryR = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add another repository"
|
||||
getNewRepositoryR = page "Add another repository" (Just Config) $ do
|
||||
home <- liftIO myHomeDir
|
||||
((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home
|
||||
case res of
|
||||
|
@ -184,9 +175,7 @@ selectDriveForm drives def = renderBootstrap $ RemovableDrive
|
|||
|
||||
{- Adding a removable drive. -}
|
||||
getAddDriveR :: Handler RepHtml
|
||||
getAddDriveR = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add a removable drive"
|
||||
getAddDriveR = page "AAdd a removable drive" (Just Config) $ do
|
||||
removabledrives <- liftIO $ driveList
|
||||
writabledrives <- liftIO $
|
||||
filterM (canWrite . T.unpack . mountPoint) removabledrives
|
||||
|
@ -226,9 +215,7 @@ getAddDriveR = bootstrap (Just Config) $ do
|
|||
addRemote $ makeGitRemote name dir
|
||||
|
||||
getEnableDirectoryR :: UUID -> Handler RepHtml
|
||||
getEnableDirectoryR uuid = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Enable a repository"
|
||||
getEnableDirectoryR uuid = page "Enable a repository" (Just Config) $ do
|
||||
description <- lift $ runAnnex "" $
|
||||
T.pack . concat <$> prettyListUUIDs [uuid]
|
||||
$(widgetFile "configurators/enabledirectory")
|
||||
|
|
|
@ -11,13 +11,9 @@
|
|||
module Assistant.WebApp.Configurators.Pairing where
|
||||
|
||||
import Assistant.Pairing
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.SideBar
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.Types.Buddies
|
||||
import Utility.Yesod
|
||||
#ifdef WITH_PAIRING
|
||||
import Assistant.Common
|
||||
import Assistant.Pairing.Network
|
||||
import Assistant.Pairing.MakeRemote
|
||||
import Assistant.Ssh
|
||||
|
@ -42,7 +38,6 @@ import Utility.UserInfo
|
|||
import Git
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
#ifdef WITH_PAIRING
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
|
@ -293,10 +288,7 @@ sampleQuote = T.unwords
|
|||
#endif
|
||||
|
||||
pairPage :: Widget -> Handler RepHtml
|
||||
pairPage w = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Pairing"
|
||||
w
|
||||
pairPage = page "Pairing" (Just Config)
|
||||
|
||||
noPairing :: Text -> Handler RepHtml
|
||||
noPairing pairingtype = pairPage $
|
||||
|
|
|
@ -9,13 +9,9 @@
|
|||
|
||||
module Assistant.WebApp.Configurators.Ssh where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.Ssh
|
||||
import Assistant.MakeRemote
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.SideBar
|
||||
import Utility.Yesod
|
||||
import Utility.Rsync (rsyncUrlIsShell)
|
||||
import Logs.Remote
|
||||
import Remote
|
||||
|
@ -24,16 +20,12 @@ import Types.StandardGroups
|
|||
import Utility.UserInfo
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
import Network.Socket
|
||||
|
||||
sshConfigurator :: Widget -> Handler RepHtml
|
||||
sshConfigurator a = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add a remote server"
|
||||
a
|
||||
sshConfigurator = page "Add a remote server" (Just Config)
|
||||
|
||||
data SshInput = SshInput
|
||||
{ hostname :: Maybe Text
|
||||
|
@ -291,10 +283,7 @@ getAddRsyncNetR = do
|
|||
((result, form), enctype) <- runFormGet $
|
||||
renderBootstrap $ sshInputAForm $
|
||||
SshInput Nothing Nothing Nothing
|
||||
let showform status = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add a Rsync.net repository"
|
||||
let authtoken = webAppFormAuthToken
|
||||
let showform status = page "Add a Rsync.net repository" (Just Config) $
|
||||
$(widgetFile "configurators/addrsync.net")
|
||||
case result of
|
||||
FormSuccess sshinput
|
||||
|
|
|
@ -9,13 +9,9 @@
|
|||
|
||||
module Assistant.WebApp.Configurators.WebDAV where
|
||||
|
||||
import Assistant.Common
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.MakeRemote
|
||||
import Assistant.Sync
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.SideBar
|
||||
import Utility.Yesod
|
||||
import qualified Remote.WebDAV as WebDAV
|
||||
import qualified Remote
|
||||
import Types.Remote (RemoteConfig)
|
||||
|
@ -24,21 +20,14 @@ import Logs.PreferredContent
|
|||
import Logs.Remote
|
||||
|
||||
import Yesod
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map as M
|
||||
|
||||
webDAVConfigurator :: Widget -> Handler RepHtml
|
||||
webDAVConfigurator a = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add a WebDAV repository"
|
||||
a
|
||||
webDAVConfigurator = page "Add a WebDAV repository" (Just Config)
|
||||
|
||||
boxConfigurator :: Widget -> Handler RepHtml
|
||||
boxConfigurator a = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Add a Box.com repository"
|
||||
a
|
||||
boxConfigurator = page "Add a Box.com repository" (Just Config)
|
||||
|
||||
data WebDAVInput = WebDAVInput
|
||||
{ user :: Text
|
||||
|
|
|
@ -10,14 +10,10 @@
|
|||
|
||||
module Assistant.WebApp.Configurators.XMPP where
|
||||
|
||||
import Assistant.WebApp
|
||||
import Assistant.WebApp.Types
|
||||
import Assistant.WebApp.Common
|
||||
import Assistant.WebApp.Notifications
|
||||
import Assistant.WebApp.SideBar
|
||||
import Utility.Yesod
|
||||
import Utility.NotificationBroadcaster
|
||||
#ifdef WITH_XMPP
|
||||
import Assistant.Common
|
||||
import Assistant.XMPP.Client
|
||||
import Assistant.XMPP.Buddies
|
||||
import Assistant.Types.Buddies
|
||||
|
@ -31,7 +27,6 @@ import Yesod
|
|||
#ifdef WITH_XMPP
|
||||
import Network
|
||||
import Network.Protocol.XMPP
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Control.Exception (SomeException)
|
||||
#endif
|
||||
|
@ -97,8 +92,8 @@ getBuddyListR :: NotificationId -> Handler RepHtml
|
|||
getBuddyListR nid = do
|
||||
waitNotifier getBuddyListBroadcaster nid
|
||||
|
||||
page <- widgetToPageContent buddyListDisplay
|
||||
hamletToRepHtml $ [hamlet|^{pageBody page}|]
|
||||
p <- widgetToPageContent buddyListDisplay
|
||||
hamletToRepHtml $ [hamlet|^{pageBody p}|]
|
||||
|
||||
buddyListDisplay :: Widget
|
||||
buddyListDisplay = do
|
||||
|
@ -163,7 +158,4 @@ testXMPP creds = either Left (const $ Right creds)
|
|||
#endif
|
||||
|
||||
xmppPage :: Widget -> Handler RepHtml
|
||||
xmppPage w = bootstrap (Just Config) $ do
|
||||
sideBarDisplay
|
||||
setTitle "Jabber"
|
||||
w
|
||||
xmppPage = page "Jabber" (Just Config)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue