Merge branch 'master' of github.com:yesodweb/yesod

yesod-auth/Yesod/Auth/GoogleEmail2.hs

@@ -30,15 +30,20 @@ import           Blaze.ByteString.Builder (fromByteString, toByteString)
 import           Control.Applicative      ((<$>), (<*>))
 import           Control.Arrow            (second)
 import           Control.Monad            (liftM, unless)
+import qualified Data.Aeson               as A
+import qualified Data.Aeson.Encode        as A
 import           Data.Aeson.Parser        (json')
 import           Data.Aeson.Types         (FromJSON (parseJSON), parseEither,
                                            withObject)
 import           Data.Conduit             (($$+-))
 import           Data.Conduit.Attoparsec  (sinkParser)
+import qualified Data.HashMap.Strict      as M
 import           Data.Monoid              (mappend)
 import           Data.Text                (Text)
 import qualified Data.Text                as T
 import           Data.Text.Encoding       (decodeUtf8, encodeUtf8)
+import qualified Data.Text.Lazy           as TL
+import qualified Data.Text.Lazy.Builder   as TL
 import           Network.HTTP.Client      (parseUrl, requestHeaders,
                                            responseBody, urlEncodedBody)
 import           Network.HTTP.Conduit     (http)
@@ -175,7 +180,7 @@ authGoogleEmail clientID clientSecret =
                 [e] -> return e
                 [] -> error "No account email"
                 x -> error $ "Too many account emails: " ++ show x
-        lift $ setCredsRedirect $ Creds pid email []
+        lift $ setCredsRedirect $ Creds pid email $ allPersonInfo value2
 
     dispatch _ _ = notFound
 
@@ -200,3 +205,9 @@ instance FromJSON Email where
     parseJSON = withObject "Email" $ \o -> Email
         <$> o .: "value"
         <*> o .: "type"
+
+allPersonInfo :: A.Value -> [(Text, Text)]
+allPersonInfo (A.Object o) = map enc $ M.toList o
+    where enc (key, A.String s) = (key, s)
+          enc (key, v) = (key, TL.toStrict $ TL.toLazyText $ A.encodeToTextBuilder v)
+allPersonInfo _ = []

yesod-bin/AddHandler.hs

@@ -22,20 +22,28 @@ addHandler = do
             [] -> error "No cabal file found"
             _ -> error "Too many cabal files found"
 
-    putStr "Name of route (without trailing R): "
+    let routeInput = do
-    hFlush stdout
+        putStr "Name of route (without trailing R): "
-    name <- getLine
+        hFlush stdout
-    case name of
+        name <- getLine
-        [] -> error "Please provide a name"
+        case name of
-        c:_
+            [] -> error "No name entered. Quitting ..."
-            | isLower c -> error "Name must start with an upper case letter"
+            c:_
-            | otherwise -> return ()
+                | isLower c -> do
-
+                    putStrLn "Name must start with an upper case letter"
-    -- Check that the handler file doesn't already exist
+                    routeInput
-    let handlerFile = concat ["Handler/", name, ".hs"]
+                | otherwise -> do
-    exists <- doesFileExist handlerFile
+                    -- Check that the handler file doesn't already exist
-    when exists $ error $ "File already exists: " ++ show handlerFile
+                    let handlerFile = concat ["Handler/", name, ".hs"]
+                    exists <- doesFileExist handlerFile
+                    if exists
+                        then do
+                            putStrLn $ "File already exists: " ++ show handlerFile
+                            putStrLn "Try another name or leave blank to exit"
+                            routeInput
+                        else return (name, handlerFile)
 
+    (name, handlerFile) <- routeInput
     putStr "Enter route pattern (ex: /entry/#EntryId): "
     hFlush stdout
     pattern <- getLine

yesod-form/Yesod/Form/Nic.hs

@@ -26,10 +26,10 @@ class Yesod a => YesodNic a where
 nicHtmlField :: YesodNic site => Field (HandlerT site IO) Html
 nicHtmlField = Field
     { fieldParse = \e _ -> return . Right . fmap (preEscapedToMarkup . sanitizeBalance) . listToMaybe $ e
-    , fieldView = \theId name attrs val _isReq -> do
+    , fieldView = \theId name attrs val isReq -> do
         toWidget [shamlet|
 $newline never
-    <textarea id="#{theId}" *{attrs} name="#{name}" .html>#{showVal val}
+    <textarea id="#{theId}" *{attrs} name="#{name}" :isReq:required .html>#{showVal val}
 |]
         addScript' urlNicEdit
         master <- getYesod