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

allow building webapp w/o webdav

Browse source
This commit is contained in:
Joey Hess 2012-11-25 14:36:24 -04:00
parent d07675648c
commit 18fe34222a
2 changed files with 14 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Assistant/Threads/WebApp.hs
View file

@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, CPP #-} {-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Assistant.Threads.WebApp where module Assistant.Threads.WebApp where
@ -22,9 +22,7 @@ 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
import Assistant.WebApp.Configurators.AWS import Assistant.WebApp.Configurators.AWS
#ifdef WITH_WEBDAV
import Assistant.WebApp.Configurators.WebDAV import Assistant.WebApp.Configurators.WebDAV
#endif
import Assistant.WebApp.Configurators.XMPP import Assistant.WebApp.Configurators.XMPP
import Assistant.WebApp.Documentation import Assistant.WebApp.Documentation
import Assistant.WebApp.OtherRepos import Assistant.WebApp.OtherRepos

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

@ -5,14 +5,16 @@
- Licensed under the GNU AGPL version 3 or higher. - Licensed under the GNU AGPL version 3 or higher.
-} -}
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-} {-# LANGUAGE CPP, TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
module Assistant.WebApp.Configurators.WebDAV where module Assistant.WebApp.Configurators.WebDAV where
import Assistant.WebApp.Common import Assistant.WebApp.Common
import Assistant.MakeRemote import Assistant.MakeRemote
import Assistant.Sync import Assistant.Sync
#ifdef WITH_WEBDAV
import qualified Remote.WebDAV as WebDAV import qualified Remote.WebDAV as WebDAV
#endif
import qualified Remote import qualified Remote
import Types.Remote (RemoteConfig) import Types.Remote (RemoteConfig)
import Types.StandardGroups import Types.StandardGroups
@ -48,6 +50,7 @@ webDAVCredsAForm = WebDAVInput
<*> pure (T.empty) <*> pure (T.empty)
getAddBoxComR :: Handler RepHtml getAddBoxComR :: Handler RepHtml
#ifdef WITH_WEBDAV
getAddBoxComR = boxConfigurator $ do getAddBoxComR = boxConfigurator $ do
((result, form), enctype) <- lift $ ((result, form), enctype) <- lift $
runFormGet $ renderBootstrap boxComAForm runFormGet $ renderBootstrap boxComAForm
@ -66,8 +69,12 @@ getAddBoxComR = boxConfigurator $ do
where where
setgroup r = runAnnex () $ setgroup r = runAnnex () $
setStandardGroup (Remote.uuid r) TransferGroup setStandardGroup (Remote.uuid r) TransferGroup
#else
getAddBoxComR = error "WebDAV not supported by this build"
#endif
getEnableWebDAVR :: UUID -> Handler RepHtml getEnableWebDAVR :: UUID -> Handler RepHtml
#ifdef WITH_WEBDAV
getEnableWebDAVR uuid = do getEnableWebDAVR uuid = do
m <- runAnnex M.empty readRemoteLog m <- runAnnex M.empty readRemoteLog
let c = fromJust $ M.lookup uuid m let c = fromJust $ M.lookup uuid m
@ -89,7 +96,11 @@ getEnableWebDAVR uuid = do
description <- lift $ runAnnex "" $ description <- lift $ runAnnex "" $
T.pack . concat <$> Remote.prettyListUUIDs [uuid] T.pack . concat <$> Remote.prettyListUUIDs [uuid]
$(widgetFile "configurators/enablewebdav") $(widgetFile "configurators/enablewebdav")
#else
getEnableWebDAVR _ = error "WebDAV not supported by this build"
#endif
#ifdef WITH_WEBDAV
makeWebDavRemote :: String -> WebDAVInput -> (Remote -> Handler ()) -> RemoteConfig -> Handler () makeWebDavRemote :: String -> WebDAVInput -> (Remote -> Handler ()) -> RemoteConfig -> Handler ()
makeWebDavRemote name input setup config = do makeWebDavRemote name input setup config = do
remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0 remotename <- runAnnex name $ fromRepo $ uniqueRemoteName name 0
@ -100,3 +111,4 @@ makeWebDavRemote name input setup config = do
setup r setup r
liftAssistant $ syncNewRemote r liftAssistant $ syncNewRemote r
redirect $ EditNewCloudRepositoryR $ Remote.uuid r redirect $ EditNewCloudRepositoryR $ Remote.uuid r
#endif