diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs
index b0beefb59f..1681e3c492 100644
--- a/Assistant/WebApp/Configurators/AWS.hs
+++ b/Assistant/WebApp/Configurators/AWS.hs
@@ -63,7 +63,7 @@ data AWSCreds = AWSCreds Text Text
extractCreds :: AWSInput -> AWSCreds
extractCreds i = AWSCreds (accessKeyID i) (secretAccessKey i)
-s3InputAForm :: Maybe CredPair -> AForm Handler AWSInput
+s3InputAForm :: Maybe CredPair -> MkAForm AWSInput
s3InputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
@@ -78,7 +78,7 @@ s3InputAForm defcreds = AWSInput
, ("Reduced redundancy (costs less)", ReducedRedundancy)
]
-glacierInputAForm :: Maybe CredPair -> AForm Handler AWSInput
+glacierInputAForm :: Maybe CredPair -> MkAForm AWSInput
glacierInputAForm defcreds = AWSInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
@@ -87,15 +87,15 @@ glacierInputAForm defcreds = AWSInput
<*> areq textField "Repository name" (Just "glacier")
<*> enableEncryptionField
-awsCredsAForm :: Maybe CredPair -> AForm Handler AWSCreds
+awsCredsAForm :: Maybe CredPair -> MkAForm AWSCreds
awsCredsAForm defcreds = AWSCreds
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> secretAccessKeyField (T.pack . snd <$> defcreds)
-accessKeyIDField :: Widget -> Maybe Text -> AForm Handler Text
+accessKeyIDField :: Widget -> Maybe Text -> MkAForm Text
accessKeyIDField help def = areq (textField `withNote` help) "Access Key ID" def
-accessKeyIDFieldWithHelp :: Maybe Text -> AForm Handler Text
+accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp def = accessKeyIDField help def
where
help = [whamlet|
@@ -103,10 +103,10 @@ accessKeyIDFieldWithHelp def = accessKeyIDField help def
Get Amazon access keys
|]
-secretAccessKeyField :: Maybe Text -> AForm Handler Text
+secretAccessKeyField :: Maybe Text -> MkAForm Text
secretAccessKeyField def = areq passwordField "Secret Access Key" def
-datacenterField :: AWS.Service -> AForm Handler Text
+datacenterField :: AWS.Service -> MkAForm Text
datacenterField service = areq (selectFieldList list) "Datacenter" defregion
where
list = M.toList $ AWS.regionMap service
diff --git a/Assistant/WebApp/Configurators/Delete.hs b/Assistant/WebApp/Configurators/Delete.hs
index 3b0d6b78b5..8d706ff2c5 100644
--- a/Assistant/WebApp/Configurators/Delete.hs
+++ b/Assistant/WebApp/Configurators/Delete.hs
@@ -107,7 +107,7 @@ deleteCurrentRepository = dangerPage $ do
data SanityVerifier = SanityVerifier T.Text
deriving (Eq)
-sanityVerifierAForm :: SanityVerifier -> AForm Handler SanityVerifier
+sanityVerifierAForm :: SanityVerifier -> MkAForm SanityVerifier
sanityVerifierAForm template = SanityVerifier
<$> areq checksanity "Confirm deletion?" Nothing
where
diff --git a/Assistant/WebApp/Configurators/Edit.hs b/Assistant/WebApp/Configurators/Edit.hs
index abd3c95827..96361e0bf6 100644
--- a/Assistant/WebApp/Configurators/Edit.hs
+++ b/Assistant/WebApp/Configurators/Edit.hs
@@ -132,7 +132,7 @@ setRepoConfig uuid mremote oldc newc = do
legalName = makeLegalName . T.unpack . repoName
-editRepositoryAForm :: RepoConfig -> AForm Handler RepoConfig
+editRepositoryAForm :: RepoConfig -> MkAForm RepoConfig
editRepositoryAForm def = RepoConfig
<$> areq textField "Name" (Just $ repoName def)
<*> aopt textField "Description" (Just $ repoDescription def)
diff --git a/Assistant/WebApp/Configurators/IA.hs b/Assistant/WebApp/Configurators/IA.hs
index 15536adb95..f42c841c34 100644
--- a/Assistant/WebApp/Configurators/IA.hs
+++ b/Assistant/WebApp/Configurators/IA.hs
@@ -79,7 +79,7 @@ showMediaType MediaVideo = "videos & movies"
showMediaType MediaAudio = "audio & music"
showMediaType MediaOmitted = "other"
-iaInputAForm :: Maybe CredPair -> AForm Handler IAInput
+iaInputAForm :: Maybe CredPair -> MkAForm IAInput
iaInputAForm defcreds = IAInput
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
@@ -99,7 +99,7 @@ itemNameHelp = [whamlet|
will be uploaded to your Internet Archive item.
|]
-iaCredsAForm :: Maybe CredPair -> AForm Handler AWS.AWSCreds
+iaCredsAForm :: Maybe CredPair -> MkAForm AWS.AWSCreds
iaCredsAForm defcreds = AWS.AWSCreds
<$> accessKeyIDFieldWithHelp (T.pack . fst <$> defcreds)
<*> AWS.secretAccessKeyField (T.pack . snd <$> defcreds)
@@ -110,7 +110,7 @@ previouslyUsedIACreds = previouslyUsedCredPair AWS.creds S3.remote $
AWS.isIARemoteConfig . Remote.config
#endif
-accessKeyIDFieldWithHelp :: Maybe Text -> AForm Handler Text
+accessKeyIDFieldWithHelp :: Maybe Text -> MkAForm Text
accessKeyIDFieldWithHelp def = AWS.accessKeyIDField help def
where
help = [whamlet|
diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs
index 0b551c4383..e5ba193687 100644
--- a/Assistant/WebApp/Configurators/Local.hs
+++ b/Assistant/WebApp/Configurators/Local.hs
@@ -46,7 +46,11 @@ data RepositoryPath = RepositoryPath Text
-
- Validates that the path entered is not empty, and is a safe value
- to use as a repository. -}
+#if MIN_VERSION_yesod(1,2,0)
repositoryPathField :: forall (m :: * -> *). (MonadIO m, HandlerSite m ~ WebApp) => Bool -> Field m Text
+#else
+repositoryPathField :: forall sub. Bool -> Field sub WebApp Text
+#endif
repositoryPathField autofocus = Field
#if ! MIN_VERSION_yesod_form(1,2,0)
{ fieldParse = parse
@@ -119,7 +123,7 @@ defaultRepositoryPath firstrun = do
)
legit d = not <$> doesFileExist (d > "git-annex")
-newRepositoryForm :: FilePath -> Html -> Form RepositoryPath
+newRepositoryForm :: FilePath -> Html -> MkMForm RepositoryPath
newRepositoryForm defpath msg = do
(pathRes, pathView) <- mreq (repositoryPathField True) ""
(Just $ T.pack $ addTrailingPathSeparator defpath)
@@ -185,7 +189,7 @@ getCombineRepositoryR (FilePathAndUUID newrepopath newrepouuid) = do
where
remotename = takeFileName newrepopath
-selectDriveForm :: [RemovableDrive] -> Html -> Form RemovableDrive
+selectDriveForm :: [RemovableDrive] -> Html -> MkMForm RemovableDrive
selectDriveForm drives = renderBootstrap $ RemovableDrive
<$> pure Nothing
<*> areq (selectFieldList pairs) "Select drive:" Nothing
diff --git a/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs
index 8842ae14bc..2bd161351d 100644
--- a/Assistant/WebApp/Configurators/Preferences.hs
+++ b/Assistant/WebApp/Configurators/Preferences.hs
@@ -29,7 +29,7 @@ data PrefsForm = PrefsForm
, debugEnabled :: Bool
}
-prefsAForm :: PrefsForm -> AForm Handler PrefsForm
+prefsAForm :: PrefsForm -> MkAForm PrefsForm
prefsAForm def = PrefsForm
<$> areq (storageField `withNote` diskreservenote)
"Disk reserve" (Just $ diskReserve def)
diff --git a/Assistant/WebApp/Configurators/Ssh.hs b/Assistant/WebApp/Configurators/Ssh.hs
index cbb6d76a76..3baff59f30 100644
--- a/Assistant/WebApp/Configurators/Ssh.hs
+++ b/Assistant/WebApp/Configurators/Ssh.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
-{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, RankNTypes, FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Assistant.WebApp.Configurators.Ssh where
@@ -58,7 +58,11 @@ mkSshInput s = SshInput
, inputPort = sshPort s
}
+#if MIN_VERSION_yesod(1,2,0)
sshInputAForm :: Field Handler Text -> SshInput -> AForm Handler SshInput
+#else
+sshInputAForm :: Field WebApp WebApp Text -> SshInput -> AForm WebApp WebApp SshInput
+#endif
sshInputAForm hostnamefield def = SshInput
<$> aopt check_hostname "Host name" (Just $ inputHostname def)
<*> aopt check_username "User name" (Just $ inputUsername def)
diff --git a/Assistant/WebApp/Configurators/WebDAV.hs b/Assistant/WebApp/Configurators/WebDAV.hs
index 49af3c5a17..9046033ffb 100644
--- a/Assistant/WebApp/Configurators/WebDAV.hs
+++ b/Assistant/WebApp/Configurators/WebDAV.hs
@@ -43,7 +43,7 @@ data WebDAVInput = WebDAVInput
toCredPair :: WebDAVInput -> CredPair
toCredPair input = (T.unpack $ user input, T.unpack $ password input)
-boxComAForm :: Maybe CredPair -> AForm Handler WebDAVInput
+boxComAForm :: Maybe CredPair -> MkAForm WebDAVInput
boxComAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Box.com Password" (T.pack . snd <$> defcreds)
@@ -51,7 +51,7 @@ boxComAForm defcreds = WebDAVInput
<*> areq textField "Directory" (Just "annex")
<*> enableEncryptionField
-webDAVCredsAForm :: Maybe CredPair -> AForm Handler WebDAVInput
+webDAVCredsAForm :: Maybe CredPair -> MkAForm WebDAVInput
webDAVCredsAForm defcreds = WebDAVInput
<$> areq textField "Username or Email" (T.pack . fst <$> defcreds)
<*> areq passwordField "Password" (T.pack . snd <$> defcreds)
diff --git a/Assistant/WebApp/Configurators/XMPP.hs b/Assistant/WebApp/Configurators/XMPP.hs
index 30f141188c..b29f0d295d 100644
--- a/Assistant/WebApp/Configurators/XMPP.hs
+++ b/Assistant/WebApp/Configurators/XMPP.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
-{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, TemplateHaskell, OverloadedStrings, FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Assistant.WebApp.Configurators.XMPP where
@@ -171,12 +171,12 @@ data XMPPForm = XMPPForm
creds2Form :: XMPPCreds -> XMPPForm
creds2Form c = XMPPForm (xmppJID c) (xmppPassword c)
-xmppAForm :: (Maybe XMPPForm) -> AForm Handler XMPPForm
+xmppAForm :: (Maybe XMPPForm) -> MkAForm XMPPForm
xmppAForm def = XMPPForm
<$> areq jidField "Jabber address" (formJID <$> def)
<*> areq passwordField "Password" Nothing
-jidField :: Field Handler Text
+jidField :: MkField Text
jidField = checkBool (isJust . parseJID) bad textField
where
bad :: Text
diff --git a/Assistant/WebApp/Form.hs b/Assistant/WebApp/Form.hs
index b474f76d88..d7a6c621c2 100644
--- a/Assistant/WebApp/Form.hs
+++ b/Assistant/WebApp/Form.hs
@@ -8,10 +8,12 @@
{-# LANGUAGE FlexibleContexts, TypeFamilies, QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses, TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE CPP #-}
module Assistant.WebApp.Form where
import Types.Remote (RemoteConfigKey)
+import Assistant.WebApp.Types
import Yesod hiding (textField, passwordField)
import Yesod.Form.Fields as F
@@ -24,7 +26,7 @@ import Data.Text (Text)
-
- Required fields are still checked by Yesod.
-}
-textField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
+textField :: MkField Text
textField = F.textField
{ fieldView = \theId name attrs val _isReq -> [whamlet|
@@ -32,7 +34,7 @@ textField = F.textField
}
{- Also without required attribute. -}
-passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
+passwordField :: MkField Text
passwordField = F.passwordField
{ fieldView = \theId name attrs val _isReq -> toWidget [hamlet|
@@ -40,7 +42,11 @@ passwordField = F.passwordField
}
{- Makes a note widget be displayed after a field. -}
+#if MIN_VERSION_yesod(1,2,0)
withNote :: (Monad m, ToWidget (HandlerSite m) a) => Field m v -> a -> Field m v
+#else
+withNote :: Field sub master v -> GWidget sub master () -> Field sub master v
+#endif
withNote field note = field { fieldView = newview }
where
newview theId name attrs val isReq =
@@ -48,7 +54,11 @@ withNote field note = field { fieldView = newview }
in [whamlet|^{fieldwidget} ^{note}|]
{- Note that the toggle string must be unique on the form. -}
+#if MIN_VERSION_yesod(1,2,0)
withExpandableNote :: (Monad m, ToWidget (HandlerSite m) w) => Field m v -> (String, w) -> Field m v
+#else
+withExpandableNote :: Field sub master v -> (String, GWidget sub master ()) -> Field sub master v
+#endif
withExpandableNote field (toggle, note) = withNote field $ [whamlet|
#{toggle}
@@ -62,7 +72,11 @@ data EnableEncryption = SharedEncryption | NoEncryption
deriving (Eq)
{- Adds a check box to an AForm to control encryption. -}
+#if MIN_VERSION_yesod(1,2,0)
enableEncryptionField :: (RenderMessage site FormMessage) => AForm (HandlerT site IO) EnableEncryption
+#else
+enableEncryptionField :: RenderMessage master FormMessage => AForm sub master EnableEncryption
+#endif
enableEncryptionField = areq (selectFieldList choices) "Encryption" (Just SharedEncryption)
where
choices :: [(Text, EnableEncryption)]
diff --git a/Assistant/WebApp/Types.hs b/Assistant/WebApp/Types.hs
index eae7269407..4191e028da 100644
--- a/Assistant/WebApp/Types.hs
+++ b/Assistant/WebApp/Types.hs
@@ -7,7 +7,8 @@
{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell, OverloadedStrings, RankNTypes #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
+{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Assistant.WebApp.Types where
@@ -81,29 +82,65 @@ instance RenderMessage WebApp FormMessage where
- When the webapp is run outside a git-annex repository, the fallback
- value is returned.
-}
+#if MIN_VERSION_yesod(1,2,0)
liftAnnexOr :: forall a. a -> Annex a -> Handler a
+#else
+liftAnnexOr :: forall sub a. a -> Annex a -> GHandler sub WebApp a
+#endif
liftAnnexOr fallback a = ifM (noAnnex <$> getYesod)
( return fallback
, liftAssistant $ liftAnnex a
)
+#if MIN_VERSION_yesod(1,2,0)
instance LiftAnnex Handler where
+#else
+instance LiftAnnex (GHandler sub WebApp) where
+#endif
liftAnnex = liftAnnexOr $ error "internal liftAnnex"
+#if MIN_VERSION_yesod(1,2,0)
instance LiftAnnex (WidgetT WebApp IO) where
+#else
+instance LiftAnnex (GWidget WebApp WebApp) where
+#endif
liftAnnex = liftH . liftAnnex
class LiftAssistant m where
liftAssistant :: Assistant a -> m a
+#if MIN_VERSION_yesod(1,2,0)
instance LiftAssistant Handler where
+#else
+instance LiftAssistant (GHandler sub WebApp) where
+#endif
liftAssistant a = liftIO . flip runAssistant a
=<< assistantData <$> getYesod
+#if MIN_VERSION_yesod(1,2,0)
instance LiftAssistant (WidgetT WebApp IO) where
+#else
+instance LiftAssistant (GWidget WebApp WebApp) where
+#endif
liftAssistant = liftH . liftAssistant
-type Form x = MForm Handler (FormResult x, Widget)
+#if MIN_VERSION_yesod(1,2,0)
+type MkMForm x = MForm Handler (FormResult x, Widget)
+#else
+type MkMForm x = MForm WebApp WebApp (FormResult x, Widget)
+#endif
+
+#if MIN_VERSION_yesod(1,2,0)
+type MkAForm x = AForm Handler x
+#else
+type MkAForm x = AForm WebApp WebApp x
+#endif
+
+#if MIN_VERSION_yesod(1,2,0)
+type MkField x = Monad m => RenderMessage (HandlerSite m) FormMessage => Field m x
+#else
+type MkField x = RenderMessage master FormMessage => Field sub master x
+#endif
data RepoSelector = RepoSelector
{ onlyCloud :: Bool
diff --git a/Utility/WebApp.hs b/Utility/WebApp.hs
index 240d097b00..f3c0d3a6b3 100644
--- a/Utility/WebApp.hs
+++ b/Utility/WebApp.hs
@@ -178,7 +178,11 @@ lookupRequestField k req = fromMaybe "" . lookup k $ Wai.requestHeaders req
{- Rather than storing a session key on disk, use a random key
- that will only be valid for this run of the webapp. -}
+#if MIN_VERSION_yesod(1,2,0)
webAppSessionBackend :: Yesod.Yesod y => y -> IO (Maybe Yesod.SessionBackend)
+#else
+webAppSessionBackend :: Yesod.Yesod y => y -> IO (Maybe (Yesod.SessionBackend y))
+#endif
webAppSessionBackend _ = do
g <- newGenIO :: IO SystemRandom
case genBytes 96 g of
@@ -218,7 +222,11 @@ genRandomToken = do
- Note that the usual Yesod error page is bypassed on error, to avoid
- possibly leaking the auth token in urls on that page!
-}
+#if MIN_VERSION_yesod(1,2,0)
checkAuthToken :: (Monad m, Yesod.MonadHandler m) => (Yesod.HandlerSite m -> T.Text) -> m Yesod.AuthResult
+#else
+checkAuthToken :: forall t sub. (t -> T.Text) -> Yesod.GHandler sub t Yesod.AuthResult
+#endif
checkAuthToken extractToken = do
webapp <- Yesod.getYesod
req <- Yesod.getRequest
diff --git a/Utility/Yesod.hs b/Utility/Yesod.hs
index ef9ad5fc57..e437326b02 100644
--- a/Utility/Yesod.hs
+++ b/Utility/Yesod.hs
@@ -8,20 +8,21 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-{-# LANGUAGE CPP, RankNTypes #-}
+{-# LANGUAGE CPP, RankNTypes, FlexibleContexts #-}
module Utility.Yesod where
+import Yesod
+#if MIN_VERSION_yesod_default(1,2,0)
+import Yesod.Core
+#endif
#ifndef __ANDROID__
import Yesod.Default.Util
-import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Syntax (Q, Exp)
#if MIN_VERSION_yesod_default(1,1,0)
import Data.Default (def)
import Text.Hamlet
#endif
-#if MIN_VERSION_yesod_default(1,2,0)
-import Yesod.Core
-#endif
widgetFile :: String -> Q Exp
#if ! MIN_VERSION_yesod_default(1,1,0)
@@ -39,10 +40,10 @@ hamletTemplate f = globFile "hamlet" f
#endif
{- Lift Handler to Widget -}
-#if ! MIN_VERSION_yesod(1,2,0)
-liftH :: forall t. Lift t => t -> Q Exp
-liftH = lift
-#else
+#if MIN_VERSION_yesod(1,2,0)
liftH :: Monad m => HandlerT site m a -> WidgetT site m a
liftH = liftH
+#else
+liftH :: MonadLift base m => base a -> m a
+liftH = lift
#endif
diff --git a/git-annex.cabal b/git-annex.cabal
index a97ee38944..14d6da7a50 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -133,7 +133,7 @@ Executable git-annex
if flag(Webapp)
Build-Depends:
- yesod, yesod-default, yesod-static, yesod-form,
+ yesod, yesod-default, yesod-static, yesod-form, yesod-core,
case-insensitive, http-types, transformers, wai, wai-logger, warp,
blaze-builder, crypto-api, hamlet, clientsession, aeson,
template-haskell, data-default