Sorted Contrib stuff into regular hierarchy

This commit is contained in:
Michael Snoyman 2010-06-09 10:26:54 +03:00
parent 59c56c1256
commit 93ad24f969
8 changed files with 58 additions and 55 deletions

View File

@ -10,7 +10,7 @@ module Yesod
, module Yesod.Form
, module Yesod.Hamlet
, module Yesod.Json
, module Yesod.Contrib
, module Yesod.Formable
, Application
, liftIO
, Routes
@ -28,10 +28,10 @@ import Yesod.Dispatch
import Yesod.Request
import Yesod.Form hiding (Form)
import Yesod.Formable
import Yesod.Yesod
import Yesod.Handler hiding (runHandler)
import Network.Wai (Application)
import Yesod.Hamlet
import "transformers" Control.Monad.IO.Class (liftIO)
import Web.Routes.Quasi (Routes)
import Yesod.Contrib

View File

@ -1,9 +0,0 @@
module Yesod.Contrib
( module Yesod.Contrib.Formable
, module Yesod.Contrib.Crud
, module Yesod.Contrib.Persist
) where
import Yesod.Contrib.Formable hiding (runForm)
import Yesod.Contrib.Crud
import Yesod.Contrib.Persist

View File

@ -1,12 +0,0 @@
{-# LANGUAGE TypeFamilies #-}
module Yesod.Contrib.Persist
( YesodPersist (..)
, Persist (..)
) where
import Yesod.Handler
import Database.Persist
class YesodPersist y where
type YesodDB y :: (* -> *) -> * -> *
runDB :: YesodDB y (GHandler sub y) a -> GHandler sub y a

View File

@ -55,8 +55,10 @@ import Data.Time
import Control.Monad
import Data.Maybe
import Web.ClientSession
import qualified Web.ClientSession as CS
import Data.Serialize
import qualified Data.Serialize as Ser
import Network.Wai.Parse
#if TEST
@ -336,7 +338,7 @@ headerToPair _ (DeleteCookie key) =
headerToPair _ (Header key value) =
(W.responseHeaderFromBS $ S.fromString key, S.fromString value)
encodeSession :: Key
encodeSession :: CS.Key
-> UTCTime -- ^ expire time
-> B.ByteString -- ^ remote host
-> [(String, String)] -- ^ session
@ -344,7 +346,7 @@ encodeSession :: Key
encodeSession key expire rhost session' =
encrypt key $ encode $ SessionCookie expire rhost session'
decodeSession :: Key
decodeSession :: CS.Key
-> UTCTime -- ^ current time
-> B.ByteString -- ^ remote host field
-> B.ByteString -- ^ cookie value
@ -363,8 +365,8 @@ instance Serialize SessionCookie where
put (SessionCookie a b c) = putTime a >> put b >> put c
get = do
a <- getTime
b <- get
c <- get
b <- Ser.get
c <- Ser.get
return $ SessionCookie a b c
putTime :: Putter UTCTime
@ -375,8 +377,8 @@ putTime t@(UTCTime d _) = do
getTime :: Get UTCTime
getTime = do
d <- get
ndt <- get
d <- Ser.get
ndt <- Ser.get
return $ fromRational ndt `addUTCTime` UTCTime (ModifiedJulianDay d) 0
#if TEST

View File

@ -3,12 +3,24 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Yesod.Contrib.Formable where
module Yesod.Formable
( Form (..)
, Formlet
, SealedForm (..)
, SealedFormlet
, runForm
, runIncr
, Formable (..)
, Fieldable (..)
, deriveFormable
, share2
, wrapperRow
, sealFormlet
) where
import Text.Hamlet
import Data.Time (Day)
import Control.Applicative
import Web.Routes.Quasi (SinglePiece)
import Database.Persist (Persistable)
import Data.Char (isAlphaNum)
import Language.Haskell.TH.Syntax
@ -19,6 +31,17 @@ import Control.Arrow (first)
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty, mappend)
import qualified Data.ByteString.Lazy.UTF8
import Yesod.Request
import Yesod.Handler
import Control.Monad.IO.Class (liftIO)
import Web.Routes.Quasi
runForm :: SealedForm (Routes y) a
-> GHandler sub y (Either [String] a, Hamlet (Routes y))
runForm f = do
req <- getRequest
(pp, _) <- liftIO $ reqRequestBody req
return $ fst $ runIncr (runSealedForm f pp) 1
type Env = [(String, String)]
@ -39,9 +62,7 @@ instance Functor FormResult where
fmap _ (FormFailure errs) = FormFailure errs
fmap f (FormSuccess a) = FormSuccess $ f a
newtype Form url a = Form
{ runForm :: Env -> Incr (FormResult a, Hamlet url)
}
newtype Form url a = Form (Env -> Incr (FormResult a, Hamlet url))
type Formlet url a = Maybe a -> Form url a
newtype SealedForm url a = SealedForm

View File

@ -1,28 +1,21 @@
{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Rank2Types #-}
module Yesod.Contrib.Crud where
module Yesod.Helpers.Crud
( Item (..)
, Crud (..)
, defaultCrud
, siteCrud
) where
import Yesod.Yesod
import Yesod.Dispatch
import Yesod.Content
import Yesod.Handler
import Yesod.Request
import Text.Hamlet
import Control.Monad.IO.Class (liftIO)
import Web.Routes.Quasi
import Database.Persist
import Yesod.Contrib.Formable hiding (runForm)
import Yesod.Contrib.Persist
import Yesod.Formable
import Data.Monoid (mempty)
runForm :: SealedForm (Routes y) a
-> GHandler sub y (Either [String] a, Hamlet (Routes y))
runForm f = do
req <- getRequest
(pp, _) <- liftIO $ reqRequestBody req
return $ fst $ runIncr (runSealedForm f pp) 1
class Formable a => Item a where
itemTitle :: a -> String

View File

@ -1,10 +1,14 @@
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
-- | The basic typeclass for a Yesod application.
module Yesod.Yesod
( -- * Type classes
Yesod (..)
, YesodSite (..)
-- ** Persistence
, YesodPersist (..)
, Persist (..)
-- * Convenience functions
, applyLayout
, applyLayoutJson
@ -19,9 +23,11 @@ import Yesod.Handler
import qualified Network.Wai as W
import Yesod.Json
import Yesod.Internal
import Web.ClientSession (getKey, defaultKeyFile, Key)
import Web.ClientSession (getKey, defaultKeyFile)
import qualified Web.ClientSession as CS
import Data.Monoid (mempty)
import Data.ByteString.UTF8 (toString)
import Database.Persist (Persist (..))
import Web.Routes.Quasi (QuasiSite (..), Routes)
@ -46,7 +52,7 @@ class Yesod a where
approot :: a -> String
-- | The encryption key to be used for encrypting client sessions.
encryptKey :: a -> IO Key
encryptKey :: a -> IO CS.Key
encryptKey _ = getKey defaultKeyFile
-- | Number of minutes before a client session times out. Defaults to
@ -162,3 +168,7 @@ defaultErrorHandler (BadMethod m) =
%h1 Method Not Supported
%p Method "$string.m$" not supported
|]
class YesodPersist y where
type YesodDB y :: (* -> *) -> * -> *
runDB :: YesodDB y (GHandler sub y) a -> GHandler sub y a

View File

@ -58,6 +58,7 @@ library
Yesod.Content
Yesod.Dispatch
Yesod.Form
Yesod.Formable
Yesod.Hamlet
Yesod.Handler
Yesod.Internal
@ -66,13 +67,10 @@ library
Yesod.Yesod
Yesod.Helpers.AtomFeed
Yesod.Helpers.Auth
Yesod.Helpers.Crud
Yesod.Helpers.Sitemap
Yesod.Helpers.Static
Yesod.Contrib
Yesod.Contrib.Crud
Yesod.Contrib.Formable
Yesod.Contrib.Persist
ghc-options: -Wall
ghc-options: -Wall -Werror
executable runtests
if flag(buildtests)