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:
parent
a15e1158c6
commit
eb8ef44133
13 changed files with 19 additions and 466 deletions
|
@ -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} <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)]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue