parent
39485f7243
commit
332e83a111
@ -689,7 +689,7 @@ jsonField hide = Field{..}
|
||||
inputType
|
||||
| hide = "hidden"
|
||||
| otherwise = "text"
|
||||
fieldParse [v] [] = return . bimap (SomeMessage . MsgJSONFieldDecodeFailure) Just . eitherDecodeStrict' $ encodeUtf8 v
|
||||
fieldParse [encodeUtf8 -> v] [] = return . bimap (SomeMessage . MsgJSONFieldDecodeFailure) Just $ eitherDecodeStrict' v <|> eitherDecodeStrict' (urlDecode True v)
|
||||
fieldParse [] [] = return $ Right Nothing
|
||||
fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
|
||||
fieldView theId name attrs val isReq = liftWidgetT [whamlet|
|
||||
|
||||
@ -641,8 +641,12 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
, fieldEnctype = UrlEncoded
|
||||
}
|
||||
|
||||
piPrevious <- lift . runInputMaybe $ ireq (jsonField True) (wIdent "pagination")
|
||||
let piPreviousRes = maybe FormMissing FormSuccess piPrevious
|
||||
piPreviousPost <- lift . runInputPost $ iopt (jsonField True) (wIdent "pagination")
|
||||
piPreviousGet <- lift . runInputGet $ iopt (jsonField True) (wIdent "pagination")
|
||||
let
|
||||
piPreviousRes = maybe FormMissing FormSuccess $ piPreviousPost <|> piPreviousGet
|
||||
$logDebugS "dbTable" [st|#{wIdent "pagination"}: #{tshow piPreviousRes}|]
|
||||
|
||||
previousKeys <- throwExceptT . runMaybeT $ encodedSecretBoxOpen =<< MaybeT (lift . lookupPostParam $ wIdent "previous")
|
||||
|
||||
piInput <- lift . runInputGetResult $ PaginationInput
|
||||
|
||||
@ -621,18 +621,25 @@ formResult' (FormFailure _) = Nothing
|
||||
formResult' (FormSuccess x) = Just x
|
||||
|
||||
runInputGetMaybe, runInputPostMaybe, runInputMaybe :: MonadHandler m => FormInput m a -> m (Maybe a)
|
||||
runInputGetMaybe form = do
|
||||
res <- runInputGetResult form
|
||||
return $ case res of
|
||||
FormSuccess suc -> Just suc
|
||||
_other -> Nothing
|
||||
runInputPostMaybe form = do
|
||||
res <- runInputPostResult form
|
||||
return $ case res of
|
||||
FormSuccess suc -> Just suc
|
||||
_other -> Nothing
|
||||
runInputGetMaybe = fmap formResult' . runInputGetResult
|
||||
runInputPostMaybe = fmap formResult' . runInputPostResult
|
||||
runInputMaybe form = runMaybeT $ MaybeT (runInputPostMaybe form) <|> MaybeT (runInputGetMaybe form)
|
||||
|
||||
runInputResult :: MonadHandler m => FormInput m a -> m (FormResult a)
|
||||
runInputResult form = do
|
||||
postRes <- runInputPostResult form
|
||||
getRes <- runInputGetResult form
|
||||
return $ case (postRes, getRes) of
|
||||
(FormSuccess a, _) -> FormSuccess a
|
||||
(_, FormSuccess b) -> FormSuccess b
|
||||
(postRes', _) -> postRes'
|
||||
|
||||
runInput :: (MonadHandler m, RenderMessage (HandlerSite m) FormMessage) => FormInput m a -> m a
|
||||
runInput = runInputResult >=> \case
|
||||
FormFailure errs -> invalidArgs errs
|
||||
FormMissing -> invalidArgsI [MsgValueRequired]
|
||||
FormSuccess a -> return a
|
||||
|
||||
hoistAForm :: HandlerSite m ~ HandlerSite n => (forall a. m a -> n a) -> AForm m b -> AForm n b
|
||||
hoistAForm f (AForm g) = AForm (\x y z ->f $ g x y z)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user