Dropped support for older versions of yesod and warp than the ones in Debian Jessie.

466 lines of compat cruft deleted!
This commit is contained in:
Joey Hess 2015-04-22 16:19:05 -04:00
parent a15e1158c6
commit eb8ef44133
13 changed files with 19 additions and 466 deletions

View file

@ -8,28 +8,15 @@
{-# LANGUAGE FlexibleContexts, TypeFamilies, QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses, TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings, RankNTypes #-}
{-# LANGUAGE CPP #-}
module Assistant.WebApp.Form where
import Assistant.WebApp.Types
import Assistant.Gpg
#if MIN_VERSION_yesod(1,2,0)
import Yesod hiding (textField, passwordField)
import Yesod.Form.Fields as F
#else
import Yesod hiding (textField, passwordField, selectField, selectFieldList)
import Yesod.Form.Fields as F hiding (selectField, selectFieldList)
import Data.String (IsString (..))
import Control.Monad (unless)
import Data.Maybe (listToMaybe)
#endif
#if MIN_VERSION_yesod_form(1,3,8)
import Yesod.Form.Bootstrap3 as Y hiding (bfs)
#else
import Assistant.WebApp.Bootstrap3 as Y hiding (bfs)
#endif
import Data.Text (Text)
{- Yesod's textField sets the required attribute for required fields.
@ -61,60 +48,8 @@ passwordField = F.passwordField
|]
}
{- In older Yesod versions attrs is written into the <option> tag instead of the
- surrounding <select>. This breaks the Bootstrap 3 layout of select fields as
- it requires the "form-control" class on the <select> tag.
- We need to change that to behave the same way as in newer versions.
-}
#if ! MIN_VERSION_yesod(1,2,0)
selectFieldList :: (Eq a, RenderMessage master FormMessage, RenderMessage master msg) => [(msg, a)] -> Field sub master a
selectFieldList = selectField . optionsPairs
selectField :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
selectField = selectFieldHelper
(\theId name attrs inside -> [whamlet|<select ##{theId} name=#{name} *{attrs}>^{inside}|]) -- outside
(\_theId _name isSel -> [whamlet|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
(\_theId _name _attrs value isSel text -> [whamlet|<option value=#{value} :isSel:selected>#{text}|]) -- inside
selectFieldHelper :: (Eq a, RenderMessage master FormMessage)
=> (Text -> Text -> [(Text, Text)] -> GWidget sub master () -> GWidget sub master ())
-> (Text -> Text -> Bool -> GWidget sub master ())
-> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> GWidget sub master ())
-> GHandler sub master (OptionList a) -> Field sub master a
selectFieldHelper outside onOpt inside opts' = Field
{ fieldParse = \x -> do
opts <- opts'
return $ selectParser opts x
, fieldView = \theId name attrs val isReq -> do
opts <- fmap olOptions $ lift opts'
outside theId name attrs $ do
unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts
flip mapM_ opts $ \opt -> inside
theId
name
((if isReq then (("required", "required"):) else id) attrs)
(optionExternalValue opt)
((render opts val) == optionExternalValue opt)
(optionDisplay opt)
}
where
render _ (Left _) = ""
render opts (Right a) = maybe "" optionExternalValue $ listToMaybe $ filter ((== a) . optionInternalValue) opts
selectParser _ [] = Right Nothing
selectParser opts (s:_) = case s of
"" -> Right Nothing
"none" -> Right Nothing
x -> case olReadExternal opts x of
Nothing -> Left $ SomeMessage $ MsgInvalidEntry x
Just y -> Right $ Just y
#endif
{- 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 =
@ -122,11 +57,7 @@ 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 .btn-default data-toggle="collapse" data-target="##{ident}">#{toggle}</a>
<div ##{ident} .collapse>
@ -136,11 +67,7 @@ withExpandableNote field (toggle, note) = withNote field $ [whamlet|
ident = "toggle_" ++ toggle
{- 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) (bfs "Encryption") (Just SharedEncryption)
where
choices :: [(Text, EnableEncryption)]