[Haskell-cafe] working off a Yesod example file, need help lifting values from one monad into another. (and probably other things too).
Luke Palmer
lrpalmer at gmail.com
Tue Mar 29 04:51:44 CEST 2011
On Mon, Mar 28, 2011 at 6:28 PM, Michael Litchard <michael at schmong.org>wrote:
> 1
> 2
> 3
> 4
> 5
> 6
> 7
> 8
> 9
> 10
> 11
> 12
> 13
> 14
> 15
> 16
> 17
> 18
> 19
> 20
> 21
> 22
> 23
> 24
> 25
> 26
> 27
> 28
> 29
> 30
> 31
> 32
> 33
> 34
> 35
> 36
> 37
> 38
> 39
> 40
> 41
> 42
> 43
> 44
> 45
> 46
> 47
> 48
> 49
> 50
> 51
> 52
> 53
> 54
> 55
> 56
> 57
> 58
> 59
> 60
> 61
> 62
> 63
> 64
> 65
> 66
> 67
> 68
> 69
> 70
> 71
> 72
> 73
> 74
> 75
> 76
> 77
> 78
> 79
> 80
> 81
> 82
> 83
> 84
> 85
> 86
> 87
> 88
> 89
> 90
> 91
> 92
> 93
> 94
> 95
> 96
> 97
> 98
> 99
> 100
> 101
> 102
> 103
> 104
> 105
> 106
> 107
> 108
> 109
> 110
> 111
> 112
> 113
> 114
> 115
> 116
> 117
> 118
> 119
> 120
> 121
> 122
> 123
> 124
> 125
> 126
> 127
> 128
> 129
> 130
> 131
> 132
> 133
> 134
> 135
> 136
> 137
> 138
> 139
> 140
> 141
> 142
> 143
> 144
> 145
> 146
> 147
> 148
> 149
> 150
> 151
> 152
> 153
> 154
> 155
> 156
> 157
> 158
> 159
> 160
> 161
> 162
> 163
> 164
> 165
> 166
> 167
> 168
> 169
> 170
> 171
> 172
> 173
> 174
> 175
> 176
> 177
> 178
> 179
> 180
> 181
> 182
> 183
> 184
> 185
> 186
> 187
> 188
> 189
> 190
> 191
> 192
> 193
> 194
> 195
> 196
> 197
> 198
> 199
> 200
> 201
> 202
> 203
> 204
> 205
> 206
> 207
> 208
> 209
> 210
> 211
> 212
> 213
> 214
> 215
> 216
> 217
> 218
> 219
> 220
> 221
> 222
> 223
> 224
> 225
> 226
> 227
> 228
> 229
> 230
> 231
> 232
> 233
> 234
> 235
> 236
> 237
> 238
> 239
> 240
> 241
> 242
> 243
> 244
> 245
> 246
> 247
> 248
> 249
> 250
> 251
> 252
> 253
> 254
> 255
> 256
> 257
> 258
> 259
> 260
> 261
> 262
> 263
> 264
> 265
> 266
> 267
> 268
> 269
> 270
> 271
> 272
> 273
> 274
> 275
> 276
> 277
> 278
> 279
> 280
> 281
> 282
> 283
> 284
> 285
> 286
> 287
> 288
> 289
> 290
> 291
> 292
> 293
> 294
> 295
> 296
> 297
> 298
> 299
> 300
> 301
> 302
> 303
> 304
> 305
> 306
> 307
> 308
> 309
> 310
> 311
> 312
> 313
> 314
> 315
> 316
> 317
> 318
> 319
> 320
> 321
> 322
> 323
> 324
> 325
> 326
> 327
> 328
> 329
> 330
> 331
> 332
> 333
> 334
> 335
> 336
> 337
> 338
> 339
> 340
> 341
> 342
> 343
> 344
> 345
> 346
> 347
> 348
> 349
> 350
> 351
> 352
> 353
> 354
> 355
> 356
> 357
> 358
> 359
> 360
> 361
> 362
> 363
> 364
> 365
> 366
> 367
> 368
>
Ready or not, here I come.
What is the purposes of these 368 numbers?
Luke
>
>
>
> I'm working off of a example file from Yesod, ajax.lhs
> I've made an important change in types, and this has resulted in
> having to make the old code conform to the change. I will point out
> the specifics, then present my question. In the event I failed to
> include important information, I will paste in my code as well as the
> prototype.
>
> [Original]
>
> > getHomeR :: Handler ()
> > getHomeR = do
> > Ajax pages _ <- getYesod
> > let first = head pages
> > redirect RedirectTemporary $ PageR $ pageSlug first
>
> [Changed]
>
> > getHomeR :: Handler ()
> > getHomeR = do
> > Tframe pages _ <- getYesod
> > let first = head pages
> > redirect RedirectTemporary $ PageR $ pageSlug first
>
> Error Message
>
> test.lhs:62:4:
> Constructor `Tframe' should have 2 arguments, but has been given 1
> In the pattern: Tframe pages
> In a stmt of a 'do' expression: Tframe pages <- getYesod ****
> This is not what I wrote *****
> In the expression:
> do { Tframe pages <- getYesod;
> content <- widgetToPageContent widget;
> hamletToRepHtml
> (hamlet-0.7.1:Text.Hamlet.Quasi.toHamletValue
> (do { (hamlet-0.7.1:Text.Hamlet.Quasi.htmlToHamletMonad
> . preEscapedString)
> "<!DOCTYPE html><html><head><title>";
> (hamlet-0.7.1:Text.Hamlet.Quasi.htmlToHamletMonad
> . Text.Blaze.toHtml)
> (Main.pageTitle content);
> .... })) }
>
> As far as I can tell, I only made a cosmetic change. I don't know
> what's going on here.
>
>
>
> [Original]
>
> > data Page = Page
> > { pageName :: String
> > , pageSlug :: String
> > , pageContent :: String ******** I'm going to change this
> **********
> > }
>
> [Changed]
>
> > data Page = Page
> > { pageTitle :: String
> > , pageSlug :: String -- ^ used in the URL
> > , pageContent :: IO String ******** This is the change
> *******
> > }
>
>
> Here's where I run into trouble
>
> [Original]
> > json page = jsonMap
> > [ ("name", jsonScalar $ pageName page)
> > , ("content", jsonScalar $ pageContent page) ******** I'm going
> to change this ********
> > ]
>
>
>
> [My changes]
>
> > json page = jsonMap
> > [ ("name", jsonScalar $ Main.pageTitle page)
> > , ("content", jsonScalar $ liftIO $ pageContent page) ******* This
> is the change ***********
> > ]
>
>
> Here's the compiler error
>
> test.lhs:107:35:
> Couldn't match expected type `Char' against inferred type `[Char]'
> Expected type: String
> Inferred type: [String]
> In the second argument of `($)', namely `liftIO $ pageContent page'
> In the expression: jsonScalar $ liftIO $ pageContent page
> Failed, modules loaded: none.
>
>
> I'd appreciate a discussion about why this is wrong, and perhaps clues
> as to what is right.
>
>
> Last problem, stemming from the change in type to IO String. I don't
> have a clue as to what change I should make.
>
> test.lhs:100:25:
> No instance for (Text.Blaze.ToHtml (IO String))
> arising from a use of `Text.Blaze.toHtml'
> at test.lhs:(100,25)-(103,3)
> Possible fix:
> add an instance declaration for (Text.Blaze.ToHtml (IO String))
> In the second argument of `(.)', namely `Text.Blaze.toHtml'
> In a stmt of a 'do' expression:
> (hamlet-0.7.1:Text.Hamlet.Quasi.htmlToHamletMonad
> . Text.Blaze.toHtml)
> (pageContent page)
> In the first argument of
> `hamlet-0.7.1:Text.Hamlet.Quasi.toHamletValue', nam
>
> ely
> `do { (hamlet-0.7.1:Text.Hamlet.Quasi.htmlToHamletMonad
> . preEscapedString)
> "<h1>";
> (hamlet-0.7.1:Text.Hamlet.Quasi.htmlToHamletMonad
> . Text.Blaze.toHtml)
> (Main.pageTitle page);
> (hamlet-0.7.1:Text.Hamlet.Quasi.htmlToHamletMonad
> . preEscapedString)
> "</h1><article>";
> (hamlet-0.7.1:Text.Hamlet.Quasi.htmlToHamletMonad
> . Text.Blaze.toHtml)
> (pageContent page);
> .... }'
>
>
>
> And finally, both files can be found below, if it is necessary to look at
> them.
>
>
> [Original]
>
> <p>We're going to write a very simple AJAX application. It will be a
> simple site with a few pages and a navbar; when you have Javascript,
> clicking on the links will load the pages via AJAX. Otherwise, it will
> use static HTML.</p>
>
> <p>We're going to use jQuery for the Javascript, though anything would
> work just fine. Also, the AJAX responses will be served as JSON. Let's
> get started.</p>
>
> > {-# LANGUAGE ScopedTypeVariables, TypeFamilies, QuasiQuotes,
> TemplateHaskell, MultiParamTypeClasses #-}
> > import Yesod
> > import Yesod.Helpers.Static
> > import Data.Monoid (mempty)
>
> Like the blog example, we'll define some data first.
>
> > data Page = Page
> > { pageName :: String
> > , pageSlug :: String
> > , pageContent :: String
> > }
>
> > loadPages :: IO [Page]
> > loadPages = return
> > [ Page "Page 1" "page-1" "My first page"
> > , Page "Page 2" "page-2" "My second page"
> > , Page "Page 3" "page-3" "My third page"
> > ]
>
> loadPages :: IO [Page]
> loadPages = do
>
> >
> > data Ajax = Ajax
> > { ajaxPages :: [Page]
> > , ajaxStatic :: Static
> > }
> > type Handler = GHandler Ajax Ajax
>
> Next we'll generate a function for each file in our static folder.
> This way, we get a compiler warning when trying to using a file which
> does not exist.
>
> > staticFiles "static/yesod/ajax"
>
> Now the routes; we'll have a homepage, a pattern for the pages, and
> use a static subsite for the Javascript and CSS files.
>
> > mkYesod "Ajax" [$parseRoutes|
> > / HomeR GET
> > /page/#String PageR GET
> > /static StaticR Static ajaxStatic
> > |]
>
> <p>That third line there is the syntax for a subsite: Static is the
> datatype for the subsite argument; siteStatic returns the site itself
> (parse, render and dispatch functions); and ajaxStatic gets the
> subsite argument from the master argument.</p>
>
> <p>Now, we'll define the Yesod instance. We'll still use a dummy
> approot value, but we're also going to define a default layout.</p>
>
> > instance Yesod Ajax where
> > approot _ = ""
> > defaultLayout widget = do
> > Ajax pages _ <- getYesod
> > content <- widgetToPageContent widget
> > hamletToRepHtml [$hamlet|
> > \<!DOCTYPE html>
> >
> > <html>
> > <head>
> > <title>#{pageTitle content}
> > <link rel="stylesheet" href="@{StaticR style_css}">
> > <script src="
> http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js">
> > <script src="@{StaticR script_js}">
> > \^{pageHead content}
> > <body>
> > <ul id="navbar">
> > $forall page <- pages
> > <li>
> > <a href="@{PageR (pageSlug page)}">#{pageName page}
> > <div id="content">
> > \^{pageBody content}
> > |]
>
> <p>The Hamlet template refers to style_css and style_js; these were
> generated by the call to staticFiles above. There's nothing
> Yesod-specific about the <a
> href="/static/yesod/ajax/style.css">style.css</a> and <a
> href="/static/yesod/ajax/script.js">script.js</a> files, so I won't
> describe them here.</p>
>
> <p>Now we need our handler functions. We'll have the homepage simply
> redirect to the first page, so:</p>
>
> > getHomeR :: Handler ()
> > getHomeR = do
> > Ajax pages _ <- getYesod
> > let first = head pages
> > redirect RedirectTemporary $ PageR $ pageSlug first
>
> And now the cool part: a handler that returns either HTML or JSON
> data, depending on the request headers.
>
> > getPageR :: String -> Handler RepHtmlJson
> > getPageR slug = do
> > Ajax pages _ <- getYesod
> > case filter (\e -> pageSlug e == slug) pages of
> > [] -> notFound
> > page:_ -> defaultLayoutJson (do
> > setTitle $ string $ pageName page
> > addHamlet $ html page
> > ) (json page)
> > where
> > html page = [$hamlet|
> > <h1>#{pageName page}
> > <article>#{pageContent page}
> > |]
> > json page = jsonMap
> > [ ("name", jsonScalar $ pageName page)
> > , ("content", jsonScalar $ pageContent page)
> > ]
>
> <p>We first try and find the appropriate Page, returning a 404 if it's
> not there. We then use the applyLayoutJson function, which is really
> the heart of this example. It allows you an easy way to create
> responses that will be either HTML or JSON, and which use the default
> layout in the HTML responses. It takes four arguments: 1) the title of
> the HTML page, 2) some value, 3) a function from that value to a
> Hamlet value, and 4) a function from that value to a Json value.</p>
>
> <p>Under the scenes, the Json monad is really just using the Hamlet
> monad, so it gets all of the benefits thereof, namely interleaved IO
> and enumerator output. It is pretty straight-forward to generate JSON
> output by using the three functions jsonMap, jsonList and jsonMap. One
> thing to note: the input to jsonScalar must be HtmlContent; this helps
> avoid cross-site scripting attacks, by ensuring that any HTML entities
> will be escaped.</p>
>
> <p>And now our typical main function. We need two parameters to build
> our Ajax value: the pages, and the static loader. We'll load up from a
> local directory.</p>
>
> > main :: IO ()
> > main = do
> >
> > pages <- loadPages
> > let s = static "static/yesod/ajax"
> > warpDebug 3000 $ Ajax pages s
>
>
> [My changes]
> > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell,
> MultiParamTypeClasses
> > #-}
> > import Yesod
> > import Yesod.Helpers.Static
> > import System.Environment
> > import System.IO
> > import System.Directory
> > import System.FilePath.Posix
> > import Control.Applicative
> > import Data.List.Split
>
>
>
> > data Page = Page
> > { pageTitle :: String
> > , pageSlug :: String -- ^ used in the URL
> > , pageContent :: IO String
> > }
>
>
>
> > loadPage :: IO [Page]
> > loadPage = do
> > let directoryPath = "/home/mlitchard/playground/webTests/files"
> > let processedPath = map (directoryPath </>) . filter (`notElem`
> [".",".."])
> > pageFileNames <- processedPath <$> getDirectoryContents directoryPath
> > let pageFiles = map readFile pageFileNames
> > return $ zipWith popEntries pageFileNames pageFiles
>
> -- > return $ zipWith popEntries
>
> > popEntries :: FilePath -> IO String -> Page
> > popEntries pageFileName pageFile =
> > let pageT = last $ splitOn "/" pageFileName
> > pageS = "Job" ++ pageT
> > in Page { Main.pageTitle=pageT,
> > pageSlug=pageS,
> > pageContent=pageFile }
>
> > data Tframe = Tframe
> > { tframePages :: [Page]
> > , tframeStatic :: Static
> > }
>
> > type Handler = GHandler Tframe Tframe
>
> > staticFiles "static/yesod/ajax"
>
> Routes
>
> > mkYesod "Tframe" [$parseRoutes|
> > / HomeR GET
> > /page/#String PageR GET
> > /static StaticR Static tframeStatic
> > |]
>
> defining the Yesod instance
>
> > instance Yesod Tframe where
> > approot _ = ""
> > defaultLayout widget = do
> > Tframe pages <- getYesod
> > content <- widgetToPageContent widget
> > hamletToRepHtml [$hamlet|
> > \<!DOCTYPE html>
> >
> > <html>
> > <head>
> > <title>#{Main.pageTitle content}
> > <link rel="stylesheet" href="@{StaticR style_css}">
> > <script src="
> http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js">
> > <script src="@{StaticR script_js}">
> > \^{pageHead content}
> > <body>
> > <ul id="navbar">
> > $forall page <- pages
> > <li>
> > <a href="@{PageR (pageSlug page)}">#{Main.pageTitle page}
> > <div id="content">
> > \^{pageBody content}
> > |]
>
>
> > getHomeR :: Handler ()
> > getHomeR = do
> > Tframe pages _ <- getYesod
> > let first = head pages
> > redirect RedirectTemporary $ PageR $ pageSlug first
>
> > getPageR :: String -> Handler RepHtmlJson
> > getPageR slug = do
> > Tframe pages _ <- getYesod
> > case filter (\e -> pageSlug e == slug) pages of
> > [] -> notFound
> > page:_ -> defaultLayoutJson (do
> > setTitle $ string $ Main.pageTitle page
> > addHamlet $ html page
> > ) (json page)
> > where
> > html page = [$hamlet|
> > <h1>#{Main.pageTitle page}
> > <article>#{pageContent page}
> > |]
>
> > json page = jsonMap
> > [ ("name", jsonScalar $ Main.pageTitle page)
> > , ("content", jsonScalar $ liftIO $ pageContent page)
> > ]
>
> > main :: IO ()
> > main = do
> >
> > pages <- loadPage
> > let s = static "static/yesod/ajax"
> > warpDebug 3000 $ Tframe pages s
>
>
> If you've read to the bottom, thanks for your patience. I appreciate
> any illumination you can send my way.
>
>
> Michael
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20110328/06b42c01/attachment-0001.htm>
More information about the Haskell-Cafe
mailing list