Re: [Haskell-beginners] [Haskell-cafe] working off a Yesod example file, need help lifting values from one monad into another. (and probably other things too).

28 Mar 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  wrote:
...
On Mon, Mar 28, 2011 at 6:28 PM, Michael Litchard 
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@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Michael Litchard

tags

participants (1)