now builds with both yesod 1.2 and 1.1

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

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

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)

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|

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

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)

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)

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)

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

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|
 <input id="#{theId}" name="#{name}" *{attrs} type="text" value="#{either id id val}">
@@ -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|
 <input id="#{theId}" name="#{name}" *{attrs} type="password" value="#{either id id val}">
@@ -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}&nbsp;&nbsp;<span>^{note}</span>|]
 
 {- 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|
 <a .btn data-toggle="collapse" data-target="##{ident}">
   #{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)]

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

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

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

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