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

Merge branch 'master' into yesod-1.4

Browse Source
This commit is contained in:
Michael Snoyman 2014-09-21 00:07:11 +03:00
commit f86d181377
14 changed files with 123 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
yesod-auth/Yesod/Auth/GoogleEmail2.hs
View File

@ -156,7 +156,7 @@ authGoogleEmail clientID clientSecret =
manager <- liftM authHttpManager $ lift getYesod
res <- http req manager
value <- responseBody res $$+- sinkParser json'
Tokens accessToken _idToken tokenType <-
Tokens accessToken tokenType <-
case parseEither parseJSON value of
Left e -> error e
Right t -> return t
@ -184,11 +184,10 @@ authGoogleEmail clientID clientSecret =
dispatch _ _ = notFound
data Tokens = Tokens Text Text Text
data Tokens = Tokens Text Text
instance FromJSON Tokens where
parseJSON = withObject "Tokens" $ \o -> Tokens
<$> o .: "access_token"
<*> o .: "id_token"
<*> o .: "token_type"
data Person = Person [Email]

7
yesod-auth/browserid.hs
View File

@ -26,7 +26,7 @@ mkYesod "BID" [parseRoutes|
getRootR :: Handler ()
getRootR = redirect $ AuthR LoginR
getAfterLoginR :: Handler RepHtml
getAfterLoginR :: Handler Html
getAfterLoginR = do
mauth <- maybeAuthId
defaultLayout $ toWidget [hamlet|
@ -41,13 +41,14 @@ instance YesodAuth BID where
loginDest _ = AfterLoginR
logoutDest _ = AuthR LoginR
getAuthId = return . Just . credsIdent
authPlugins _ = [authBrowserId]
authPlugins _ = [authBrowserId def]
authHttpManager = httpManager
maybeAuthId = lookupSession credsKey
instance RenderMessage BID FormMessage where
renderMessage _ _ = defaultFormMessage
main :: IO ()
main = do
m <- newManager def
m <- newManager conduitManagerSettings
toWaiApp (BID m) >>= run 3000 . logStdoutDev

2
yesod-auth/yesod-auth.cabal
View File

@ -1,5 +1,5 @@
name: yesod-auth
version: 1.3.4.3
version: 1.3.4.6
license: MIT
license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin

16
yesod-bin/hsfiles/mongo.hsfiles
View File

@ -188,7 +188,7 @@ instance Yesod App where
, css_bootstrap_css
])
$(widgetFile "default-layout")
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs
@ -230,7 +230,7 @@ instance Yesod App where
-- How to run database actions.
instance YesodPersist App where
type YesodPersistBackend App = Action
type YesodPersistBackend App = MongoContext
runDB = defaultRunDB persistConfig connPool
instance YesodAuth App where
@ -359,9 +359,7 @@ import Prelude
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
let mongoSettings = (mkPersistSettings (ConT ''MongoBackend))
{ mpsGeneric = False
}
let mongoSettings = (mkPersistSettings (ConT ''MongoContext))
in share [mkPersist mongoSettings]
$(persistFileWith upperCaseSettings "config/models")
@ -411,15 +409,15 @@ library
build-depends: base >= 4 && < 5
, yesod >= 1.2.5 && < 1.3
, yesod-core >= 1.2.12 && < 1.3
, yesod-core >= 1.2.20 && < 1.3
, yesod-auth >= 1.3 && < 1.4
, yesod-static >= 1.2 && < 1.3
, yesod-form >= 1.3 && < 1.4
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0
, persistent >= 1.3 && < 1.4
, persistent-mongoDB >= 1.3 && < 1.5
, persistent-template >= 1.3 && < 1.4
, persistent >= 2.0 && < 2.1
, persistent-mongoDB >= 2.0 && < 2.1
, persistent-template >= 2.0 && < 2.1
, template-haskell
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2

16
yesod-bin/hsfiles/mysql.hsfiles
View File

@ -130,7 +130,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
import qualified Settings
import Settings.Development (development)
import qualified Database.Persist
import Database.Persist.Sql (SqlPersistT)
import Database.Persist.Sql (SqlBackend)
import Settings.StaticFiles
import Settings (widgetFile, Extra (..))
import Model
@ -195,7 +195,7 @@ instance Yesod App where
, css_bootstrap_css
])
$(widgetFile "default-layout")
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs
@ -237,7 +237,7 @@ instance Yesod App where
-- How to run database actions.
instance YesodPersist App where
type YesodPersistBackend App = SqlPersistT
type YesodPersistBackend App = SqlBackend
runDB = defaultRunDB persistConfig connPool
instance YesodPersistRunner App where
getDBRunner = defaultGetDBRunner connPool
@ -366,7 +366,7 @@ import Prelude
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
{-# START_FILE PROJECTNAME.cabal #-}
@ -415,15 +415,15 @@ library
build-depends: base >= 4 && < 5
, yesod >= 1.2.5 && < 1.3
, yesod-core >= 1.2.12 && < 1.3
, yesod-core >= 1.2.20 && < 1.3
, yesod-auth >= 1.3 && < 1.4
, yesod-static >= 1.2 && < 1.3
, yesod-form >= 1.3 && < 1.4
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0
, persistent >= 1.3 && < 1.4
, persistent-mysql >= 1.3 && < 1.4
, persistent-template >= 1.3 && < 1.4
, persistent >= 2.0 && < 2.1
, persistent-mysql >= 2.0 && < 2.1
, persistent-template >= 2.0 && < 2.1
, template-haskell
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2

16
yesod-bin/hsfiles/postgres-fay.hsfiles
View File

@ -133,7 +133,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
import qualified Settings
import Settings.Development (development)
import qualified Database.Persist
import Database.Persist.Sql (SqlPersistT)
import Database.Persist.Sql (SqlBackend)
import Settings.StaticFiles
import Settings (widgetFile, Extra (..))
import Model
@ -199,7 +199,7 @@ instance Yesod App where
, css_bootstrap_css
])
$(widgetFile "default-layout")
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs
@ -250,7 +250,7 @@ instance YesodFay App where
-- How to run database actions.
instance YesodPersist App where
type YesodPersistBackend App = SqlPersistT
type YesodPersistBackend App = SqlBackend
runDB = defaultRunDB persistConfig connPool
instance YesodPersistRunner App where
getDBRunner = defaultGetDBRunner connPool
@ -398,7 +398,7 @@ import Prelude
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
{-# START_FILE PROJECTNAME.cabal #-}
@ -451,7 +451,7 @@ library
build-depends: base >= 4 && < 5
, yesod >= 1.2.5 && < 1.3
, yesod-core >= 1.2.12 && < 1.3
, yesod-core >= 1.2.20 && < 1.3
, yesod-auth >= 1.3 && < 1.4
, yesod-static >= 1.2 && < 1.3
, yesod-form >= 1.3 && < 1.4
@ -459,9 +459,9 @@ library
, fay >= 0.16
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0
, persistent >= 1.3 && < 1.4
, persistent-postgresql >= 1.3 && < 1.4
, persistent-template >= 1.3 && < 1.4
, persistent >= 2.0 && < 2.1
, persistent-postgresql >= 2.0 && < 2.1
, persistent-template >= 2.0 && < 2.1
, template-haskell
, shakespeare >= 2.0 && < 2.1
, monad-control >= 0.3 && < 0.4

16
yesod-bin/hsfiles/postgres.hsfiles
View File

@ -130,7 +130,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
import qualified Settings
import Settings.Development (development)
import qualified Database.Persist
import Database.Persist.Sql (SqlPersistT)
import Database.Persist.Sql (SqlBackend)
import Settings.StaticFiles
import Settings (widgetFile, Extra (..))
import Model
@ -195,7 +195,7 @@ instance Yesod App where
, css_bootstrap_css
])
$(widgetFile "default-layout")
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs
@ -237,7 +237,7 @@ instance Yesod App where
-- How to run database actions.
instance YesodPersist App where
type YesodPersistBackend App = SqlPersistT
type YesodPersistBackend App = SqlBackend
runDB = defaultRunDB persistConfig connPool
instance YesodPersistRunner App where
getDBRunner = defaultGetDBRunner connPool
@ -366,7 +366,7 @@ import Prelude
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
{-# START_FILE PROJECTNAME.cabal #-}
@ -415,15 +415,15 @@ library
build-depends: base >= 4 && < 5
, yesod >= 1.2.5 && < 1.3
, yesod-core >= 1.2.12 && < 1.3
, yesod-core >= 1.2.20 && < 1.3
, yesod-auth >= 1.3 && < 1.4
, yesod-static >= 1.2 && < 1.3
, yesod-form >= 1.3 && < 1.4
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0
, persistent >= 1.3 && < 1.4
, persistent-postgresql >= 1.3 && < 1.4
, persistent-template >= 1.3 && < 1.4
, persistent >= 2.0 && < 2.1
, persistent-postgresql >= 2.0 && < 2.1
, persistent-template >= 2.0 && < 2.1
, template-haskell
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2

4
yesod-bin/hsfiles/simple.hsfiles
View File

@ -174,7 +174,7 @@ instance Yesod App where
, css_bootstrap_css
])
$(widgetFile "default-layout")
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs
@ -342,7 +342,7 @@ library
build-depends: base >= 4 && < 5
, yesod >= 1.2.5 && < 1.3
, yesod-core >= 1.2.12 && < 1.3
, yesod-core >= 1.2.20 && < 1.3
, yesod-auth >= 1.3 && < 1.4
, yesod-static >= 1.2 && < 1.3
, yesod-form >= 1.3 && < 1.4

16
yesod-bin/hsfiles/sqlite.hsfiles
View File

@ -130,7 +130,7 @@ import Network.HTTP.Client.Conduit (Manager, HasHttpManager (getHttpManager))
import qualified Settings
import Settings.Development (development)
import qualified Database.Persist
import Database.Persist.Sql (SqlPersistT)
import Database.Persist.Sql (SqlBackend)
import Settings.StaticFiles
import Settings (widgetFile, Extra (..))
import Model
@ -195,7 +195,7 @@ instance Yesod App where
, css_bootstrap_css
])
$(widgetFile "default-layout")
giveUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
-- This is done to provide an optimization for serving static files from
-- a separate domain. Please see the staticRoot setting in Settings.hs
@ -237,7 +237,7 @@ instance Yesod App where
-- How to run database actions.
instance YesodPersist App where
type YesodPersistBackend App = SqlPersistT
type YesodPersistBackend App = SqlBackend
runDB = defaultRunDB persistConfig connPool
instance YesodPersistRunner App where
getDBRunner = defaultGetDBRunner connPool
@ -366,7 +366,7 @@ import Prelude
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"]
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "config/models")
{-# START_FILE PROJECTNAME.cabal #-}
@ -415,15 +415,15 @@ library
build-depends: base >= 4 && < 5
, yesod >= 1.2.5 && < 1.3
, yesod-core >= 1.2.12 && < 1.3
, yesod-core >= 1.2.20 && < 1.3
, yesod-auth >= 1.3 && < 1.4
, yesod-static >= 1.2 && < 1.3
, yesod-form >= 1.3 && < 1.4
, bytestring >= 0.9 && < 0.11
, text >= 0.11 && < 2.0
, persistent >= 1.3 && < 1.4
, persistent-sqlite >= 1.3 && < 1.4
, persistent-template >= 1.3 && < 1.4
, persistent >= 2.0 && < 2.1
, persistent-sqlite >= 2.0 && < 2.1
, persistent-template >= 2.0 && < 2.1
, template-haskell
, shakespeare >= 2.0 && < 2.1
, hjsmin >= 0.1 && < 0.2

2
yesod-bin/yesod-bin.cabal
View File

@ -1,5 +1,5 @@
name: yesod-bin
version: 1.2.12.8
version: 1.2.13
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

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

@ -45,6 +45,7 @@ module Yesod.Form.Functions
, fieldSettingsLabel
, parseHelper
, parseHelperGen
, convertField
) where
import Yesod.Form.Types
@ -526,3 +527,29 @@ parseHelperGen :: (Monad m, RenderMessage site msg)
parseHelperGen _ [] _ = return $ Right Nothing
parseHelperGen _ ("":_) _ = return $ Right Nothing
parseHelperGen f (x:_) _ = return $ either (Left . SomeMessage) (Right . Just) $ f x
-- | Since a 'Field' cannot be a 'Functor', it is not obvious how to "reuse" a Field
-- on a @newtype@ or otherwise equivalent type. This function allows you to convert
-- a @Field m a@ to a @Field m b@ assuming you provide a bidireccional
-- convertion among the two, through the first two functions.
--
-- A simple example:
--
-- > import Data.Monoid
-- > sumField :: (Functor m, Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m (Sum Int)
-- > sumField = convertField Sum getSum intField
--
-- Another example, not using a newtype, but instead creating a Lazy Text field:
--
-- > import qualified Data.Text.Lazy as TL
-- > TextField :: (Functor m, Monad m, RenderMessage (HandlerSite m) FormMessage) => Field m TL.Text
-- > lazyTextField = convertField TL.fromStrict TL.toStrict textField
--
-- Since 1.3.16
convertField :: (Functor m)
=> (a -> b) -> (b -> a)
-> Field m a -> Field m b
convertField to from (Field fParse fView fEnctype) = let
fParse' ts = fmap (fmap (fmap to)) . fParse ts
fView' ti tn at ei = fView ti tn at (fmap from ei)
in Field fParse' fView' fEnctype

2
yesod-form/yesod-form.cabal
View File

@ -1,5 +1,5 @@
name: yesod-form
version: 1.3.15.4
version: 1.3.16
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

92
yesod-test/Yesod/Test/CssQuery.hs
View File

@ -9,7 +9,10 @@ module Yesod.Test.CssQuery
import Prelude hiding (takeWhile)
import Data.Text (Text)
import Data.Attoparsec.Text
import Control.Applicative (many, (<|>), optional)
import Control.Applicative
import Data.Char
import qualified Data.Text as T
data SelectorGroup
= DirectChildren [Selector]
@ -27,6 +30,13 @@ data Selector
| ByAttrEnds Text Text
deriving (Show, Eq)
-- The official syntax specification for CSS2 can be found here:
-- http://www.w3.org/TR/CSS2/syndata.html
-- but that spec is tricky to fully support. Instead we do the minimal and we
-- can extend it as needed.
-- | Parses a query into an intermediate format which is easy to feed to HXT
--
-- * The top-level lists represent the top level comma separated queries.
@ -41,66 +51,54 @@ parseQuery = parseOnly cssQuery
-- Below this line is the Parsec parser for css queries.
cssQuery :: Parser [[SelectorGroup]]
cssQuery = sepBy rules (char ',' >> (optional (char ' ')))
cssQuery = sepBy rules (char ',' >> optional (char ' '))
rules :: Parser [SelectorGroup]
rules = many $ directChildren <|> deepChildren
directChildren :: Parser SelectorGroup
directChildren = do
_ <- char '>'
_ <- char ' '
sels <- selectors
_ <- optional $ char ' '
return $ DirectChildren sels
directChildren = string "> " >> DirectChildren <$> parseSelectors
deepChildren :: Parser SelectorGroup
deepChildren = do
sels <- selectors
_ <- optional $ char ' '
return $ DeepChildren sels
selectors :: Parser [Selector]
selectors = many1 $ parseId
<|> parseClass
<|> parseTag
<|> parseAttr
deepChildren = DeepChildren <$> parseSelectors
parseSelectors :: Parser [Selector]
parseSelectors = pOptionalTrailingSpace . many1 $
parseId <|> parseClass <|> parseTag <|> parseAttr
parseId :: Parser Selector
parseId = do
_ <- char '#'
x <- takeWhile $ flip notElem ",#.[ >"
return $ ById x
parseId = char '#' >> ById <$> pIdent
parseClass :: Parser Selector
parseClass = do
_ <- char '.'
x <- takeWhile $ flip notElem ",#.[ >"
return $ ByClass x
parseClass = char '.' >> ByClass <$> pIdent
parseTag :: Parser Selector
parseTag = do
x <- takeWhile1 $ flip notElem ",#.[ >"
return $ ByTagName x
parseTag = ByTagName <$> pIdent
parseAttr :: Parser Selector
parseAttr = do
_ <- char '['
name <- takeWhile $ flip notElem ",#.=$^*]"
(parseAttrExists name)
<|> (parseAttrWith "=" ByAttrEquals name)
<|> (parseAttrWith "*=" ByAttrContains name)
<|> (parseAttrWith "^=" ByAttrStarts name)
<|> (parseAttrWith "$=" ByAttrEnds name)
parseAttr = pSquare $ choice
[ ByAttrEquals <$> pIdent <*> (string "=" *> pAttrValue)
, ByAttrContains <$> pIdent <*> (string "*=" *> pAttrValue)
, ByAttrStarts <$> pIdent <*> (string "^=" *> pAttrValue)
, ByAttrEnds <$> pIdent <*> (string "$=" *> pAttrValue)
, ByAttrExists <$> pIdent
]
parseAttrExists :: Text -> Parser Selector
parseAttrExists attrname = do
_ <- char ']'
return $ ByAttrExists attrname
-- | pIdent : Parse an identifier (not yet supporting escapes and unicode as
-- part of the identifier). Basically the regex: [-]?[_a-zA-Z][_a-zA-Z0-9]*
pIdent :: Parser Text
pIdent = pOptionalTrailingSpace $ do
leadingMinus <- string "-" <|> pure ""
nmstart <- T.singleton <$> satisfy (\c -> isAlpha c || c == '_')
nmchar <- takeWhile (\c -> isAlphaNum c || c == '_')
return $ T.concat [ leadingMinus, nmstart, nmchar ]
parseAttrWith :: Text -> (Text -> Text -> Selector) -> Text -> Parser Selector
parseAttrWith sign constructor name = do
_ <- string sign
value <- takeWhile $ flip notElem ",#.]"
_ <- char ']'
return $ constructor name value
pAttrValue :: Parser Text
pAttrValue = takeWhile (/= ']')
pSquare :: Parser a -> Parser a
pSquare p = char '[' *> p <* char ']'
pOptionalTrailingSpace :: Parser a -> Parser a
pOptionalTrailingSpace p = p <* optional (char ' ')

2
yesod-test/yesod-test.cabal
View File

@ -1,5 +1,5 @@
name: yesod-test
version: 1.2.5
version: 1.2.6
license: MIT
license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar>