haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix deprecated pragma and follow it ourselves

Browse Source
This commit is contained in:
patrick brisbin 2011-11-24 13:28:06 -05:00
parent c8af14b750
commit d05160f458
3 changed files with 21 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
yesod-form/Yesod/Form/Functions.hs
View File

@ -62,7 +62,7 @@ import qualified Data.ByteString.Lazy as L
#endif #endif
-- | Get a unique identifier. -- | Get a unique identifier.
newFormIdent :: Form sub master Text newFormIdent :: MForm sub master Text
newFormIdent = do newFormIdent = do
i <- get i <- get
let i' = incrInts i let i' = incrInts i
@ -72,12 +72,12 @@ newFormIdent = do
incrInts (IntSingle i) = IntSingle $ i + 1 incrInts (IntSingle i) = IntSingle $ i + 1
incrInts (IntCons i is) = (i + 1) `IntCons` is incrInts (IntCons i is) = (i + 1) `IntCons` is
formToAForm :: Form sub master (FormResult a, FieldView sub master) -> AForm sub master a formToAForm :: MForm sub master (FormResult a, FieldView sub master) -> AForm sub master a
formToAForm form = AForm $ \(master, langs) env ints -> do formToAForm form = AForm $ \(master, langs) env ints -> do
((a, xml), ints', enc) <- runRWST form (env, master, langs) ints ((a, xml), ints', enc) <- runRWST form (env, master, langs) ints
return (a, (:) xml, ints', enc) return (a, (:) xml, ints', enc)
aFormToForm :: AForm sub master a -> Form sub master (FormResult a, [FieldView sub master] -> [FieldView sub master]) aFormToForm :: AForm sub master a -> MForm sub master (FormResult a, [FieldView sub master] -> [FieldView sub master])
aFormToForm (AForm aform) = do aFormToForm (AForm aform) = do
ints <- get ints <- get
(env, master, langs) <- ask (env, master, langs) <- ask
@ -86,24 +86,24 @@ aFormToForm (AForm aform) = do
tell enc tell enc
return (a, xml) return (a, xml)
askParams :: Form sub master (Maybe Env) askParams :: MForm sub master (Maybe Env)
askParams = do askParams = do
(x, _, _) <- ask (x, _, _) <- ask
return $ liftM fst x return $ liftM fst x
askFiles :: Form sub master (Maybe FileEnv) askFiles :: MForm sub master (Maybe FileEnv)
askFiles = do askFiles = do
(x, _, _) <- ask (x, _, _) <- ask
return $ liftM snd x return $ liftM snd x
mreq :: (RenderMessage master msg, RenderMessage master FormMessage) mreq :: (RenderMessage master msg, RenderMessage master FormMessage)
=> Field sub master a -> FieldSettings msg -> Maybe a => Field sub master a -> FieldSettings msg -> Maybe a
-> Form sub master (FormResult a, FieldView sub master) -> MForm sub master (FormResult a, FieldView sub master)
mreq field fs mdef = mhelper field fs mdef (\m l -> FormFailure [renderMessage m l MsgValueRequired]) FormSuccess True mreq field fs mdef = mhelper field fs mdef (\m l -> FormFailure [renderMessage m l MsgValueRequired]) FormSuccess True
mopt :: RenderMessage master msg mopt :: RenderMessage master msg
=> Field sub master a -> FieldSettings msg -> Maybe (Maybe a) => Field sub master a -> FieldSettings msg -> Maybe (Maybe a)
-> Form sub master (FormResult (Maybe a), FieldView sub master) -> MForm sub master (FormResult (Maybe a), FieldView sub master)
mopt field fs mdef = mhelper field fs (join mdef) (const $ const $ FormSuccess Nothing) (FormSuccess . Just) False mopt field fs mdef = mhelper field fs (join mdef) (const $ const $ FormSuccess Nothing) (FormSuccess . Just) False
mhelper :: RenderMessage master msg mhelper :: RenderMessage master msg
@ -113,7 +113,7 @@ mhelper :: RenderMessage master msg
-> (master -> [Text] -> FormResult b) -- ^ on missing -> (master -> [Text] -> FormResult b) -- ^ on missing
-> (a -> FormResult b) -- ^ on success -> (a -> FormResult b) -- ^ on success
-> Bool -- ^ is it required? -> Bool -- ^ is it required?
-> Form sub master (FormResult b, FieldView sub master) -> MForm sub master (FormResult b, FieldView sub master)
mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
mp <- askParams mp <- askParams
@ -157,7 +157,7 @@ aopt :: RenderMessage master msg
-> AForm sub master (Maybe a) -> AForm sub master (Maybe a)
aopt a b = formToAForm . mopt a b aopt a b = formToAForm . mopt a b
runFormGeneric :: MonadIO m => Form sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GGHandler sub master m (a, Enctype) runFormGeneric :: MonadIO m => MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GGHandler sub master m (a, Enctype)
runFormGeneric form master langs env = liftIOHandler $ evalRWST form (env, master, langs) (IntSingle 1) runFormGeneric form master langs env = liftIOHandler $ evalRWST form (env, master, langs) (IntSingle 1)
-- | This function is used to both initially render a form and to later extract -- | This function is used to both initially render a form and to later extract
@ -170,14 +170,14 @@ runFormGeneric form master langs env = liftIOHandler $ evalRWST form (env, maste
-- the form submit to a POST page. In such a case, both the GET and POST -- the form submit to a POST page. In such a case, both the GET and POST
-- handlers should use 'runFormPost'. -- handlers should use 'runFormPost'.
runFormPost :: RenderMessage master FormMessage runFormPost :: RenderMessage master FormMessage
=> (Html -> Form sub master (FormResult a, xml)) => (Html -> MForm sub master (FormResult a, xml))
-> GHandler sub master ((FormResult a, xml), Enctype) -> GHandler sub master ((FormResult a, xml), Enctype)
runFormPost form = do runFormPost form = do
env <- postEnv env <- postEnv
postHelper form env postHelper form env
postHelper :: RenderMessage master FormMessage postHelper :: RenderMessage master FormMessage
=> (Html -> Form sub master (FormResult a, xml)) => (Html -> MForm sub master (FormResult a, xml))
-> Maybe (Env, FileEnv) -> Maybe (Env, FileEnv)
-> GHandler sub master ((FormResult a, xml), Enctype) -> GHandler sub master ((FormResult a, xml), Enctype)
postHelper form env = do postHelper form env = do
@ -204,7 +204,7 @@ postHelper form env = do
-- general usage, you can stick with @runFormPost@. -- general usage, you can stick with @runFormPost@.
generateFormPost generateFormPost
:: RenderMessage master FormMessage :: RenderMessage master FormMessage
=> (Html -> Form sub master (FormResult a, xml)) => (Html -> MForm sub master (FormResult a, xml))
-> GHandler sub master ((FormResult a, xml), Enctype) -> GHandler sub master ((FormResult a, xml), Enctype)
generateFormPost form = postHelper form Nothing generateFormPost form = postHelper form Nothing
@ -220,14 +220,14 @@ postEnv = do
where where
notEmpty = not . L.null . fileContent notEmpty = not . L.null . fileContent
runFormPostNoNonce :: (Html -> Form sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype) runFormPostNoNonce :: (Html -> MForm sub master (FormResult a, xml)) -> GHandler sub master ((FormResult a, xml), Enctype)
runFormPostNoNonce form = do runFormPostNoNonce form = do
langs <- languages langs <- languages
m <- getYesod m <- getYesod
env <- postEnv env <- postEnv
runFormGeneric (form mempty) m langs env runFormGeneric (form mempty) m langs env
runFormGet :: (Html -> Form sub master a) -> GHandler sub master (a, Enctype) runFormGet :: (Html -> MForm sub master a) -> GHandler sub master (a, Enctype)
runFormGet form = do runFormGet form = do
gets <- liftM reqGetParams getRequest gets <- liftM reqGetParams getRequest
let env = let env =
@ -236,13 +236,13 @@ runFormGet form = do
Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty) Just _ -> Just (Map.unionsWith (++) $ map (\(x, y) -> Map.singleton x [y]) gets, Map.empty)
getHelper form env getHelper form env
generateFormGet :: (Html -> Form sub master a) -> GHandler sub master (a, Enctype) generateFormGet :: (Html -> MForm sub master a) -> GHandler sub master (a, Enctype)
generateFormGet form = getHelper form Nothing generateFormGet form = getHelper form Nothing
getKey :: Text getKey :: Text
getKey = "_hasdata" getKey = "_hasdata"
getHelper :: (Html -> Form sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype) getHelper :: (Html -> MForm sub master a) -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
getHelper form env = do getHelper form env = do
let fragment = [HTML|<input type=hidden name=#{getKey}>|] let fragment = [HTML|<input type=hidden name=#{getKey}>|]
langs <- languages langs <- languages
@ -252,7 +252,7 @@ getHelper form env = do
type FormRender sub master a = type FormRender sub master a =
AForm sub master a AForm sub master a
-> Html -> Html
-> Form sub master (FormResult a, GWidget sub master ()) -> MForm sub master (FormResult a, GWidget sub master ())
renderTable, renderDivs :: FormRender sub master a renderTable, renderDivs :: FormRender sub master a
renderTable aform fragment = do renderTable aform fragment = do

6
yesod-form/Yesod/Form/MassInput.hs
View File

@ -35,7 +35,7 @@ import Data.Maybe (listToMaybe)
#define WHAMLET $whamlet #define WHAMLET $whamlet
#endif #endif
down :: Int -> Form sub master () down :: Int -> MForm sub master ()
down 0 = return () down 0 = return ()
down i | i < 0 = error "called down with a negative number" down i | i < 0 = error "called down with a negative number"
down i = do down i = do
@ -43,7 +43,7 @@ down i = do
put $ IntCons 0 is put $ IntCons 0 is
down $ i - 1 down $ i - 1
up :: Int -> Form sub master () up :: Int -> MForm sub master ()
up 0 = return () up 0 = return ()
up i | i < 0 = error "called down with a negative number" up i | i < 0 = error "called down with a negative number"
up i = do up i = do
@ -98,7 +98,7 @@ inputList label fixXml single mdef = formToAForm $ do
withDelete :: (xml ~ GWidget sub master (), RenderMessage master FormMessage) withDelete :: (xml ~ GWidget sub master (), RenderMessage master FormMessage)
=> AForm sub master a => AForm sub master a
-> Form sub master (Either xml (FormResult a, [FieldView sub master])) -> MForm sub master (Either xml (FormResult a, [FieldView sub master]))
withDelete af = do withDelete af = do
down 1 down 1
deleteName <- newFormIdent deleteName <- newFormIdent

2
yesod-form/Yesod/Form/Types.hs
View File

@ -76,7 +76,7 @@ type FileEnv = Map.Map Text FileInfo
type Lang = Text type Lang = Text
type Form sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GGHandler sub master IO) a type Form sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GGHandler sub master IO) a
{-# DEPRECATE Form "Use MForm instead" #-} {-# DEPRECATED Form "Use MForm instead" #-}
type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GGHandler sub master IO) a type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GGHandler sub master IO) a
newtype AForm sub master a = AForm newtype AForm sub master a = AForm