Updated documentation

This commit is contained in:
Michael Snoyman 2010-07-13 09:36:20 +03:00
parent 62878e53cf
commit d8ece1db78
6 changed files with 105 additions and 15 deletions

View File

@ -80,7 +80,7 @@ import Yesod.Content
#endif
-- | Generates URL datatype and site function for the given 'Resource's. This
-- is used for creating sites, *not* subsites. See 'mkYesodSub' for the latter.
-- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
-- Use 'parseRoutes' to create the 'Resource's.
mkYesod :: String -- ^ name of the argument datatype
-> [Resource]
@ -88,7 +88,7 @@ mkYesod :: String -- ^ name of the argument datatype
mkYesod name = fmap (uncurry (++)) . mkYesodGeneral name [] [] False
-- | Generates URL datatype and site function for the given 'Resource's. This
-- is used for creating subsites, *not* sites. See 'mkYesod' for the latter.
-- is used for creating subsites, /not/ sites. See 'mkYesod' for the latter.
-- Use 'parseRoutes' to create the 'Resource's. In general, a subsite is not
-- executable by itself, but instead provides functionality to
-- be embedded in other sites.
@ -103,8 +103,8 @@ mkYesodSub name clazzes =
-- | Sometimes, you will want to declare your routes in one file and define
-- your handlers elsewhere. For example, this is the only way to break up a
-- monolithic file into smaller parts. This function, paired with
-- 'mkYesodDispatch', do just that.
-- monolithic file into smaller parts. Use this function, paired with
-- 'mkYesodDispatch', to do just that.
mkYesodData :: String -> [Resource] -> Q [Dec]
mkYesodData name res = do
(x, _) <- mkYesodGeneral name [] [] False res
@ -288,7 +288,7 @@ toWaiApp' y segments env = do
-- | Fully render a route to an absolute URL. Since Yesod does this for you
-- internally, you will rarely need access to this. However, if you need to
-- generate links *outside* of the Handler monad, this may be useful.
-- generate links /outside/ of the Handler monad, this may be useful.
--
-- For example, if you want to generate an e-mail which links to your site,
-- this is the function you would want to use.

View File

@ -100,6 +100,11 @@ import Yesod.Widget
import Control.Arrow ((&&&))
import qualified Text.Email.Validate as Email
-- | A form can produce three different results: there was no data available,
-- the data was invalid, or there was a successful parse.
--
-- The 'Applicative' instance will concatenate the failure messages in two
-- 'FormResult's.
data FormResult a = FormMissing
| FormFailure [String]
| FormSuccess a
@ -116,6 +121,8 @@ instance Applicative FormResult where
_ <*> (FormFailure y) = FormFailure y
_ <*> _ = FormMissing
-- | The encoding type required by a form. The 'Show' instance produces values
-- that can be inserted directly into HTML.
data Enctype = UrlEncoded | Multipart
instance Show Enctype where
show UrlEncoded = "application/x-www-form-urlencoded"
@ -125,6 +132,8 @@ instance Monoid Enctype where
mappend UrlEncoded UrlEncoded = UrlEncoded
mappend _ _ = Multipart
-- | A generic form, allowing you to specifying the subsite datatype, master
-- site datatype, a datatype for the form XML and the return type.
newtype GForm sub y xml a = GForm
{ deform :: Env -> FileEnv -> StateT Int (GHandler sub y) (FormResult a, xml, Enctype)
}
@ -134,11 +143,15 @@ type FormField sub y = GForm sub y [FieldInfo sub y]
type FormletField sub y a = Maybe a -> FormField sub y a
type FormInput sub y = GForm sub y [GWidget sub y ()]
-- | Convert the XML in a 'GForm'.
mapFormXml :: (xml1 -> xml2) -> GForm s y xml1 a -> GForm s y xml2 a
mapFormXml f (GForm g) = GForm $ \e fe -> do
(res, xml, enc) <- g e fe
return (res, f xml, enc)
-- | Using this as the intermediate XML representation for fields allows us to
-- write generic field functions and then different functions for producing
-- actual HTML. See, for example, 'fieldsToTable' and 'fieldsToPlain'.
data FieldInfo sub y = FieldInfo
{ fiLabel :: Html ()
, fiTooltip :: Html ()
@ -163,12 +176,15 @@ instance Monoid xml => Applicative (GForm sub url xml) where
(g1, g2, g3) <- g env fe
return (f1 <*> g1, f2 `mappend` g2, f3 `mappend` g3)
-- | Display only the actual input widget code, without any decoration.
fieldsToPlain :: [FieldInfo sub y] -> GWidget sub y ()
fieldsToPlain = mapM_ fiInput
fieldsToInput :: [FieldInfo sub y] -> [GWidget sub y ()]
fieldsToInput = map fiInput
-- | Display the label, tooltip, input code and errors in a single row of a
-- table.
fieldsToTable :: [FieldInfo sub y] -> GWidget sub y ()
fieldsToTable = mapM_ go
where
@ -189,6 +205,8 @@ class ToForm a where
class ToFormField a where
toFormField :: Html () -> Html () -> Maybe a -> FormField sub y a
-- | Create a required field (ie, one that cannot be blank) from a
-- 'FieldProfile'.
requiredFieldHelper :: FieldProfile sub y a -> Maybe a -> FormField sub y a
requiredFieldHelper (FieldProfile parse render mkXml w name' label tooltip) orig =
GForm $ \env _ -> do
@ -214,6 +232,8 @@ requiredFieldHelper (FieldProfile parse render mkXml w name' label tooltip) orig
}
return (res, [fi], UrlEncoded)
-- | Create an optional field (ie, one that can be blank) from a
-- 'FieldProfile'.
optionalFieldHelper :: FieldProfile sub y a -> Maybe (Maybe a)
-> FormField sub y (Maybe a)
optionalFieldHelper (FieldProfile parse render mkXml w name' label tooltip) orig' =
@ -241,6 +261,9 @@ optionalFieldHelper (FieldProfile parse render mkXml w name' label tooltip) orig
}
return (res, [fi], UrlEncoded)
-- | A generic definition of a form field that can be used for generating both
-- required and optional fields. See 'requiredFieldHelper and
-- 'optionalFieldHelper'.
data FieldProfile sub y a = FieldProfile
{ fpParse :: String -> Either String a
, fpRender :: a -> String
@ -403,10 +426,12 @@ jqueryDayFieldProfile = FieldProfile
%input#$name$!name=$name$!type=date!:isReq:required!value=$val$
|]
, fpWidget = \name -> do
addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
addScriptRemote "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
addStylesheetRemote "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
addJavaScript [$hamlet|$$(function(){$$("#$name$").datepicker({dateFormat:'yy-mm-dd'})});|]
addScriptRemote urlJqueryJs
addScriptRemote urlJqueryUiJs
addStylesheetRemote urlJqueryUiCss
addJavaScript [$hamlet|
$$(function(){$$("#$name$").datepicker({dateFormat:'yy-mm-dd'})});
|]
, fpName = Nothing
, fpLabel = mempty
, fpTooltip = mempty
@ -683,6 +708,7 @@ maybeDayInput n =
--------------------- End prebuilt inputs
-- | Get a unique identifier.
newFormIdent :: Monad m => StateT Int m String
newFormIdent = do
i <- get
@ -726,12 +752,16 @@ runFormGet f = do
gs <- reqGetParams `fmap` getRequest
runFormGeneric gs [] f
-- | This function allows two different monadic functions to share the same
-- input and have their results concatenated. This is particularly useful for
-- allowing 'mkToForm' to share its input with mkPersist.
share2 :: Monad m => (a -> m [b]) -> (a -> m [b]) -> a -> m [b]
share2 f g a = do
f' <- f a
g' <- g a
return $ f' ++ g'
-- | Create 'ToForm' instances for the entities given. In addition to regular 'EntityDef' attributes understood by persistent, it also understands label= and tooltip=.
mkToForm :: [EntityDef] -> Q [Dec]
mkToForm = mapM derive
where
@ -810,10 +840,12 @@ jqueryAutocompleteFieldProfile src = FieldProfile
%input.autocomplete#$name$!name=$name$!type=text!:isReq:required!value=$val$
|]
, fpWidget = \name -> do
addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
addScriptRemote "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
addStylesheetRemote "http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"
addJavaScript [$hamlet|$$(function(){$$("#$name$").autocomplete({source:"@src@",minLength:2})});|]
addScriptRemote urlJqueryJs
addScriptRemote urlJqueryUiJs
addStylesheetRemote urlJqueryUiCss
addJavaScript [$hamlet|
$$(function(){$$("#$name$").autocomplete({source:"@src@",minLength:2})});
|]
, fpName = Nothing
, fpLabel = mempty
, fpTooltip = mempty

View File

@ -52,6 +52,7 @@ import Control.Monad.Attempt
import Data.ByteString.Lazy.UTF8 (fromString)
import Data.Object
-- | Minimal complete definition: 'defaultDest' and 'defaultLoginRoute'.
class Yesod master => YesodAuth master where
-- | Default destination on successful login or logout, if no other
-- destination exists.
@ -75,8 +76,8 @@ class Yesod master => YesodAuth master where
stdgen <- newStdGen
return $ take 10 $ randomRs ('A', 'Z') stdgen
-- | Each authentication subsystem (OpenId, Rpxnow, Email) has its own
-- settings. If those settings are not present, then relevant handlers will
-- | Each authentication subsystem (OpenId, Rpxnow, Email, Facebook) has its
-- own settings. If those settings are not present, then relevant handlers will
-- simply return a 404.
data Auth = Auth
{ authIsOpenIdEnabled :: Bool
@ -456,6 +457,9 @@ saltPass pass = do
saltPass' :: String -> String -> String
saltPass' salt pass = salt ++ show (md5 $ fromString $ salt ++ pass)
-- | A simplistic set of email settings, useful only for testing purposes. In
-- particular, it doesn't actually send emails, but instead prints verification
-- URLs to stderr.
inMemoryEmailSettings :: IO AuthEmailSettings
inMemoryEmailSettings = do
mm <- newMVar []

View File

@ -19,9 +19,14 @@ import Text.Hamlet
import Yesod.Form
import Data.Monoid (mempty)
-- | An entity which can be displayed by the Crud subsite.
class ToForm a => Item a where
-- | The title of an entity, to be displayed in the list of all entities.
itemTitle :: a -> String
-- | Defines all of the CRUD operations (Create, Read, Update, Delete)
-- necessary to implement this subsite. When using the "Yesod.Form" module and
-- 'ToForm' typeclass, you can probably just use 'defaultCrud'.
data Crud master item = Crud
{ crudSelect :: GHandler (Crud master item) master [(Key item, item)]
, crudReplace :: Key item -> item -> GHandler (Crud master item) master ()
@ -159,6 +164,7 @@ crudHelper title me isPost = do
%a!href=@toMaster.CrudDeleteR.toSinglePiece.fst.e@ Delete
|]
-- | A default 'Crud' value which relies about persistent and "Yesod.Form".
defaultCrud
:: (PersistEntity i, PersistBackend (YesodDB a (GHandler (Crud a i) a)),
YesodPersist a)

View File

@ -68,6 +68,8 @@ mkYesodSub "Static" [] [$parseRoutes|
-- probably are), the handler itself checks that no unsafe paths are being
-- requested. In particular, no path segments may begin with a single period,
-- so hidden files and parent directories are safe.
--
-- For the second argument to this function, you can just use 'typeByExt'.
fileLookupDir :: FilePath -> [(String, ContentType)] -> Static
fileLookupDir dir = Static $ \fp -> do
let fp' = dir ++ '/' : fp
@ -114,6 +116,10 @@ getFileList = flip go id
dirs' <- mapM (\f -> go (fullPath f) (front . (:) f)) dirs
return $ concat $ files' : dirs'
-- | This piece of Template Haskell will find all of the files in the given directory and create Haskell identifiers for them. For example, if you have the files \"static\/style.css\" and \"static\/js\/script.js\", it will essentailly create:
--
-- > style_css = StaticRoute ["style.css"]
-- > js_script_js = StaticRoute ["js/script.js"]
staticFiles :: FilePath -> Q [Dec]
staticFiles fp = do
fs <- qRunIO $ getFileList fp

View File

@ -3,6 +3,8 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE FlexibleInstances #-}
-- | Widgets combine HTML with JS and CSS dependencies with a unique identifier
-- generator, allowing you to create truly modular HTML components.
module Yesod.Widget
( -- * Datatype
GWidget
@ -24,6 +26,10 @@ module Yesod.Widget
-- * Manipulating
, wrapWidget
, extractBody
-- * Default library URLs
, urlJqueryJs
, urlJqueryUiJs
, urlJqueryUiCss
) where
import Data.List (nub)
@ -68,6 +74,9 @@ newtype Body url = Body (Hamlet url)
newtype JavaScript url = JavaScript (Maybe (Hamlet url))
deriving Monoid
-- | A generic widget, allowing specification of both the subsite and master
-- site datatypes. This is basically a large 'WriterT' stack keeping track of
-- dependencies along with a 'StateT' to track unique identifiers.
newtype GWidget sub master a = GWidget (
WriterT (Body (Route master)) (
WriterT (Last Title) (
@ -83,17 +92,23 @@ newtype GWidget sub master a = GWidget (
instance Monoid (GWidget sub master ()) where
mempty = return ()
mappend x y = x >> y
-- | A 'GWidget' specialized to when the subsite and master site are the same.
type Widget y = GWidget y y
-- | Set the page title. Calling 'setTitle' multiple times overrides previously
-- set values.
setTitle :: Html () -> GWidget sub master ()
setTitle = GWidget . lift . tell . Last . Just . Title
-- | Add some raw HTML to the head tag.
addHead :: Hamlet (Route master) -> GWidget sub master ()
addHead = GWidget . lift . lift . lift . lift . lift . lift . tell . Head
-- | Add some raw HTML to the body tag.
addBody :: Hamlet (Route master) -> GWidget sub master ()
addBody = GWidget . tell . Body
-- | Get a unique identifier.
newIdent :: GWidget sub master String
newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift $ do
i <- get
@ -101,31 +116,39 @@ newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ lift $ do
put i'
return $ "w" ++ show i'
-- | Add some raw CSS to the style tag.
addStyle :: Hamlet (Route master) -> GWidget sub master ()
addStyle = GWidget . lift . lift . lift . lift . tell . Style . Just
-- | Link to the specified local stylesheet.
addStylesheet :: Route master -> GWidget sub master ()
addStylesheet = GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Local
-- | Link to the specified remote stylesheet.
addStylesheetRemote :: String -> GWidget sub master ()
addStylesheetRemote =
GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Remote
-- | Link to the specified local script.
addScript :: Route master -> GWidget sub master ()
addScript = GWidget . lift . lift . tell . toUnique . Script . Local
-- | Link to the specified remote script.
addScriptRemote :: String -> GWidget sub master ()
addScriptRemote =
GWidget . lift . lift . tell . toUnique . Script . Remote
-- | Include raw Javascript in the page's script tag.
addJavaScript :: Hamlet (Route master) -> GWidget sub master ()
addJavaScript = GWidget . lift . lift . lift . lift . lift. tell
. JavaScript . Just
-- | Apply the default layout to the given widget.
applyLayoutW :: (Eq (Route m), Yesod m)
=> GWidget sub m () -> GHandler sub m RepHtml
applyLayoutW w = widgetToPageContent w >>= fmap RepHtml . defaultLayout
-- | Convert a widget to a 'PageContent'.
widgetToPageContent :: Eq (Route master)
=> GWidget sub master ()
-> GHandler sub master (PageContent (Route master))
@ -158,6 +181,8 @@ $maybe jscript j
|]
return $ PageContent title head'' body
-- | Modify the given 'GWidget' by wrapping the body tag HTML code with the
-- given function. You might also consider using 'extractBody'.
wrapWidget :: GWidget s m a
-> (Hamlet (Route m) -> Hamlet (Route m))
-> GWidget s m a
@ -166,8 +191,25 @@ wrapWidget (GWidget w) wrap =
where
go (a, Body h) = (a, Body $ wrap h)
-- | Pull out the HTML tag contents and return it. Useful for performing some
-- manipulations. It can be easier to use this sometimes than 'wrapWidget'.
extractBody :: GWidget s m () -> GWidget s m (Hamlet (Route m))
extractBody (GWidget w) =
GWidget $ mapWriterT (fmap go) w
where
go ((), Body h) = (h, Body mempty)
-- | The Google-hosted jQuery 1.4.2 file.
urlJqueryJs :: String
urlJqueryJs =
"http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"
-- | The Google-hosted jQuery UI 1.8.1 javascript file.
urlJqueryUiJs :: String
urlJqueryUiJs =
"http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/jquery-ui.min.js"
-- | The Google-hosted jQuery UI 1.8.1 CSS file with cupertino theme.
urlJqueryUiCss :: String
urlJqueryUiCss =
"http://ajax.googleapis.com/ajax/libs/jqueryui/1.8.1/themes/cupertino/jquery-ui.css"