Updated documentation
This commit is contained in:
parent
62878e53cf
commit
d8ece1db78
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 []
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user