reorg templates
This commit is contained in:
parent
6e60b08060
commit
f62cc48482
10 changed files with 10 additions and 10 deletions
|
@ -107,8 +107,8 @@ defaultRepositoryPath firstrun = do
|
||||||
)
|
)
|
||||||
else return cwd
|
else return cwd
|
||||||
|
|
||||||
localRepositoryForm :: Form RepositoryPath
|
firstRepositoryForm :: Form RepositoryPath
|
||||||
localRepositoryForm msg = do
|
firstRepositoryForm msg = do
|
||||||
path <- T.pack . addTrailingPathSeparator
|
path <- T.pack . addTrailingPathSeparator
|
||||||
<$> (liftIO . defaultRepositoryPath =<< lift inFirstRun)
|
<$> (liftIO . defaultRepositoryPath =<< lift inFirstRun)
|
||||||
(pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path)
|
(pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path)
|
||||||
|
@ -118,7 +118,7 @@ localRepositoryForm msg = do
|
||||||
FormSuccess _ -> (False, "")
|
FormSuccess _ -> (False, "")
|
||||||
let form = do
|
let form = do
|
||||||
webAppFormAuthToken
|
webAppFormAuthToken
|
||||||
$(widgetFile "configurators/localrepositoryform")
|
$(widgetFile "configurators/firstrepository/form")
|
||||||
return (RepositoryPath <$> pathRes, form)
|
return (RepositoryPath <$> pathRes, form)
|
||||||
|
|
||||||
{- Making the first repository, when starting the webapp for the first time. -}
|
{- Making the first repository, when starting the webapp for the first time. -}
|
||||||
|
@ -126,7 +126,7 @@ getFirstRepositoryR :: Handler RepHtml
|
||||||
getFirstRepositoryR = bootstrap (Just Config) $ do
|
getFirstRepositoryR = bootstrap (Just Config) $ do
|
||||||
sideBarDisplay
|
sideBarDisplay
|
||||||
setTitle "Getting started"
|
setTitle "Getting started"
|
||||||
((res, form), enctype) <- lift $ runFormGet localRepositoryForm
|
((res, form), enctype) <- lift $ runFormGet firstRepositoryForm
|
||||||
case res of
|
case res of
|
||||||
FormSuccess (RepositoryPath p) -> lift $
|
FormSuccess (RepositoryPath p) -> lift $
|
||||||
startFullAssistant $ T.unpack p
|
startFullAssistant $ T.unpack p
|
||||||
|
|
|
@ -74,7 +74,7 @@ getInprogressPairR :: Text -> Handler RepHtml
|
||||||
getInprogressPairR secret = bootstrap (Just Config) $ do
|
getInprogressPairR secret = bootstrap (Just Config) $ do
|
||||||
sideBarDisplay
|
sideBarDisplay
|
||||||
setTitle "Pairing"
|
setTitle "Pairing"
|
||||||
$(widgetFile "configurators/inprogresspairing")
|
$(widgetFile "configurators/pairing/inprogress")
|
||||||
#else
|
#else
|
||||||
getInprogressPairR _ = noPairing
|
getInprogressPairR _ = noPairing
|
||||||
#endif
|
#endif
|
||||||
|
@ -123,7 +123,7 @@ promptSecret msg cont = bootstrap (Just Config) $ do
|
||||||
u <- T.pack <$> liftIO getUserName
|
u <- T.pack <$> liftIO getUserName
|
||||||
let sameusername = username == u
|
let sameusername = username == u
|
||||||
let authtoken = webAppFormAuthToken
|
let authtoken = webAppFormAuthToken
|
||||||
$(widgetFile "configurators/pairing")
|
$(widgetFile "configurators/pairing/prompt")
|
||||||
|
|
||||||
{- This counts unicode characters as more than one character,
|
{- This counts unicode characters as more than one character,
|
||||||
- but that's ok; they *do* provide additional entropy. -}
|
- but that's ok; they *do* provide additional entropy. -}
|
||||||
|
@ -155,6 +155,6 @@ noPairing :: Handler RepHtml
|
||||||
noPairing = bootstrap (Just Config) $ do
|
noPairing = bootstrap (Just Config) $ do
|
||||||
sideBarDisplay
|
sideBarDisplay
|
||||||
setTitle "Pairing"
|
setTitle "Pairing"
|
||||||
$(widgetFile "configurators/nopairing")
|
$(widgetFile "configurators/pairing/disabled")
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -112,7 +112,7 @@ getAddSshR = sshConfigurator $ do
|
||||||
where
|
where
|
||||||
showform form enctype status = do
|
showform form enctype status = do
|
||||||
let authtoken = webAppFormAuthToken
|
let authtoken = webAppFormAuthToken
|
||||||
$(widgetFile "configurators/addssh")
|
$(widgetFile "configurators/ssh/add")
|
||||||
|
|
||||||
{- Test if we can ssh into the server.
|
{- Test if we can ssh into the server.
|
||||||
-
|
-
|
||||||
|
@ -225,7 +225,7 @@ sshSetup opts input a = do
|
||||||
|
|
||||||
showSshErr :: String -> Handler RepHtml
|
showSshErr :: String -> Handler RepHtml
|
||||||
showSshErr msg = sshConfigurator $
|
showSshErr msg = sshConfigurator $
|
||||||
$(widgetFile "configurators/makessherror")
|
$(widgetFile "configurators/ssh/error")
|
||||||
|
|
||||||
{- Does ssh have known_hosts data for a hostname? -}
|
{- Does ssh have known_hosts data for a hostname? -}
|
||||||
knownHost :: SshServer -> IO Bool
|
knownHost :: SshServer -> IO Bool
|
||||||
|
@ -240,7 +240,7 @@ knownHost (SshServer { hostname = Just h }) = do
|
||||||
getConfirmSshR :: SshData -> Handler RepHtml
|
getConfirmSshR :: SshData -> Handler RepHtml
|
||||||
getConfirmSshR sshdata = sshConfigurator $ do
|
getConfirmSshR sshdata = sshConfigurator $ do
|
||||||
let authtoken = webAppFormAuthToken
|
let authtoken = webAppFormAuthToken
|
||||||
$(widgetFile "configurators/confirmssh")
|
$(widgetFile "configurators/ssh/confirm")
|
||||||
|
|
||||||
getMakeSshGitR :: SshData -> Handler RepHtml
|
getMakeSshGitR :: SshData -> Handler RepHtml
|
||||||
getMakeSshGitR = makeSsh False
|
getMakeSshGitR = makeSsh False
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue