yesod-form compiles again

yesod-form/Yesod/Form/Class.hs

@@ -17,7 +17,6 @@ import Data.Time (Day, TimeOfDay)
 import Data.Text (Text)
 import Yesod.Handler (GGHandler)
 import Yesod.Message (RenderMessage)
-import Control.Monad.IO.Class (MonadIO) -- FIXME
 
 {-
 class ToForm a where

yesod-form/Yesod/Form/Input.hs

@@ -35,7 +35,7 @@ instance Applicative (FormInput sub master) where
             (_, Left b) -> Left b
             (Right a, Right b) -> Right $ a b
 
-ireq :: (RenderMessage master msg, RenderMessage master FormMessage) => Field sub master a -> Text -> FormInput sub master a
+ireq :: (RenderMessage master FormMessage) => Field sub master a -> Text -> FormInput sub master a
 ireq field name = FormInput $ \m l env -> do
       let filteredEnv = fromMaybe [] $ Map.lookup name env
       emx <- fieldParse field $ filteredEnv
@@ -44,7 +44,7 @@ ireq field name = FormInput $ \m l env -> do
           Right Nothing -> Left $ (:) $ renderMessage m l $ MsgInputNotFound name
           Right (Just a) -> Right a
 
-iopt :: RenderMessage master msg => Field sub master a -> Text -> FormInput sub master (Maybe a)
+iopt :: Field sub master a -> Text -> FormInput sub master (Maybe a)
 iopt field name = FormInput $ \m l env -> do
       let filteredEnv = fromMaybe [] $ Map.lookup name env
       emx <- fieldParse field $ filteredEnv

yesod-form/Yesod/Form/Jquery.hs

@@ -27,6 +27,7 @@ import Text.Julius (julius)
 import Control.Monad.Trans.Class (lift)
 import Data.Text (Text, pack, unpack)
 import Data.Monoid (mconcat)
+import Yesod.Core (RenderMessage)
 
 #if __GLASGOW_HASKELL__ >= 700
 #define HTML html
@@ -65,12 +66,12 @@ class YesodJquery a where
     urlJqueryUiDateTimePicker :: a -> Either (Route a) Text
     urlJqueryUiDateTimePicker _ = Right "http://github.com/gregwebs/jquery.ui.datetimepicker/raw/master/jquery.ui.datetimepicker.js"
 
-blank :: (Text -> Either msg a) -> [Text] -> Either msg (Maybe a)
-blank _ [] = Right Nothing
-blank _ ("":_) = Right Nothing
-blank f (x:_) = either Left (Right . Just) $ f x
+blank :: (RenderMessage master FormMessage, Monad m) => (Text -> Either FormMessage a) -> [Text] -> m (Either (SomeMessage master) (Maybe a))
+blank _ [] = return $ Right Nothing
+blank _ ("":_) = return $ Right Nothing
+blank f (x:_) = return $ either (Left . SomeMessage) (Right . Just) $ f x
 
-jqueryDayField :: (YesodJquery master) => JqueryDaySettings -> Field (GWidget sub master ()) FormMessage Day
+jqueryDayField :: (RenderMessage master FormMessage, YesodJquery master) => JqueryDaySettings -> Field sub master Day
 jqueryDayField jds = Field
     { fieldParse = blank $ maybe
                   (Left MsgInvalidDay)
@@ -125,7 +126,7 @@ jqueryDayTimeUTCTime (UTCTime day utcTime) =
       let (h, apm) = if hour < 12 then (hour, "AM") else (hour - 12, "PM")
       in (showLeadingZero h) ++ ":" ++ (showLeadingZero minute) ++ " " ++ apm
 
-jqueryDayTimeField :: YesodJquery master => Field (GWidget sub master ()) FormMessage UTCTime
+jqueryDayTimeField :: (RenderMessage master FormMessage, YesodJquery master) => Field sub master UTCTime
 jqueryDayTimeField = Field
     { fieldParse  = blank $ parseUTCTime . unpack
     , fieldView = \theId name val isReq -> do
@@ -154,7 +155,8 @@ parseUTCTime s =
                 ifRight (parseTime timeS)
                     (UTCTime date . timeOfDayToTime)
 
-jqueryAutocompleteField :: YesodJquery master => Route master -> Field (GWidget sub master ()) FormMessage Text
+jqueryAutocompleteField :: (RenderMessage master FormMessage, YesodJquery master)
+                        => Route master -> Field sub master Text
 jqueryAutocompleteField src = Field
     { fieldParse = blank $ Right
     , fieldView = \theId name val isReq -> do

yesod-form/Yesod/Form/Nic.hs

@@ -20,22 +20,16 @@ import Text.Blaze.Renderer.String (renderHtml)
 import Text.Blaze (preEscapedString)
 import Control.Monad.Trans.Class (lift)
 import Data.Text (Text, pack, unpack)
+import Data.Maybe (listToMaybe)
 
 class YesodNic a where
     -- | NIC Editor Javascript file.
     urlNicEdit :: a -> Either (Route a) Text
     urlNicEdit _ = Right "http://js.nicedit.com/nicEdit-latest.js"
 
-blank :: (Text -> Either msg a) -> [Text] -> Either msg (Maybe a)
-blank _ [] = Right Nothing
-blank _ ("":_) = Right Nothing
-blank f (x:_) = either Left (Right . Just) $ f x
-
-
-
-nicHtmlField :: YesodNic master => Field (GWidget sub master ()) msg Html
+nicHtmlField :: YesodNic master => Field sub master Html
 nicHtmlField = Field
-    { fieldParse = blank $ Right . preEscapedString . sanitizeBalance . unpack -- FIXME
+    { fieldParse = return . Right . fmap (preEscapedString . sanitizeBalance . unpack) . listToMaybe -- FIXME
     , fieldView = \theId name val _isReq -> do
         addHtml
 #if __GLASGOW_HASKELL__ >= 700