RetroSearch Browse

Home - News ( United States | United Kingdom | Italy | Germany ) - Football scores

Showing content from https://www.yesodweb.com/blog/2011/09/new-book-content below:

New Book Content

New Book Content September 23, 2011 By Michael Snoyman

Joins You might be thinking this is something that Persistent could automate away for us. Well, in theory yes, but there are two complications to be taken into account: there might be multiple relations between entities (e.g., a car could have both an owner and a mechanic), or that might not be any relations. In my opinion, the simplest, most consistent API results from just making these things explicit parameters.

type PersonPair = (PersonId, Person)
type CarPair = (CarId, Car)
type Result = [(PersonPair, [CarPair])]

{-# LANGUAGE TypeFamilies, TemplateHaskell, MultiParamTypeClasses,
GADTs, QuasiQuotes, OverloadedStrings, FlexibleContexts #-}
import Database.Persist
import Database.Persist.Sqlite
import Database.Persist.TH
import Database.Persist.Query.Join (SelectOneMany (..), selectOneMany)
import Control.Monad.IO.Class (liftIO)

-- We'll use the SQL-enhanced joins. If you want the in-application join
-- behavior instead, just import runJoin from Database.Persist.Query.Join
import Database.Persist.Query.Join.Sql (runJoin)

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
    name String
Car
    owner PersonId
    name String
|]

main :: IO ()
main = withSqliteConn ":memory:" $ runSqlConn $ do
    runMigration migrateAll

    bruce <- insert $ Person "Bruce Wayne"
    insert $ Car bruce "Bat Mobile"
    insert $ Car bruce "Porsche"
    -- this could go on a while

    peter <- insert $ Person "Peter Parker"
    -- poor Spidey, no car

    logan <- insert $ Person "James Logan" -- Wolverine
    insert $ Car logan "Harley"

    britt <- insert $ Person "Britt Reid" -- The Green Hornet
    insert $ Car britt "The Black Beauty"

    results <- runJoin (selectOneMany (CarOwner <-.) carOwner)
        { somOrderOne = [Asc PersonName]
        }

    liftIO $ printResults results

printResults :: [(Entity Person, [Entity Car])] -> IO ()
printResults =
    mapM_ goPerson
  where
    goPerson :: (Entity Person, [Entity Car]) -> IO ()
    goPerson ((Entity _personid person), cars) = do
        putStrLn $ personName person
        mapM_ goCar cars
        putStrLn ""

    goCar :: (Entity Car) -> IO ()
    goCar (Entity _carid car) = putStrLn $ "    " ++ carName car

Monadic Forms A non-standard form layout

{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes,
TemplateHaskell, MultiParamTypeClasses #-}
import Yesod
import Control.Applicative
import Data.Text (Text)

data Monadic = Monadic

mkYesod "Monadic" [parseRoutes|
/ RootR GET
|]

instance Yesod Monadic

instance RenderMessage Monadic FormMessage where
    renderMessage _ _ = defaultFormMessage

data Person = Person { personName :: Text, personAge :: Int }
    deriving Show

personForm :: Html -> MForm Monadic Monadic (FormResult Person, Widget)
personForm extra = do
    (nameRes, nameView) <- mreq textField "this is not used" Nothing
    (ageRes, ageView) <- mreq intField "neither is this" Nothing
    let personRes = Person <$> nameRes <*> ageRes
    let widget = do
            toWidget [lucius|
##{fvId ageView} {
    width: 3em;
}
|]
            [whamlet|
#{extra}
<p>
    Hello, my name is #
    ^{fvInput nameView}
    \ and I am #
    ^{fvInput ageView}
    \ years old. #
    <input type=submit value="Introduce myself">
|]
    return (personRes, widget)

getRootR :: Handler RepHtml
getRootR = do
    ((res, widget), enctype) <- runFormGet personForm
    defaultLayout [whamlet|
<p>Result: #{show res}
<form enctype=#{enctype}>
    ^{widget}
|]

main :: IO ()
main = warpDebug 3000 Monadic

fromString "this is not used" == FieldSettings
    { fsLabel = "this is not used"
    , fsTooltip = Nothing
    , fsId = Nothing
    , fsName = Nothing
    , fsClass = []
    }

In the case of applicative forms, the fsLabel and fsTooltip values are used when constructing your HTML. In the case of monadic forms, Yesod does not generate any of the "wrapper" HTML for you, and therefore these values are ignored. Well, that's not exactly true. It would compile and build, but you wouldn't have a submit button. Input forms

You use runInputPost and runInputGet.
You use ireq and iopt. These functions now only take two arguments: the field type and the name (i.e., HTML name attribute) of the field in question.
After running a form, it returns the value. It doesn't return a widget or an encoding type.
If there are any validation errors, the page returns an "invalid arguments" error page.

{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes,
TemplateHaskell, MultiParamTypeClasses #-}
import Yesod
import Control.Applicative
import Data.Text (Text)

data Input = Input

mkYesod "Input" [parseRoutes|
/ RootR GET
/input InputR GET
|]

instance Yesod Input

instance RenderMessage Input FormMessage where
    renderMessage _ _ = defaultFormMessage

data Person = Person { personName :: Text, personAge :: Int }
    deriving Show

getRootR :: Handler RepHtml
getRootR = defaultLayout [whamlet|
<form action=@{InputR}>
    <p>
        My name is #
        <input type=text name=name>
        \ and I am #
        <input type=text name=age>
        \ years old. #
        <input type=submit value="Introduce myself">
|]

getInputR :: Handler RepHtml
getInputR = do
    person <- runInputGet $ Person
                <$> ireq textField "name"
                <*> ireq intField "age"
    defaultLayout [whamlet|<p>#{show person}|]

main :: IO ()
main = warpDebug 3000 Input

Custom fields

An error message saying validation failed.
The parsed value.
Nothing, indicating that no data was supplied.

passwordConfirmField :: Field sub master Text
passwordConfirmField = Field
    { fieldParse = \rawVals ->
        case rawVals of
            [a, b]
                | a == b -> return $ Right $ Just a
                | otherwise -> return $ Left "Passwords don't match"
            [] -> return $ Right Nothing
            _ -> return $ Left "You must enter two values"
    , fieldView = \idAttr nameAttr _ eResult isReq -> [whamlet|
<input id=#{idAttr} name=#{nameAttr} type=password>
<div>Confirm:
<input id=#{idAttr}-confirm name=#{nameAttr} type=password>
|]
    }

getRootR :: Handler RepHtml
getRootR = do
    ((res, widget), enctype) <- runFormGet $ renderDivs
        $ areq passwordConfirmField "Password" Nothing
    defaultLayout [whamlet|
<p>Result: #{show res}
<form enctype=#{enctype}>
    ^{widget}
    <input type=submit value="Change password">
|]

comments powered by