diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Changelog +## 1.7.0.3 + +* Support `yesod-core` 1.7 + ## 1.7.0.2 * Allow yesod-form 1.7 diff --git a/Yesod/Form/MultiInput.hs b/Yesod/Form/MultiInput.hs --- a/Yesod/Form/MultiInput.hs +++ b/Yesod/Form/MultiInput.hs @@ -1,12 +1,16 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeOperators #-} +#if !MIN_VERSION_shakespeare(2,0,18) +{-# OPTIONS_GHC -Wno-orphans #-} +#endif -- | A module providing a means of creating multiple input forms without -- the need to submit the form to generate a new input field unlike @@ -35,14 +39,11 @@ import Yesod.Form.Functions import Yesod.Form.Types -#ifdef MIN_VERSION_shakespeare(2,0,18) -#if MIN_VERSION_shakespeare(2,0,18) -#else +#if !MIN_VERSION_shakespeare(2,0,18) import Text.Julius (ToJavascript (..)) instance ToJavascript String where toJavascript = toJavascript . toJSON instance ToJavascript Text where toJavascript = toJavascript . toJSON #endif -#endif -- | By default delete buttons have a @margin-left@ property of @0.75rem@. -- You can override this by specifying an alternative value in a class @@ -65,7 +66,7 @@ -- both the field and it's corresponding delete button. -- -- The structure is illustrated by the following: --- +-- -- >
-- >
-- > ^{fieldWidget} @@ -76,7 +77,7 @@ -- is returned in the 'MultiView' should you wish to change the styling. The inner wrapper -- uses the same class followed by @-inner@. By default the wrapper and inner wrapper has -- classes are as follows: --- +-- -- > .#{wrapperClass} { -- > margin-bottom: 1rem; -- > } @@ -105,7 +106,7 @@ "has-error" Nothing Nothing (Just errW) where - errW err = + errW err = [whamlet| #{err} |] @@ -140,7 +141,7 @@ where addIcon = Just [shamlet||] delIcon = Just [shamlet||] - errW err = + errW err = [whamlet| #{err} |] @@ -184,7 +185,10 @@ mform = do (fr, MultiView {..}) <- mmulti field fs defs minVals ms - let (fv : _) = mvFields + let fv = + case mvFields of + [] -> error "amulti: expected at least one input field" + inputField : _ -> inputField widget = do [whamlet| $maybe tooltip <- fvTooltip fv @@ -205,7 +209,7 @@ , fvErrors = fvErrors mvAddBtn , fvRequired = False } - + return (fr, view) -- | Converts a form field into a monadic form containing an arbitrary @@ -235,7 +239,7 @@ -> Int -> MultiSettings site -> MForm m (FormResult [a], MultiView site) -mhelperMulti field@Field {..} fs@FieldSettings {..} wrapperClass defs minVals MultiSettings {..} = do +mhelperMulti field fs@FieldSettings{..} wrapperClass defs minVals MultiSettings{..} = do mp <- askParams (_, site, langs) <- ask name <- maybe newFormIdent return fsName @@ -258,7 +262,7 @@ _ -> False mfs <- askFiles - + -- get counter value (starts counting from 0) cr@(cRes, _) <- case mp of Nothing -> return (FormMissing, Right cDef) @@ -332,7 +336,7 @@ $('##{rawJS delBtnId}').click(function() { var field = $('##{rawJS fieldId}'); deleteField_#{rawJS theId}(field.parents('.#{rawJS wrapperClass}')); - }); + }); |] -- generate field views @@ -348,19 +352,19 @@ zs -> zs rvs <- mapM mkView' ys return $ unzip rvs - + -- check values let rs' = [ fmap fromJust r | r <- rs , not $ isSuccNothing r ] err = T.pack $ "Please enter at least " ++ show minVals ++ " values." - (res, tooFewVals) = + (res, tooFewVals) = case foldr (<*>) (FormSuccess []) (map (fmap $ (:)) rs') of FormSuccess xs -> if length xs < minVals then (FormFailure [err], True) else (FormSuccess xs, False) fRes -> (fRes, False) - + -- create add button -- also includes some styling / functions that we only want to include once btnWidget = do @@ -392,7 +396,7 @@ var newName = #{name} + "-" + newNumber; var newId = #{theId} + "-" + newNumber; var newDelId = #{delBtnPrefix} + newId; - + // get new wrapper and remove old error messages var newWrapper = $('.#{rawJS wrapperClass}').first().clone(); newWrapper.children( ':not(.#{rawJS wrapperClass}-inner)' ).remove(); @@ -458,7 +462,7 @@ -> (site -> [Text] -> FormResult b) -> (a -> FormResult b) -> MForm m (FormResult b, Either Text a) -mkRes Field {..} FieldSettings {..} p mfs name onMissing onFound = do +mkRes Field{..} _ p mfs name onMissing onFound = do tell fieldEnctype (_, site, langs) <- ask let mvals = fromMaybe [] $ Map.lookup name p @@ -468,7 +472,7 @@ Left msg -> (FormFailure [renderMessage site langs msg], maybe (Left "") Left (listToMaybe mvals)) Right mx -> case mx of - Nothing -> (onMissing site langs, Left "") + Nothing -> (onMissing site langs, Left "") Just x -> (onFound x, Right x) -- Generate a FieldView for the given field with the given result. @@ -485,7 +489,7 @@ -> Text -> Bool -> MForm m (FieldView site) -mkView Field {..} FieldSettings {..} (res, val) mdel merrW errClass theId name isReq = do +mkView Field{..} FieldSettings{..} (res, val) mdel merrW errClass theId name isReq = do (_, site, langs) <- ask let mr2 = renderMessage site langs merr = case res of @@ -499,11 +503,11 @@
^{fv'} ^{delBtn} - + $maybe err <- merr $maybe errW <- merrW ^{errW err} - + $nothing ^{fv'} |] diff --git a/yesod-form-multi.cabal b/yesod-form-multi.cabal --- a/yesod-form-multi.cabal +++ b/yesod-form-multi.cabal @@ -1,5 +1,5 @@ name: yesod-form-multi -version: 1.7.0.2 +version: 1.7.0.3 license: MIT license-file: LICENSE author: James Burton @@ -25,7 +25,7 @@ , shakespeare >= 2.0 , text >= 0.9 , transformers >= 0.2.2 - , yesod-core >= 1.6 && < 1.7 + , yesod-core >= 1.6 && < 1.8 , yesod-form >= 1.6 && < 1.8 if flag(network-uri)