diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index dbe607ec..0e3dfe36 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -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. diff --git a/Yesod/Form.hs b/Yesod/Form.hs index fc6b2b9c..e2870883 100644 --- a/Yesod/Form.hs +++ b/Yesod/Form.hs @@ -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 diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 9a01c7b9..d8837345 100644 --- a/Yesod/Helpers/Auth.hs +++ b/Yesod/Helpers/Auth.hs @@ -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 [] diff --git a/Yesod/Helpers/Crud.hs b/Yesod/Helpers/Crud.hs index 9b25cdde..bf8462c4 100644 --- a/Yesod/Helpers/Crud.hs +++ b/Yesod/Helpers/Crud.hs @@ -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) diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs index f498dfbd..734dac8b 100644 --- a/Yesod/Helpers/Static.hs +++ b/Yesod/Helpers/Static.hs @@ -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 diff --git a/Yesod/Widget.hs b/Yesod/Widget.hs index bfbc6581..1e081c69 100644 --- a/Yesod/Widget.hs +++ b/Yesod/Widget.hs @@ -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"