diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index bfe3d897..04afd433 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/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 _ = [] diff --git a/yesod-bin/AddHandler.hs b/yesod-bin/AddHandler.hs index ca3a6ce3..9c59c59b 100644 --- a/yesod-bin/AddHandler.hs +++ b/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): " - hFlush stdout - name <- getLine - case name of - [] -> error "Please provide a name" - c:_ - | isLower c -> error "Name must start with an upper case letter" - | otherwise -> return () - - -- Check that the handler file doesn't already exist - let handlerFile = concat ["Handler/", name, ".hs"] - exists <- doesFileExist handlerFile - when exists $ error $ "File already exists: " ++ show handlerFile + let routeInput = do + putStr "Name of route (without trailing R): " + hFlush stdout + name <- getLine + case name of + [] -> error "No name entered. Quitting ..." + c:_ + | isLower c -> do + putStrLn "Name must start with an upper case letter" + routeInput + | otherwise -> do + -- Check that the handler file doesn't already exist + 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 diff --git a/yesod-form/Yesod/Form/Nic.hs b/yesod-form/Yesod/Form/Nic.hs index 28626789..7e4af077 100644 --- a/yesod-form/Yesod/Form/Nic.hs +++ b/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 -