From daf977fdb189da04811b234d753de9bd3085c6eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Sat, 10 Apr 2021 11:42:04 +0200 Subject: [PATCH 01/10] Use standard function forM_ --- yesod-form/Yesod/Form/Fields.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index ab27544f..bf04b9c8 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -80,7 +80,7 @@ import Database.Persist (Entity (..), SqlType (SqlString), PersistRecordBackend, import Database.Persist (Entity (..), SqlType (SqlString), PersistEntity, PersistQuery, PersistEntityBackend) #endif import Text.HTML.SanitizeXSS (sanitizeBalance) -import Control.Monad (when, unless) +import Control.Monad (when, unless, forM_) import Data.Either (partitionEithers) import Data.Maybe (listToMaybe, fromMaybe) @@ -749,7 +749,7 @@ selectFieldHelper outside onOpt inside opts' = Field opts <- fmap olOptions $ handlerToWidget opts' outside theId name attrs $ do unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts - flip mapM_ opts $ \opt -> inside + forM_ opts $ \opt -> inside theId name ((if isReq then (("required", "required"):) else id) attrs) From 993de7fa86c724a27b822712353170101fd2a471 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Sat, 10 Apr 2021 11:42:43 +0200 Subject: [PATCH 02/10] Add selectFieldGrouped --- yesod-form/Yesod/Form/Fields.hs | 90 ++++++++++++++++++++++++++++----- 1 file changed, 76 insertions(+), 14 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index bf04b9c8..47463201 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -45,6 +45,7 @@ module Yesod.Form.Fields , selectFieldHelper , selectField , selectFieldList + , selectFieldListGrouped , radioField , radioFieldList , checkboxesField @@ -54,6 +55,7 @@ module Yesod.Form.Fields , Option (..) , OptionList (..) , mkOptionList + , mkOptionListGrouped , optionsPersist , optionsPersistKey , optionsPairs @@ -427,7 +429,13 @@ selectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg -> Field (HandlerFor site) a selectFieldList = selectField . optionsPairs --- | Creates a @\@ tag with @\@s for selecting one option. +selectFieldListGrouped :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) + => [(msg, [(msg, a)])] + -> Field (HandlerFor site) a +selectFieldListGrouped = selectField . optionsPairsGrouped + +-- | Creates a @\@ tag for selecting multiple options. multiSelectFieldList :: (Eq a, RenderMessage site msg) @@ -531,6 +542,7 @@ $newline never \#{text} |]) + Nothing -- | Creates a group of radio buttons to answer the question given in the message. Radio buttons are used to allow differentiating between an empty response (@Nothing@) and a no response (@Just False@). Consider using the simpler 'checkBoxField' if you don't need to make this distinction. -- @@ -598,10 +610,20 @@ $newline never showVal = either (\_ -> False) -- | A structure holding a list of options. Typically you can use a convenience function like 'mkOptionList' or 'optionsPairs' instead of creating this directly. -data OptionList a = OptionList +data OptionList a + = OptionList { olOptions :: [Option a] , olReadExternal :: Text -> Maybe a -- ^ A function mapping from the form's value ('optionExternalValue') to the selected Haskell value ('optionInternalValue'). } + | OptionListGrouped + { olOptionsGrouped :: [(Text, [Option a])] + , olReadExternalGrouped :: Text -> Maybe a -- ^ A function mapping from the form's value ('optionExternalValue') to the selected Haskell value ('optionInternalValue'). + } + +-- | Convert grouped 'OptionList' to a normal one. +flattenOptionList :: OptionList a -> OptionList a +flattenOptionList (OptionListGrouped os re) = OptionList (concatMap snd os) re +flattenOptionList ol = ol -- | Since 1.4.6 instance Functor OptionList where @@ -615,6 +637,13 @@ mkOptionList os = OptionList , olReadExternal = flip Map.lookup $ Map.fromList $ map (optionExternalValue &&& optionInternalValue) os } +-- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternalGrouped' function. +mkOptionListGrouped :: [(Text, [Option a])] -> OptionList a +mkOptionListGrouped os = OptionListGrouped + { olOptionsGrouped = os + , olReadExternalGrouped = flip Map.lookup $ Map.fromList $ map (optionExternalValue &&& optionInternalValue) $ concatMap snd os + } + data Option a = Option { optionDisplay :: Text -- ^ The user-facing label. , optionInternalValue :: a -- ^ The Haskell value being selected. @@ -637,6 +666,28 @@ optionsPairs opts = do } return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts) +-- | Creates an 'OptionList' from a list of (display-value, internal value) pairs. +optionsPairsGrouped + :: (MonadHandler m, RenderMessage (HandlerSite m) msg) + => [(msg, [(msg, a)])] -> m (OptionList a) +optionsPairsGrouped opts = do + mr <- getMessageRender + let mkOption (external, (display, internal)) = + Option { optionDisplay = mr display + , optionInternalValue = internal + , optionExternalValue = pack $ show external + } + opts' = enumerateSublists opts -- :: [(grp, [(Int, (msg, a))])] + opts'' = map (\(x, ys) -> (mr x, map mkOption ys)) opts' + return $ mkOptionListGrouped opts'' + +-- | Helper to enumerate sublists with one consecutive index. +enumerateSublists :: [(a, [b])] -> [(a, [(Int, b)])] +enumerateSublists xss = + let --yss :: [(Int, (a, [b]))] + yss = snd $ foldl (\(i, res) xs -> (i + (length.snd) xs, res ++ [(i, xs)])) (1, []) xss + in map (\(i, (x, ys)) -> (x, zip [i :: Int ..] ys)) yss + -- | Creates an 'OptionList' from an 'Enum', using its 'Show' instance for the user-facing value. optionsEnum :: (MonadHandler m, Show a, Enum a, Bounded a) => m (OptionList a) optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound] @@ -731,7 +782,7 @@ optionsPersistKey filts ords toDisplay = fmap mkOptionList $ do }) pairs -- | --- A helper function for constucting 'selectField's. You may want to use this when you define your custom 'selectField's or 'radioField's. +-- A helper function for constucting 'selectField's with optional option groups. You may want to use this when you define your custom 'selectField's or 'radioField's. -- -- @since 1.6.2 selectFieldHelper @@ -739,23 +790,26 @@ selectFieldHelper => (Text -> Text -> [(Text, Text)] -> WidgetFor site () -> WidgetFor site ()) -- ^ Outermost part of the field -> (Text -> Text -> Bool -> WidgetFor site ()) -- ^ An option for None if the field is optional -> (Text -> Text -> [(Text, Text)] -> Text -> Bool -> Text -> WidgetFor site ()) -- ^ Other options + -> (Maybe (Text -> WidgetFor site ())) -- ^ Group headers placed inbetween options -> HandlerFor site (OptionList a) -> Field (HandlerFor site) a -selectFieldHelper outside onOpt inside opts' = Field +selectFieldHelper outside onOpt inside grpHdr opts' = Field { fieldParse = \x _ -> do - opts <- opts' + opts <- fmap flattenOptionList opts' return $ selectParser opts x , fieldView = \theId name attrs val isReq -> do - opts <- fmap olOptions $ handlerToWidget opts' outside theId name attrs $ do - unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts - forM_ opts $ \opt -> inside - theId - name - ((if isReq then (("required", "required"):) else id) attrs) - (optionExternalValue opt) - ((render opts val) == optionExternalValue opt) - (optionDisplay opt) + optsFlat <- fmap (olOptions.flattenOptionList) $ handlerToWidget opts' + unless isReq $ onOpt theId name $ not $ render optsFlat val `elem` map optionExternalValue optsFlat + opts'' <- handlerToWidget opts' + case opts'' of + (OptionList{}) -> constructOptions theId name attrs val isReq optsFlat + (OptionListGrouped{olOptionsGrouped=grps}) -> do + forM_ grps $ \(grp, opts) -> do + case grpHdr of + Just hdr -> hdr grp + Nothing -> return () + constructOptions theId name attrs val isReq opts , fieldEnctype = UrlEncoded } where @@ -768,6 +822,14 @@ selectFieldHelper outside onOpt inside opts' = Field x -> case olReadExternal opts x of Nothing -> Left $ SomeMessage $ MsgInvalidEntry x Just y -> Right $ Just y + constructOptions theId name attrs val isReq opts = + forM_ opts $ \opt -> inside + theId + name + ((if isReq then (("required", "required"):) else id) attrs) + (optionExternalValue opt) + ((render opts val) == optionExternalValue opt) + (optionDisplay opt) -- | Creates an input with @type="file"@. fileField :: Monad m From 829b5af62c7f83b3af7ba9c52c05b0681fda3236 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Tue, 13 Apr 2021 21:58:33 +0200 Subject: [PATCH 03/10] Fix implementation of instance Functor OptionList --- yesod-form/Yesod/Form/Fields.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 47463201..91fb487c 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -627,8 +627,10 @@ flattenOptionList ol = ol -- | Since 1.4.6 instance Functor OptionList where - fmap f (OptionList options readExternal) = + fmap f (OptionList options readExternal) = OptionList ((fmap.fmap) f options) (fmap f . readExternal) + fmap f (OptionListGrouped options readExternal) = + OptionListGrouped (map (\(g, os) -> (g, (fmap.fmap) f os)) options) (fmap f . readExternal) -- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternal' function. mkOptionList :: [Option a] -> OptionList a From 2998849e9919b7d031de236e87d3a052abf2a225 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Tue, 13 Apr 2021 22:16:29 +0200 Subject: [PATCH 04/10] Fix comments --- yesod-form/Yesod/Form/Fields.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 91fb487c..0f957054 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -679,14 +679,14 @@ optionsPairsGrouped opts = do , optionInternalValue = internal , optionExternalValue = pack $ show external } - opts' = enumerateSublists opts -- :: [(grp, [(Int, (msg, a))])] + opts' = enumerateSublists opts -- :: [(msg, [(Int, (msg, a))])] opts'' = map (\(x, ys) -> (mr x, map mkOption ys)) opts' return $ mkOptionListGrouped opts'' -- | Helper to enumerate sublists with one consecutive index. enumerateSublists :: [(a, [b])] -> [(a, [(Int, b)])] enumerateSublists xss = - let --yss :: [(Int, (a, [b]))] + let -- yss :: [(Int, (a, [b]))] yss = snd $ foldl (\(i, res) xs -> (i + (length.snd) xs, res ++ [(i, xs)])) (1, []) xss in map (\(i, (x, ys)) -> (x, zip [i :: Int ..] ys)) yss From c6f44d47b97356003b8fdd1efe15a37dd843ff67 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Tue, 13 Apr 2021 22:22:26 +0200 Subject: [PATCH 05/10] Also export this helper --- yesod-form/Yesod/Form/Fields.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 0f957054..4688eccb 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -59,6 +59,7 @@ module Yesod.Form.Fields , optionsPersist , optionsPersistKey , optionsPairs + , optionsPairsGrouped , optionsEnum ) where From 848da5ff12b9dfc739aa598b2f5bfd1765bddfe3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 09:39:13 +0200 Subject: [PATCH 06/10] Bump version and fix old version comments --- yesod-form/ChangeLog.md | 4 ++++ yesod-form/Yesod/Form/Fields.hs | 22 ++++++++++++++++------ yesod-form/yesod-form.cabal | 2 +- 3 files changed, 21 insertions(+), 7 deletions(-) diff --git a/yesod-form/ChangeLog.md b/yesod-form/ChangeLog.md index c38a49dc..5d37f2f8 100644 --- a/yesod-form/ChangeLog.md +++ b/yesod-form/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yesod-form +## 1.7.0 + +* Extended `OptionList` by `OptionListGrouped` and implemented grouped select fields (`@ tag with @\@s for selecting one option. +-- +-- @since 1.7.0 selectFieldListGrouped :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, [(msg, a)])] -> Field (HandlerFor site) a @@ -611,6 +613,8 @@ $newline never showVal = either (\_ -> False) -- | A structure holding a list of options. Typically you can use a convenience function like 'mkOptionList' or 'optionsPairs' instead of creating this directly. +-- +-- Extended by 'OptionListGrouped' in 1.7.0. data OptionList a = OptionList { olOptions :: [Option a] @@ -622,11 +626,13 @@ data OptionList a } -- | Convert grouped 'OptionList' to a normal one. +-- +-- @since 1.7.0 flattenOptionList :: OptionList a -> OptionList a flattenOptionList (OptionListGrouped os re) = OptionList (concatMap snd os) re flattenOptionList ol = ol --- | Since 1.4.6 +-- | @since 1.4.6 instance Functor OptionList where fmap f (OptionList options readExternal) = OptionList ((fmap.fmap) f options) (fmap f . readExternal) @@ -641,6 +647,8 @@ mkOptionList os = OptionList } -- | Creates an 'OptionList', using a 'Map' to implement the 'olReadExternalGrouped' function. +-- +-- @since 1.7.0 mkOptionListGrouped :: [(Text, [Option a])] -> OptionList a mkOptionListGrouped os = OptionListGrouped { olOptionsGrouped = os @@ -653,7 +661,7 @@ data Option a = Option , optionExternalValue :: Text -- ^ The representation of this value stored in the form. } --- | Since 1.4.6 +-- | @since 1.4.6 instance Functor Option where fmap f (Option display internal external) = Option display (f internal) external @@ -670,6 +678,8 @@ optionsPairs opts = do return $ mkOptionList (zipWith mkOption [1 :: Int ..] opts) -- | Creates an 'OptionList' from a list of (display-value, internal value) pairs. +-- +-- @since 1.7.0 optionsPairsGrouped :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => [(msg, [(msg, a)])] -> m (OptionList a) @@ -746,7 +756,7 @@ optionsPersist filts ords toDisplay = fmap mkOptionList $ do -- | An alternative to 'optionsPersist' which returns just the 'Key' instead of -- the entire 'Entity'. -- --- Since 1.3.2 +-- @since 1.3.2 #if MIN_VERSION_persistent(2,5,0) optionsPersistKey :: (YesodPersist site diff --git a/yesod-form/yesod-form.cabal b/yesod-form/yesod-form.cabal index c66cd7b0..1fb100b1 100644 --- a/yesod-form/yesod-form.cabal +++ b/yesod-form/yesod-form.cabal @@ -1,5 +1,5 @@ name: yesod-form -version: 1.6.7 +version: 1.7.0 license: MIT license-file: LICENSE author: Michael Snoyman From e3a95bd92cc932fe9d4258c94a290402a6ef681b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 09:40:21 +0200 Subject: [PATCH 07/10] Simplify code, fix linter warnings --- yesod-form/README.md | 2 +- yesod-form/Yesod/Form/Fields.hs | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/yesod-form/README.md b/yesod-form/README.md index 097995c4..29bd5767 100644 --- a/yesod-form/README.md +++ b/yesod-form/README.md @@ -3,7 +3,7 @@ Form handling for Yesod, in the same style as formlets. See [the forms chapter](http://www.yesodweb.com/book/forms) of the Yesod book. -This package provies a set of basic form inputs such as text, number, time, +This package provides a set of basic form inputs such as text, number, time, checkbox, select, textarea, and etc. via `Yesod.Form.Fields` module. Also, there is `Yesod.Form.Nic` module providing richtext field using Nic editor. However, this module is grandfathered now and Nic editor is not actively diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index f242131b..5f7255d8 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -813,11 +813,11 @@ selectFieldHelper outside onOpt inside grpHdr opts' = Field , fieldView = \theId name attrs val isReq -> do outside theId name attrs $ do optsFlat <- fmap (olOptions.flattenOptionList) $ handlerToWidget opts' - unless isReq $ onOpt theId name $ not $ render optsFlat val `elem` map optionExternalValue optsFlat + unless isReq $ onOpt theId name $ render optsFlat val `notElem` map optionExternalValue optsFlat opts'' <- handlerToWidget opts' case opts'' of - (OptionList{}) -> constructOptions theId name attrs val isReq optsFlat - (OptionListGrouped{olOptionsGrouped=grps}) -> do + OptionList{} -> constructOptions theId name attrs val isReq optsFlat + OptionListGrouped{olOptionsGrouped=grps} -> do forM_ grps $ \(grp, opts) -> do case grpHdr of Just hdr -> hdr grp @@ -841,7 +841,7 @@ selectFieldHelper outside onOpt inside grpHdr opts' = Field name ((if isReq then (("required", "required"):) else id) attrs) (optionExternalValue opt) - ((render opts val) == optionExternalValue opt) + (render opts val == optionExternalValue opt) (optionDisplay opt) -- | Creates an input with @type="file"@. @@ -939,7 +939,7 @@ prependZero t0 = if T.null t1 then "-0." `T.append` (T.drop 2 t1) else t1 - where t1 = T.dropWhile ((==) ' ') t0 + where t1 = T.dropWhile (==' ') t0 -- $optionsOverview -- These functions create inputs where one or more options can be selected from a list. From 7ffff2532652ac9788647f04a5506a0bf2bd8896 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 09:40:34 +0200 Subject: [PATCH 08/10] Add some type annotations --- yesod-form/Yesod/Form/Fields.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 5f7255d8..7dbaf3c4 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -3,6 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE CPP #-} -- | Field functions allow you to easily create and validate forms, cleanly handling the uncertainty of parsing user input. @@ -681,7 +682,7 @@ optionsPairs opts = do -- -- @since 1.7.0 optionsPairsGrouped - :: (MonadHandler m, RenderMessage (HandlerSite m) msg) + :: forall m msg a. (MonadHandler m, RenderMessage (HandlerSite m) msg) => [(msg, [(msg, a)])] -> m (OptionList a) optionsPairsGrouped opts = do mr <- getMessageRender @@ -690,14 +691,14 @@ optionsPairsGrouped opts = do , optionInternalValue = internal , optionExternalValue = pack $ show external } - opts' = enumerateSublists opts -- :: [(msg, [(Int, (msg, a))])] + opts' = enumerateSublists opts :: [(msg, [(Int, (msg, a))])] opts'' = map (\(x, ys) -> (mr x, map mkOption ys)) opts' return $ mkOptionListGrouped opts'' -- | Helper to enumerate sublists with one consecutive index. -enumerateSublists :: [(a, [b])] -> [(a, [(Int, b)])] +enumerateSublists :: forall a b. [(a, [b])] -> [(a, [(Int, b)])] enumerateSublists xss = - let -- yss :: [(Int, (a, [b]))] + let yss :: [(Int, (a, [b]))] yss = snd $ foldl (\(i, res) xs -> (i + (length.snd) xs, res ++ [(i, xs)])) (1, []) xss in map (\(i, (x, ys)) -> (x, zip [i :: Int ..] ys)) yss From 08b5150ac0042254bc66b81c9a72095c88d18d91 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 13:46:03 +0200 Subject: [PATCH 09/10] Fix typo --- demo/subsite/WikiRoutes.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/subsite/WikiRoutes.hs b/demo/subsite/WikiRoutes.hs index f22c0222..0e340449 100644 --- a/demo/subsite/WikiRoutes.hs +++ b/demo/subsite/WikiRoutes.hs @@ -21,7 +21,7 @@ data Wiki = Wiki } -- | A typeclass that all master sites that want a Wiki must implement. A --- master must be able to render form messages, as we use yesod-forms for +-- master must be able to render form messages, as we use yesod-form for -- processing user input. class (RenderMessage master FormMessage, Yesod master) => YesodWiki master where -- | Write protection. By default, no protection. From 73a85310c6985658fe74b5e0485bbc8e2f3a13ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Wed, 14 Apr 2021 13:46:53 +0200 Subject: [PATCH 10/10] Relax version constraints for yesod-form --- yesod-auth-oauth/yesod-auth-oauth.cabal | 2 +- yesod-auth/yesod-auth.cabal | 2 +- yesod-form-multi/yesod-form-multi.cabal | 2 +- yesod/yesod.cabal | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal index 8c1ee7f4..3a3f5ce6 100644 --- a/yesod-auth-oauth/yesod-auth-oauth.cabal +++ b/yesod-auth-oauth/yesod-auth-oauth.cabal @@ -22,7 +22,7 @@ library , unliftio , yesod-auth >= 1.6 && < 1.7 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 exposed-modules: Yesod.Auth.OAuth ghc-options: -Wall diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index b6be336c..039051f1 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -57,7 +57,7 @@ library , unordered-containers , wai >= 1.4 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 , yesod-persistent >= 1.6 if flag(network-uri) diff --git a/yesod-form-multi/yesod-form-multi.cabal b/yesod-form-multi/yesod-form-multi.cabal index 7e576ead..f8b7c983 100644 --- a/yesod-form-multi/yesod-form-multi.cabal +++ b/yesod-form-multi/yesod-form-multi.cabal @@ -26,7 +26,7 @@ library , text >= 0.9 , transformers >= 0.2.2 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 if flag(network-uri) build-depends: network-uri >= 2.6 diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 42e36729..21e51b95 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -38,7 +38,7 @@ library , warp >= 1.3 , yaml >= 0.8.17 , yesod-core >= 1.6 && < 1.7 - , yesod-form >= 1.6 && < 1.7 + , yesod-form >= 1.6 && < 1.8 , yesod-persistent >= 1.6 && < 1.7 exposed-modules: Yesod