[Haskell-cafe] working off a Yesod example file, need help lifting values from one monad into another. (and probably other things too).
Michael Litchard
michael at schmong.org
Tue Mar 29 05:00:51 CEST 2011
I just noticed those. I think that came from hpaste. The first mail
was a cut and paste from a post I made there. When I went to look at
your reply, I had the very same question as you.
On Mon, Mar 28, 2011 at 7:51 PM, Luke Palmer <lrpalmer at gmail.com> wrote:
> 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
>
>
More information about the Haskell-Cafe
mailing list