From f8a95f058e8e61be426378fe4fb83ed634cc5380 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 29 Dec 2011 15:39:54 +0200
Subject: [PATCH] Fixed yesod-form

---
 yesod-form/Yesod/Form/Fields.hs    | 22 ++++++++++------------
 yesod-form/Yesod/Form/Functions.hs | 13 ++++++-------
 yesod-form/Yesod/Form/Input.hs     |  8 ++++----
 yesod-form/Yesod/Form/Jquery.hs    |  5 ++---
 yesod-form/Yesod/Form/MassInput.hs |  3 +--
 yesod-form/Yesod/Form/Nic.hs       |  3 +--
 yesod-form/Yesod/Form/Types.hs     |  8 ++++----
 7 files changed, 28 insertions(+), 34 deletions(-)

diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs
index 53ef9903..d3fa50c1 100644
--- a/yesod-form/Yesod/Form/Fields.hs
+++ b/yesod-form/Yesod/Form/Fields.hs
@@ -69,14 +69,12 @@ import qualified Data.ByteString.Lazy as L
 import Data.Text (Text, unpack, pack)
 import qualified Data.Text as T
 import qualified Data.Text.Read
-import Control.Monad.Trans.Class (lift)
 
-import Control.Applicative ((<$>))
 import qualified Data.Map as Map
-import Yesod.Handler (newIdent, liftIOHandler)
+import Yesod.Handler (newIdent)
 import Yesod.Request (FileInfo)
 
-import Yesod.Core (toPathPiece, GHandler, GHandlerT, PathPiece)
+import Yesod.Core (toPathPiece, GHandler, PathPiece)
 import Yesod.Persist (selectList, runDB, Filter, SelectOpt, YesodPersistBackend, Key, YesodPersist, PersistEntity, PersistQuery)
 import Control.Arrow ((&&&))
 
@@ -307,7 +305,7 @@ urlField = Field
 selectField :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a
 selectField = selectField' . optionsPairs
 
-selectField' :: (Eq a, RenderMessage master FormMessage) => GHandlerT sub master IO (OptionList a) -> Field sub master a
+selectField' :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
 selectField' = selectFieldHelper
     (\theId name inside -> [WHAMLET|<select ##{theId} name=#{name}>^{inside}|]) -- outside
     (\_theId _name isSel -> [WHAMLET|<option value=none :isSel:selected>_{MsgSelectNone}|]) -- onOpt
@@ -321,7 +319,7 @@ multiSelectField = multiSelectFieldHelper
 radioField :: (Eq a, RenderMessage master FormMessage) => [(Text, a)] -> Field sub master a
 radioField = radioField' . optionsPairs
 
-radioField' :: (Eq a, RenderMessage master FormMessage) => GHandlerT sub master IO (OptionList a) -> Field sub master a
+radioField' :: (Eq a, RenderMessage master FormMessage) => GHandler sub master (OptionList a) -> Field sub master a
 radioField' = selectFieldHelper
     (\theId _name inside -> [WHAMLET|<div ##{theId}>^{inside}|])
     (\theId name isSel -> [WHAMLET|
@@ -402,14 +400,14 @@ data Option a = Option
     , optionExternalValue :: Text
     }
 
-optionsPairs :: [(Text, a)] -> GHandlerT sub master IO (OptionList a)
+optionsPairs :: [(Text, a)] -> GHandler sub master (OptionList a)
 optionsPairs = return . mkOptionList . zipWith (\external (display, internal) -> Option
     { optionDisplay = display
     , optionInternalValue = internal
     , optionExternalValue = pack $ show external
     }) [1 :: Int ..]
 
-optionsEnum :: (Show a, Enum a, Bounded a) => GHandlerT sub master IO (OptionList a)
+optionsEnum :: (Show a, Enum a, Bounded a) => GHandler sub master (OptionList a)
 optionsEnum = optionsPairs $ map (\x -> (pack $ show x, x)) [minBound..maxBound]
 
 optionsPersist :: ( YesodPersist master, PersistEntity a
@@ -430,13 +428,13 @@ selectFieldHelper
         => (Text -> Text -> GWidget sub master () -> GWidget sub master ())
         -> (Text -> Text -> Bool -> GWidget sub master ())
         -> (Text -> Text -> [Text] -> Text -> Bool -> Text -> GWidget sub master ())
-        -> GHandlerT sub master IO (OptionList a) -> Field sub master a
+        -> 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 theClass val isReq -> do
-        opts <- fmap olOptions $ lift $ liftIOHandler opts'
+        opts <- fmap olOptions $ liftWidget opts'
         outside theId name $ do
             unless isReq $ onOpt theId name $ not $ render opts val `elem` map optionExternalValue opts
             flip mapM_ opts $ \opt -> inside
@@ -466,7 +464,7 @@ fileAFormReq fs = AForm $ \(master, langs) menvs ints -> do
                 Nothing ->
                     let i' = incrInts ints
                      in (pack $ 'f' : show i', i')
-    id' <- maybe (pack <$> newIdent) return $ fsId fs
+    id' <- maybe newIdent return $ fsId fs
     let (res, errs) =
             case menvs of
                 Nothing -> (FormMissing, Nothing)
@@ -497,7 +495,7 @@ fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
                 Nothing ->
                     let i' = incrInts ints
                      in (pack $ 'f' : show i', i')
-    id' <- maybe (pack <$> newIdent) return $ fsId fs
+    id' <- maybe newIdent return $ fsId fs
     let (res, errs) =
             case menvs of
                 Nothing -> (FormMissing, Nothing)
diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs
index abd16359..b7d82b33 100644
--- a/yesod-form/Yesod/Form/Functions.hs
+++ b/yesod-form/Yesod/Form/Functions.hs
@@ -40,8 +40,8 @@ import Control.Monad.Trans.RWS (ask, get, put, runRWST, tell, evalRWST)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad (liftM, join)
 import Text.Blaze (Html, toHtml)
-import Yesod.Handler (GHandler, GHandlerT, getRequest, runRequestBody, newIdent, getYesod)
-import Yesod.Core (RenderMessage, liftIOHandler, SomeMessage (..))
+import Yesod.Handler (GHandler, getRequest, runRequestBody, newIdent, getYesod)
+import Yesod.Core (RenderMessage, SomeMessage (..))
 import Yesod.Widget (GWidget, whamlet)
 import Yesod.Request (reqNonce, reqWaiRequest, reqGetParams, languages, FileInfo (..))
 import Network.Wai (requestMethod)
@@ -49,7 +49,6 @@ import Text.Hamlet (shamlet)
 import Data.Monoid (mempty)
 import Data.Maybe (listToMaybe, fromMaybe)
 import Yesod.Message (RenderMessage (..))
-import Control.Monad.IO.Class (MonadIO)
 import qualified Data.Map as Map
 import qualified Data.ByteString.Lazy as L
 
@@ -118,7 +117,7 @@ mhelper :: RenderMessage master msg
 mhelper Field {..} FieldSettings {..} mdef onMissing onFound isReq = do
     mp <- askParams
     name <- maybe newFormIdent return fsName
-    theId <- lift $ maybe (liftM pack newIdent) return fsId
+    theId <- lift $ maybe newIdent return fsId
     (_, master, langs) <- ask
     let mr2 = renderMessage master langs
     (res, val) <-
@@ -157,8 +156,8 @@ aopt :: RenderMessage master msg
      -> AForm sub master (Maybe a)
 aopt a b = formToAForm . mopt a b
 
-runFormGeneric :: MonadIO m => MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GHandlerT sub master m (a, Enctype)
-runFormGeneric form master langs env = liftIOHandler $ evalRWST form (env, master, langs) (IntSingle 1)
+runFormGeneric :: MForm sub master a -> master -> [Text] -> Maybe (Env, FileEnv) -> GHandler sub master (a, Enctype)
+runFormGeneric form master langs env = evalRWST form (env, master, langs) (IntSingle 1)
 
 -- | This function is used to both initially render a form and to later extract
 -- results from it. Note that, due to CSRF protection and a few other issues,
@@ -299,7 +298,7 @@ checkBool :: RenderMessage master msg
 checkBool b s = check $ \x -> if b x then Right x else Left s
 
 checkM :: RenderMessage master msg
-       => (a -> GHandlerT sub master IO (Either msg a))
+       => (a -> GHandler sub master (Either msg a))
        -> Field sub master a
        -> Field sub master a
 checkM f field = field
diff --git a/yesod-form/Yesod/Form/Input.hs b/yesod-form/Yesod/Form/Input.hs
index 62fcfcdb..289234a1 100644
--- a/yesod-form/Yesod/Form/Input.hs
+++ b/yesod-form/Yesod/Form/Input.hs
@@ -11,7 +11,7 @@ module Yesod.Form.Input
 import Yesod.Form.Types
 import Data.Text (Text)
 import Control.Applicative (Applicative (..))
-import Yesod.Handler (GHandler, GHandlerT, invalidArgs, runRequestBody, getRequest, getYesod, liftIOHandler)
+import Yesod.Handler (GHandler, invalidArgs, runRequestBody, getRequest, getYesod)
 import Yesod.Request (reqGetParams, languages)
 import Control.Monad (liftM)
 import Yesod.Message (RenderMessage (..), SomeMessage (..))
@@ -19,7 +19,7 @@ import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
 
 type DText = [Text] -> [Text]
-newtype FormInput sub master a = FormInput { unFormInput :: master -> [Text] -> Env -> GHandlerT sub master IO (Either DText a) }
+newtype FormInput sub master a = FormInput { unFormInput :: master -> [Text] -> Env -> GHandler sub master (Either DText a) }
 instance Functor (FormInput sub master) where
     fmap a (FormInput f) = FormInput $ \c d e -> fmap (either Left (Right . a)) $ f c d e
 instance Applicative (FormInput sub master) where
@@ -55,7 +55,7 @@ runInputGet (FormInput f) = do
     env <- liftM (toMap . reqGetParams) getRequest
     m <- getYesod
     l <- languages
-    emx <- liftIOHandler $ f m l env
+    emx <- f m l env
     case emx of
         Left errs -> invalidArgs $ errs []
         Right x -> return x
@@ -68,7 +68,7 @@ runInputPost (FormInput f) = do
     env <- liftM (toMap . fst) runRequestBody
     m <- getYesod
     l <- languages
-    emx <- liftIOHandler $ f m l env
+    emx <- f m l env
     case emx of
         Left errs -> invalidArgs $ errs []
         Right x -> return x
diff --git a/yesod-form/Yesod/Form/Jquery.hs b/yesod-form/Yesod/Form/Jquery.hs
index 710088c7..8121d36a 100644
--- a/yesod-form/Yesod/Form/Jquery.hs
+++ b/yesod-form/Yesod/Form/Jquery.hs
@@ -25,7 +25,6 @@ import Data.Char (isSpace)
 import Data.Default
 import Text.Hamlet (shamlet)
 import Text.Julius (julius)
-import Control.Monad.Trans.Class (lift)
 import Data.Text (Text, pack, unpack)
 import Data.Monoid (mconcat)
 import Yesod.Core (RenderMessage, SomeMessage (..))
@@ -174,12 +173,12 @@ $(function(){$("##{theId}").autocomplete({source:"@{src}",minLength:2})});
 
 addScript' :: (master -> Either (Route master) Text) -> GWidget sub master ()
 addScript' f = do
-    y <- lift getYesod
+    y <- liftWidget getYesod
     addScriptEither $ f y
 
 addStylesheet' :: (y -> Either (Route y) Text) -> GWidget sub y ()
 addStylesheet' f = do
-    y <- lift getYesod
+    y <- liftWidget getYesod
     addStylesheetEither $ f y
 
 readMay :: Read a => String -> Maybe a
diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs
index 7cb80bc0..661cc0b8 100644
--- a/yesod-form/Yesod/Form/MassInput.hs
+++ b/yesod-form/Yesod/Form/MassInput.hs
@@ -17,7 +17,6 @@ import Yesod.Message (RenderMessage)
 import Yesod.Handler (newIdent, GHandler)
 import Text.Blaze (Html)
 import Control.Monad.Trans.Class (lift)
-import Data.Text (pack)
 import Control.Monad.Trans.RWS (get, put, ask)
 import Data.Maybe (fromMaybe)
 import Data.Text.Read (decimal)
@@ -82,7 +81,7 @@ inputList label fixXml single mdef = formToAForm $ do
     return (res, FieldView
         { fvLabel = label
         , fvTooltip = Nothing
-        , fvId = pack theId
+        , fvId = theId
         , fvInput = [WHAMLET|
 ^{fixXml views}
 <p>
diff --git a/yesod-form/Yesod/Form/Nic.hs b/yesod-form/Yesod/Form/Nic.hs
index 582ca451..390babd9 100644
--- a/yesod-form/Yesod/Form/Nic.hs
+++ b/yesod-form/Yesod/Form/Nic.hs
@@ -18,7 +18,6 @@ import Text.Hamlet (Html, shamlet)
 import Text.Julius (julius)
 import Text.Blaze.Renderer.String (renderHtml)
 import Text.Blaze (preEscapedText)
-import Control.Monad.Trans.Class (lift)
 import Data.Text (Text, pack)
 import qualified Data.Text as T
 import Data.Maybe (listToMaybe)
@@ -55,5 +54,5 @@ bkLib.onDomLoaded(function(){new nicEditor({fullPanel:true}).panelInstance("#{th
 
 addScript' :: (y -> Either (Route y) Text) -> GWidget sub y ()
 addScript' f = do
-    y <- lift getYesod
+    y <- liftWidget getYesod
     addScriptEither $ f y
diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs
index 58f6b417..94b440fe 100644
--- a/yesod-form/Yesod/Form/Types.hs
+++ b/yesod-form/Yesod/Form/Types.hs
@@ -26,7 +26,7 @@ import Text.Blaze (Html, ToHtml (toHtml))
 import Control.Applicative ((<$>), Applicative (..))
 import Control.Monad (liftM)
 import Data.String (IsString (..))
-import Yesod.Core (GHandlerT, GWidget, SomeMessage)
+import Yesod.Core (GHandler, GWidget, SomeMessage)
 import qualified Data.Map as Map
 
 -- | A form can produce three different results: there was no data available,
@@ -74,10 +74,10 @@ type Env = Map.Map Text [Text]
 type FileEnv = Map.Map Text FileInfo
 
 type Lang = Text
-type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GHandlerT sub master IO) a
+type MForm sub master a = RWST (Maybe (Env, FileEnv), master, [Lang]) Enctype Ints (GHandler sub master) a
 
 newtype AForm sub master a = AForm
-    { unAForm :: (master, [Text]) -> Maybe (Env, FileEnv) -> Ints -> GHandlerT sub master IO (FormResult a, [FieldView sub master] -> [FieldView sub master], Ints, Enctype)
+    { unAForm :: (master, [Text]) -> Maybe (Env, FileEnv) -> Ints -> GHandler sub master (FormResult a, [FieldView sub master] -> [FieldView sub master], Ints, Enctype)
     }
 instance Functor (AForm sub master) where
     fmap f (AForm a) =
@@ -115,7 +115,7 @@ data FieldView sub master = FieldView
     }
 
 data Field sub master a = Field
-    { fieldParse :: [Text] -> GHandlerT sub master IO (Either (SomeMessage master) (Maybe a))
+    { fieldParse :: [Text] -> GHandler sub master (Either (SomeMessage master) (Maybe a))
     -- | ID, name, class, (invalid text OR legimiate result), required?
     , fieldView :: Text
                 -> Text