Everything building with Hamlet 0.10, scaffolding not fixed yet

This commit is contained in:
Michael Snoyman 2011-08-09 16:48:24 +03:00
parent 70a7f52055
commit f6ab5c05dc
11 changed files with 49 additions and 30 deletions

View File

@ -178,11 +178,12 @@ maybeAuthId = do
Just s -> return $ fromSinglePiece s Just s -> return $ fromSinglePiece s
maybeAuth :: ( YesodAuth m maybeAuth :: ( YesodAuth m
, Key val ~ AuthId m , b ~ YesodPersistBackend m
, PersistBackend (YesodDB m (GGHandler s m IO)) , Key b val ~ AuthId m
, PersistBackend b (GGHandler s m IO)
, PersistEntity val , PersistEntity val
, YesodPersist m , YesodPersist m
) => GHandler s m (Maybe (Key val, val)) ) => GHandler s m (Maybe (Key b val, val))
maybeAuth = runMaybeT $ do maybeAuth = runMaybeT $ do
aid <- MaybeT $ maybeAuthId aid <- MaybeT $ maybeAuthId
a <- MaybeT $ runDB $ get aid a <- MaybeT $ runDB $ get aid
@ -192,11 +193,12 @@ requireAuthId :: YesodAuth m => GHandler s m (AuthId m)
requireAuthId = maybeAuthId >>= maybe redirectLogin return requireAuthId = maybeAuthId >>= maybe redirectLogin return
requireAuth :: ( YesodAuth m requireAuth :: ( YesodAuth m
, Key val ~ AuthId m , b ~ YesodPersistBackend m
, PersistBackend (YesodDB m (GGHandler s m IO)) , Key b val ~ AuthId m
, PersistBackend b (GGHandler s m IO)
, PersistEntity val , PersistEntity val
, YesodPersist m , YesodPersist m
) => GHandler s m (Key val, val) ) => GHandler s m (Key b val, val)
requireAuth = maybeAuth >>= maybe redirectLogin return requireAuth = maybeAuth >>= maybe redirectLogin return
redirectLogin :: Yesod m => GHandler s m a redirectLogin :: Yesod m => GHandler s m a

View File

@ -65,7 +65,8 @@ module Yesod.Auth.HashDB
, authHashDB , authHashDB
, getAuthIdHashDB , getAuthIdHashDB
-- * Predefined data type -- * Predefined data type
, User(..) , User
, UserG (..)
, UserId , UserId
, migrateUsers , migrateUsers
) where ) where
@ -127,11 +128,12 @@ setPassword pwd u = do salt <- randomSalt
-- | Given a user ID and password in plaintext, validate them against -- | Given a user ID and password in plaintext, validate them against
-- the database values. -- the database values.
validateUser :: ( YesodPersist yesod validateUser :: ( YesodPersist yesod
, PersistBackend (YesodDB yesod (GGHandler sub yesod IO)) , b ~ YesodPersistBackend yesod
, PersistBackend b (GGHandler sub yesod IO)
, PersistEntity user , PersistEntity user
, HashDBUser user , HashDBUser user
) => ) =>
Unique user -- ^ User unique identifier Unique user b -- ^ User unique identifier
-> Text -- ^ Password in plaint-text -> Text -- ^ Password in plaint-text
-> GHandler sub yesod Bool -> GHandler sub yesod Bool
validateUser userID passwd = do validateUser userID passwd = do
@ -151,9 +153,10 @@ login = PluginR "hashdb" ["login"]
-- | Handle the login form. First parameter is function which maps -- | Handle the login form. First parameter is function which maps
-- username (whatever it might be) to unique user ID. -- username (whatever it might be) to unique user ID.
postLoginR :: ( YesodAuth y, YesodPersist y postLoginR :: ( YesodAuth y, YesodPersist y
, b ~ YesodPersistBackend y
, HashDBUser user, PersistEntity user , HashDBUser user, PersistEntity user
, PersistBackend (YesodDB y (GGHandler Auth y IO))) , PersistBackend b (GGHandler Auth y IO))
=> (Text -> Maybe (Unique user)) => (Text -> Maybe (Unique user b))
-> GHandler Auth y () -> GHandler Auth y ()
postLoginR uniq = do postLoginR uniq = do
(mu,mp) <- runInputPost $ (,) (mu,mp) <- runInputPost $ (,)
@ -173,10 +176,11 @@ postLoginR uniq = do
-- can be used if authHashDB is the only plugin in use. -- can be used if authHashDB is the only plugin in use.
getAuthIdHashDB :: ( YesodAuth master, YesodPersist master getAuthIdHashDB :: ( YesodAuth master, YesodPersist master
, HashDBUser user, PersistEntity user , HashDBUser user, PersistEntity user
, Key user ~ AuthId master , Key b user ~ AuthId master
, PersistBackend (YesodDB master (GGHandler sub master IO))) , b ~ YesodPersistBackend master
, PersistBackend b (GGHandler sub master IO))
=> (AuthRoute -> Route master) -- ^ your site's Auth Route => (AuthRoute -> Route master) -- ^ your site's Auth Route
-> (Text -> Maybe (Unique user)) -- ^ gets user ID -> (Text -> Maybe (Unique user b)) -- ^ gets user ID
-> Creds master -- ^ the creds argument -> Creds master -- ^ the creds argument
-> GHandler sub master (Maybe (AuthId master)) -> GHandler sub master (Maybe (AuthId master))
getAuthIdHashDB authR uniq creds = do getAuthIdHashDB authR uniq creds = do
@ -200,8 +204,9 @@ getAuthIdHashDB authR uniq creds = do
authHashDB :: ( YesodAuth m, YesodPersist m authHashDB :: ( YesodAuth m, YesodPersist m
, HashDBUser user , HashDBUser user
, PersistEntity user , PersistEntity user
, PersistBackend (YesodDB m (GGHandler Auth m IO))) , b ~ YesodPersistBackend m
=> (Text -> Maybe (Unique user)) -> AuthPlugin m , PersistBackend b (GGHandler Auth m IO))
=> (Text -> Maybe (Unique user b)) -> AuthPlugin m
authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
[QQ(hamlet)| [QQ(hamlet)|
<div id="header"> <div id="header">
@ -239,7 +244,7 @@ authHashDB uniq = AuthPlugin "hashdb" dispatch $ \tm -> addHamlet
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Generate data base instances for a valid user -- | Generate data base instances for a valid user
share2 mkPersist (mkMigrate "migrateUsers") share2 (mkPersist sqlSettings) (mkMigrate "migrateUsers")
[QQ(persist)| [QQ(persist)|
User User
username Text Eq username Text Eq
@ -248,7 +253,7 @@ User
UniqueUser username UniqueUser username
|] |]
instance HashDBUser User where instance HashDBUser (UserG backend) where
userPasswordHash = Just . userPassword userPasswordHash = Just . userPassword
userPasswordSalt = Just . userSalt userPasswordSalt = Just . userSalt
setUserHashAndSalt s h u = u { userSalt = s setUserHashAndSalt s h u = u { userSalt = s

View File

@ -32,7 +32,8 @@ library
, mime-mail >= 0.3 && < 0.4 , mime-mail >= 0.3 && < 0.4
, blaze-html >= 0.4 && < 0.5 , blaze-html >= 0.4 && < 0.5
, yesod-persistent >= 0.2 && < 0.3 , yesod-persistent >= 0.2 && < 0.3
, hamlet >= 0.9 && < 0.10 , hamlet >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11
, yesod-json >= 0.2 && < 0.3 , yesod-json >= 0.2 && < 0.3
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5
, yesod-form >= 0.3 && < 0.4 , yesod-form >= 0.3 && < 0.4

View File

@ -17,7 +17,7 @@ import qualified Data.ByteString as S
import Data.Text.Encoding (decodeUtf8) import Data.Text.Encoding (decodeUtf8)
import Data.Char (isSpace, toLower, toUpper) import Data.Char (isSpace, toLower, toUpper)
import Data.Ord (comparing) import Data.Ord (comparing)
import Text.Shakespeare (Deref (..), Ident (..), parseHash, derefToExp) import Text.Shakespeare.Base (Deref (..), Ident (..), parseHash, derefToExp)
import Text.ParserCombinators.Parsec (parse, many, eof, many1, noneOf, (<|>)) import Text.ParserCombinators.Parsec (parse, many, eof, many1, noneOf, (<|>))
import Control.Arrow ((***)) import Control.Arrow ((***))
import Data.Monoid (mempty, mappend) import Data.Monoid (mempty, mappend)

View File

@ -29,12 +29,15 @@ library
build-depends: base >= 4 && < 4.3 build-depends: base >= 4 && < 4.3
build-depends: time >= 1.1.4 && < 1.3 build-depends: time >= 1.1.4 && < 1.3
, wai >= 0.4 && < 0.5 , wai >= 0.4 && < 0.5
, wai-extra >= 0.4 && < 0.5 , wai-extra >= 0.4.1 && < 0.5
, bytestring >= 0.9.1.4 && < 0.10 , bytestring >= 0.9.1.4 && < 0.10
, text >= 0.5 && < 0.12 , text >= 0.5 && < 0.12
, template-haskell , template-haskell
, path-pieces >= 0.0 && < 0.1 , path-pieces >= 0.0 && < 0.1
, hamlet >= 0.9 && < 0.10 , hamlet >= 0.10 && < 0.11
, shakespeare >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11
, blaze-builder >= 0.2.1 && < 0.4 , blaze-builder >= 0.2.1 && < 0.4
, transformers >= 0.2 && < 0.3 , transformers >= 0.2 && < 0.3
, clientsession >= 0.6 && < 0.7 , clientsession >= 0.6 && < 0.7

View File

@ -15,7 +15,9 @@ library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10 , yesod-core >= 0.9 && < 0.10
, time >= 1.1.4 && < 1.3 , time >= 1.1.4 && < 1.3
, hamlet >= 0.9 && < 0.10 , hamlet >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, persistent >= 0.6 && < 0.7 , persistent >= 0.6 && < 0.7
, yesod-persistent >= 0.2 && < 0.3 , yesod-persistent >= 0.2 && < 0.3
, template-haskell , template-haskell

View File

@ -16,7 +16,7 @@ library
, yesod-core >= 0.9 && < 0.10 , yesod-core >= 0.9 && < 0.10
, aeson >= 0.3.1.1 && < 0.3.2.10 , aeson >= 0.3.1.1 && < 0.3.2.10
, text >= 0.8 && < 0.12 , text >= 0.8 && < 0.12
, hamlet >= 0.9 && < 0.10 , shakespeare-js >= 0.10 && < 0.11
, vector , vector
, containers , containers
, blaze-textual >= 0.1 && < 0.2 , blaze-textual >= 0.1 && < 0.2

View File

@ -15,7 +15,7 @@ library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10 , yesod-core >= 0.9 && < 0.10
, time >= 1.1.4 && < 1.3 , time >= 1.1.4 && < 1.3
, hamlet >= 0.9 && < 0.10 , hamlet >= 0.10 && < 0.11
, bytestring >= 0.9 && < 0.10 , bytestring >= 0.9 && < 0.10
, text >= 0.9 && < 1.0 , text >= 0.9 && < 1.0
exposed-modules: Yesod.AtomFeed exposed-modules: Yesod.AtomFeed

View File

@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module Yesod.Persist module Yesod.Persist
( YesodPersist (..) ( YesodPersist (..)
, YesodDB
, get404 , get404
, getBy404 , getBy404
, module Database.Persist , module Database.Persist
@ -11,13 +12,16 @@ module Yesod.Persist
import Database.Persist import Database.Persist
import Database.Persist.TH import Database.Persist.TH
import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.IO.Class (MonadIO)
import Control.Failure (Failure) import Control.Failure (Failure)
import Yesod.Handler import Yesod.Handler
class YesodPersist y where type YesodDB sub master = YesodPersistBackend master (GGHandler sub master IO)
type YesodDB y :: (* -> *) -> * -> *
runDB :: YesodDB y (GGHandler sub y IO) a -> GHandler sub y a class YesodPersist master where
type YesodPersistBackend master :: (* -> *) -> * -> *
runDB :: MonadIO monad => YesodDB sub master a -> GGHandler sub master monad a
-- | Get the given entity by ID, or return a 404 not found if it doesn't exist. -- | Get the given entity by ID, or return a 404 not found if it doesn't exist.
get404 :: (PersistBackend t m, PersistEntity val, Monad (t m), get404 :: (PersistBackend t m, PersistEntity val, Monad (t m),

View File

@ -15,7 +15,7 @@ library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.9 && < 0.10 , yesod-core >= 0.9 && < 0.10
, time >= 1.1.4 && < 1.3 , time >= 1.1.4 && < 1.3
, hamlet >= 0.9 && < 0.10 , hamlet >= 0.10 && < 0.11
exposed-modules: Yesod.Sitemap exposed-modules: Yesod.Sitemap
ghc-options: -Wall ghc-options: -Wall

View File

@ -72,7 +72,9 @@ library
, transformers >= 0.2 && < 0.3 , transformers >= 0.2 && < 0.3
, wai >= 0.4 && < 0.5 , wai >= 0.4 && < 0.5
, wai-extra >= 0.4.1 && < 0.5 , wai-extra >= 0.4.1 && < 0.5
, hamlet >= 0.9 && < 0.10 , hamlet >= 0.10 && < 0.11
, shakespeare-js >= 0.10 && < 0.11
, shakespeare-css >= 0.10 && < 0.11
, warp >= 0.4 && < 0.5 , warp >= 0.4 && < 0.5
, mime-mail >= 0.3 && < 0.4 , mime-mail >= 0.3 && < 0.4
, hjsmin >= 0.0.13 && < 0.1 , hjsmin >= 0.0.13 && < 0.1