Haskell Snap Framework - Dynamic hyperlinks with Heist - haskell

I am trying to create dynamic links using the Heist templating system. The problem is that the links are appearing as text rather than being interpreted as html. Is there a specific method to create dyamic lists like this with Heist?
The function where the link is constructed:
renderCategories :: Monad m => Db.Category -> I.Splice m
renderCategories (Db.Category catid catname catdesc) =
I.runChildrenWithText [ ("categoryId", T.concat $ ["<a href='http://localhost:8000/thread_home?cateid=", T.pack . show $ catid, "'>", T.pack . show $ catid, "</a>"])
, ("categoryName", catname)
, ("categoryDesc", catdesc)]
The tag appears as "http://localhost:8000/thread_home?cateid=1'>1" text on the webpage. And the source shows it as follows:
<a href='http://localhost:8000/thread_home?cateid=1'>1</a>
I figure that I need to have it print the actual < and > but I am not sure how to achieve this.
As I am currently running runChildrenWithText to populate this Heist template changing to just runChildrenWith requires splices instead of text and so instead of attempting this I am hoping there is some way to runChildrenWithText without the '<' and '>' being converted to '&lt' and '&gt'.
Any help is appreciated!
EDIT
I am trying to manually create the link using:
renderCategories :: Monad m => Db.Category -> I.Splice m
renderCategories (Db.Category catid catname catdesc) =
I.runChildrenWith [ ("categoryId", return $ X.Element "a"[("href", "http://localhost")] $ X.TextNode (T.pack $ show catid))]
However I am encountering two errors:
Couldn't match type `X.Node' with `[X.Node]'
Expected type: I.Splice m
Actual type: heist-0.11.1:Heist.Types.HeistT m m X.Node
In the expression:
return
$ X.Element "a" [("href", "http://localhost")]
$ X.TextNode (T.pack $ show catid)
and
Couldn't match expected type `[X.Node]' with actual type `X.Node'
In the return type of a call of `X.TextNode'
In the second argument of `($)', namely
`X.TextNode (T.pack $ show catid)'
I do not really understand these errors at the moment and any help is appreciated.
Working function for both returning the link and normal text:
renderCategories :: Monad m => Db.Category -> I.Splice m
renderCategories (Db.Category catid catname catdesc) =
I.runChildrenWith [( "categoryId", return $ [X.Element "a" [("href", T.concat $ ["http://localhost:8000/thread_home?cateid=", T.pack $ show catid] )] [X.TextNode (T.pack $ show catid)] ] )
, ("categoryName", I.textSplice catname)
, ("categoryDesc", I.textSplice catdesc)]

The behavior you are seeing is exactly what is intended. The reason you are having problems is because you're using runChildrenWithText which is a higher level function designed for situations where you are returning text nodes. It is meant for when you want that actual text on your page. What you are seeing is the correct way to achieve that.
A splice is a computation that returns a list of nodes.
type Splice n = HeistT n n [Node]
Node is a representation of the DOM as Haskell types, so if you want to return a link, you should do something like this:
return $ [Element "a" [("href", "http://localhost")] [TextNode (T.pack $ show catid)]]
To use this kind of a splice, you'll need to use runChildrenWith instead of runChildrenWithText.
If this manual creation of Nodes seems ugly to you, there's also a more convenient option. If you import the module Text.Blaze.Renderer.XmlHtml, you'll find functions there that let you generate Node trees using blaze-html syntax.

Related

Is it possible in Haskell to apply the function putStrLn to every element of a list of Strings, have it print to the screen, while being non recursive

I am trying to make a function that takes a list of strings and executes the command putStrLn or print (I think they are basically equivalent, please correct me if I am wrong as I'm still new to Haskell) to every element and have it printed out on my terminal screen. I was experimenting with the map function and also with lambda/anonymous functions as I already know how to do this recursively but wanted to try a more complex non recursive version. map returned a list of the type IO() which was not what I was going for and my attempts at lambda functions did not go according to plan. The basic code was:
test :: [String] -> something
test x = map (\a->putStrLn a) x -- output for this function would have to be [IO()]
Not entirely sure what the output of the function was supposed to be either which also gave me issues.
I was thinking of making a temp :: String variable and have each String appended to temp and then putStrLn temp but was not sure how to do that entirely. I though using where would be viable but I still ran into issues. I know how to do this in languages like java and C but I am still quite new to Haskell. Any help would be appreciated.
There is a special version of map that works with monadic functions, it's called mapM:
test :: [String] -> IO [()]
test x = mapM putStrLn x
Note that this way the return type of test is a list of units - that's because each call to putStrLn returns a unit, so result of applying it to each element in a list would be a list of units. If you'd rather not deal with this silliness and have the return type be a plain unit, use the special version mapM_:
test :: [String] -> IO ()
test x = mapM_ putStrLn x
I was thinking of making a temp :: String variable and have each String appended to temp and then putStrLn temp
Good idea. A pattern of "render the message" then a separate "emit the message" is often nice to have long term.
test xs = let temp = unlines (map show xs)
in putStrLn temp
Or just
test xs = putStrLn (unlines (show <$> xs))
Or
test = putStrLn . unlines . map show
Not entirely sure what the output of the function was supposed to be either which also gave me issues.
Well you made a list of IO actions:
test :: [String] -> [IO ()]
test x = map (\a->putStrLn a) x
So with this list of IO actions when do you want to execute them? Now? Just once? The first one many times the rest never? In what order?
Presumably you want to execute them all now. Let's also eta reduce (\a -> putStrLn a) to just putStrLn since that means the same thing:
test :: [String] -> IO ()
test x = sequence_ (map (\a->putStrLn a) x)

Logical OR in HXT without duplicating results

I'm having a little trouble with HXT: I am trying to locate all the nodes in a document that match some criteria, and I'm trying to combine the lenses/XPaths as predicates in an OR-like fashion, using Control.Arrow.<+>, as this guide suggests. However, when I try to "run" the arrow on my document, I am getting duplicate results. Is there an easy way to remove the duplicates, or to combine the tests in a more meaningful way? Here is my code:
run :: App -> IO ()
run a = do
inputContents <- readFile (input a)
let doc = readString [withParseHTML yes, withWarnings no] inputContents
links <- runX . xshow $ doc >>> indentDoc //> cssLinks
mapM_ putStrLn links
cssLinks = links >>> (rels <+> hrefs <+> types)
where
links = hasName "link"
rels = hasAttrValue "rel" (isInfixOf "stylesheet")
hrefs = hasAttrValue "href" (endswith ".css")
types = hasAttrValue "type" (== "text/css")
Yet every time I run this (on any web page), I get duplicated results / nodes. I noticed that <+> is part of the ArrowPlus typeclass, which mimics a monoid, and ArrowXML is an instance of both ArrowList and ArrowTree, which gives me a lot to work with. Would I have to construct ArrowIf predicates? Any help with this would be wonderful :)
You may get the arrow result as a [XmlTree], then apply List.nub, then get the string rep.
import "hxt" Text.XML.HXT.DOM.ShowXml as SX
...
links <- runX $ doc >>> indentDoc //> cssLinks
-- first remove duplicates (List.nub) then apply SX.xshow
putStrLn (SX.xshow . L.nub $ links)

Snap: compiled splices code example

I think I did asked a similar question some time ago but it was not answered due to unstable API. So I was waiting for the 0.13 to pass by. I am not sure if it is correct to bring up a similar question...?
What is the alternative to interpreted runChildrenWith(Text) and mapSplices in the compiled splices world? (this combination seems to be the most common)
I would really appreciate some code examples if possible.
If I understand correctly, we get together all the application splices and then add them to the heistInit. Can anyone show how to do it please?
Does the splice binding tag has to be unique across the whole application?
Is there a completed snap project utilising new APIs and compiled splices so that I could read and see learn?
Thank you.
-- UPDATE --
Great answer below. But some parts (the ones with lenses) got me even more confused, unfortunately.
If I understand correctly this is the simple way to splice a string:
mySplice = "testSplice" ## testSplice
where testSplice = return $ C.yieldRuntimeText $ do
return "text to be spliced"
If i need to run the spliced string several times, say in 5 table raws i would do it like this:
mySplices = C.manyWithSplices C.runChildren mySplice
Is this correct?
I get bunch of errors trying to add the splices in heist config.
addConfig h $ mempty
{
hcCompiledSplices = "mySplice" ## mySplice -- or mySplices
}
Where am I going wrong? Sorry for being slow.
All I need really ( just for now so I can understand) is to splice and display a simple string that I receive from database.
-- UPDATE 2 --
Thanks to the extremle helpfull Daniel`s answer I can finally get something working.
So far I get both variants of code working.
The first one, thanks to Daniel
stringSplice :: Monad n => C.Splice n
stringSplice = C.manyWithSplices C.runChildren splicefuncs (return ["aa","bb","cc"])
where
splicefuncs = "string" ## (C.pureSplice . C.textSplice $ id)
And the secod
testSplice :: C.Splice (Handler App App)
testSplice = return $ C.yieldRuntimeText $ return "text to be spliced"
Where
(C.pureSplice . C.textSplice $ id)
produces similar results to
return $ C.yieldRuntimeText $ return "text to be spliced"
Is there difference between the above? Any cases that one would prefer one to another? They seem to produce the same results.
There is a "deferMany" function in the compiled splices lib that, according to the docs, produces similar results to the mapSplices in interpreted lib.
Can we use it instead of "C.manyWithSplices C.runChildren" combination??
Let's say you want to display information about a list of persons using compiled splices (assume that we start from the scaffolding generated by snap init.)
A very simple _persons.tpl template with dummy values would be something like
<body>
<person>
<div>
<h1><name>dummy name</name></h1>
<p><age>77</age></p>
<p><location>jauja</location></p>
</div>
</person>
</body>
Where person, name, age, and location are the tags to be spliced.
We define a trivial Snaplet that holds the info
data Foo = Foo
{
_persons :: [Person]
}
makeLenses ''Foo
data Person = Person
{
_name :: Text
, _age :: Int
, _location :: Text
}
makeLenses ''Person
and we add it to the App record:
data App = App
{ _heist :: Snaplet (Heist App)
, _sess :: Snaplet SessionManager
, _auth :: Snaplet (AuthManager App)
, _foo :: Snaplet Foo
}
we add the following to the app initializer
f <- nestSnaplet "foo" foo $ makeSnaplet "foo" "Foo Snaplet" Nothing $ return $ Foo $
[ Person "Ricardo" 33 "Los Cantones"
, Person "Luis" 38 "Montealto"
]
...
return $ App h s a f
This function constructs a Handler that returns the list of persons (using view from Control.Lens):
personH :: SnapletLens b Foo -> Handler b b [Person]
personH l = withTop l $ view persons <$> get
This function constructs the appropiate compiled splice from a RuntimeSplice that produces a list of Persons. RuntimeSplices represent information that can only be known at run time, as opposed to load time:
personSplice :: Monad n => RuntimeSplice n [Person] -> C.Splice n
personSplice = C.manyWithSplices C.runChildren splicefuncs
where
splicefuncs = mconcat
[ "name" ## (C.pureSplice . C.textSplice $ view name)
, "age" ## (C.pureSplice . C.textSplice $ T.pack . show . view age)
, "location" ## (C.pureSplice . C.textSplice $ view location)
]
And this function can be used to register the splice in the global Heist configuration. Notice that we lift the Handler into a RuntimeSplice:
addPersonSplices :: HasHeist b => Snaplet (Heist b) ->
SnapletLens b Foo ->
Initializer b v ()
addPersonSplices h l = addConfig h $ mempty
{
hcCompiledSplices = "person" ## (personSplice . lift $ personH l)
}
Be sure to add this line to the app initializer:
addPersonSplices h foo
And to add the following pair to the app's routes:
("/persons", cRender "_persons")
If you now run the server, navigating to http://127.0.0.1:8000/persons should show the list.
UPDATE
For the simpler case (no complex records, no lenses) in which you only want to show a list of strings.
The template could be something like:
<body>
<strings>
<p><string>dummy value</string></p>
</strings>
</body>
The top-level splice would be:
stringSplice :: Monad n => C.Splice n
stringSplice = C.manyWithSplices C.runChildren splicefuncs (return ["aa","bb","cc"])
where
splicefuncs = "string" ## (C.pureSplice . C.textSplice $ id)
This means "when we encounter the tag associated to this splice, perform an action that produces a list of strings, and for each string, render the contents of the tag, substituting the current string for the string tag".
Notice that the signature of manyWithSplices forces the stuff to the right of the (##) to have type RuntimeSplice n Text -> Splice n. Here id has type Text -> Text. C.TextSplice transforms it into something of type Text -> Builder, and C.pureSplice performs the final transformation into a RuntimeSplice n Text -> Splice n.
In place of (return ["aa","bb","cc"]) you could provide a more complex action that connected a database and extracted the strings form there.
A function to register this splice would be:
addStringSplices :: HasHeist b => Snaplet (Heist b) -> Initializer b v ()
addStringSplices h = addConfig h $ mempty
{
hcCompiledSplices = "strings" ## stringSplice
}

How to use MultiPiece

I'm completely new to Yesod (and not very experienced in haskell) and I'm trying to build my first handler. I scraffolded my app using default parameters (I'm using Yesod 0.9.4.1 version and choose postgresql in scraffolding) and now I'm trying to retrieve some data from a table using selectList. I defined a new table (let's call it Foo) in models config file:
Foo
xStart Int
yStart Int
and want to pass a list of FooId's and some other Foo attributes so I defined a route:
/foos/#Int/#Int/*FooId FoosReturnR GET
and a handler:
module Handler.FoosReturn where
import Import
selectWindowSize :: Int
selectWindowSize = 10000
getFoosReturnR :: Int -> Int -> [FooId] -> Handler RepPlain
getFoosReturnR x y withoutIds = do
foos <- runDB $ selectList [FooId /<-. withoutIds,
FooXStart <. x + selectWindowSize,
FooXStart >=. x - selectWindowSize,
FooYStart <. y + selectWindowSize,
FooYStart >=. y - selectWindowSize] []
return $ RepPlain $ toContent $ show foos
I imported the handler in Application.hs and added it to cabal file and now when I'm trying to run it I receive an error saying that FooId is not an instance of MultiPiece - but when I try to make it an instance there is an error saying that FooId is a type synonym and cannot be an instance of MultiPiece - how to resolve this problem?
EDIT:
Daniel: well, actually I don't know what exactly is FooId - it's a part of Yesod's magic which I don't fully understand so far - it's generated automatically from the table definition - but it's a some kind of a number.
Because I don't know how to use MultiPiece I switched to simpler solution and modified:
route: /foos/#Int/#Int/#String FoosReturnR GET
handler: [added also some logging]
module Handler.FoosReturn where
import Import
import Data.List.Split
import qualified Data.Text.Lazy as TL
selectWindowSize :: Int
selectWindowSize = 10000
getFoosReturnR :: Int -> Int -> String -> Handler RepPlain
getFoosReturnR x y withoutIds = do
app <- getYesod
liftIO $ logLazyText (getLogger app) ("getFoosReturnR('" `TL.append` (TL.pack $ (show x) ++ "', '" ++ (show y) ++ "', '" ++ withoutIds ++ "') "))
foos <- runDB $ selectList [FooId /<-. (map (\a -> read a :: FooId) $ splitOn "," withoutIds),
FooXStart <. x + selectWindowSize,
FooXStart >=. x - selectWindowSize,
FooYStart <. y + selectWindowSize,
FooYStart >=. y - selectWindowSize] []
return $ RepPlain $ toContent $ show foos
and now it is compiling but when I browse to: http://localhost:3000/sectors/1/1/1,2 I get a page containing only:
Internal Server Error
Prelude.read: no parse
Well, I don't fully understand what is FooId here - how to create such a list of FooId's from list of strings containing numbers?
And of course a solution of how to make the FooId an instance of MultiPiece is most wanted.
EDIT:
Daniel and svachalek, thanks for your posts - I tried your (Daniel's) solution but then I was receiving errors saying that [FooId] is expected (as in the handler function declaration) but FooId type was given and this lead me to the following solution:
data FooIds = FooIds [FooId] deriving (Show, Read, Eq)
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (Data.Text.pack . show) fooList
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case reads (Data.Text.unpack x) :: [(FooId,String)] of
[(foo,_)] -> Just foo
_ -> Nothing
of course I changed the route to: /foos/#Int/#Int/*FooIds FoosReturnR GET
and the handler to:
getFoosReturnR :: Int -> Int -> FooIds -> Handler RepPlain
getFoosReturnR coordX coordY (FooIds withoutIds) = do
and now I don't get any errors during compilation nor runtime, and the only not satisfying thing is that I always receive Not Found as a result, even if I supply parameters that should give me some results - so now I have to figure out how to determine what SQL was exactly sent to the database
EDIT:
Now I see that the "Not Found" is connected to the problem and that the above edit is not a solution - when I browse to localhost:3000/foos/4930000/3360000 then I get the results (but then the FooIds is empty) - but when I add something like: localhost:3000/sectors/4930000/3360000/1 then I always get "Not Found" - so it's still not working..
Wish I could help, but yesod has something to do with web applications, as far as I know, hence I've never really looked at it. So I can just try a stab in the air, maybe I hit something.
Hayoo leads to
class MultiPiece s where
fromMultiPiece :: [Text] -> Maybe s
toMultiPiece :: s -> [Text]
in Yesod.Dispatch. Since FooId seems to have a Read instance and probably a Show instance, you could try
{-# LANGUAGE TypeSynonymInstances #-}
-- maybe also FlexibleInstances
instance MultiPiece FooId where
toMultiPiece foo = [Text.pack $ show foo]
fromMultiPiece texts =
case reads (unpack $ Text.concat texts) :: [(FooId,String)] of
[(foo,_)] -> Just foo
_ -> Nothing
I have no idea whether that is close to the right thing, and I would have posted it as a comment, but it's too long and there's not much formatting in comments. If it doesn't help I will delete it to not give the impression your question already has an answer when it hasn't.
The problem is solved:)
You could either use my implementation from one of the last edits of the question and browse to URL like: http://localhost:3000/foos/4930000/3360000/Key {unKey = PersistInt64 3}/Key {unKey = PersistInt64 4}
The Key type derives Read but not in a very friendly (and expected) way:)
Or change the implementation of fromMultiPiece to:
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (Data.Text.pack . show) fooList
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case TR.decimal x of
Left err -> Nothing
Right (el,_) -> Just $ Key (PersistInt64 el)
and use URLs like: http://localhost:3000/foos/4930000/3360000/1/2
Many thanks to David McBride from the Yesod Web Framework Google Group
EDIT: the above solution had only one disadvantage - using the PersistInt64 type - it's not a good practice to use such a details of implementation, but it can be repaired by using fromPersistValue and toPersistValue functions from Database.Persist as follows:
instance MultiPiece FooIds where
toMultiPiece (FooIds fooList) = map (persistValuetoText . unKey) fooList
where
persistValuetoText x = case fromPersistValue x of
Left _ -> Data.Text.pack ""
Right val -> Data.Text.pack $ show (val::Int)
fromMultiPiece texts =
if length (filter isNothing listOfMaybeFooId) > 0
then Nothing
else Just $ FooIds $ map fromJust listOfMaybeFooId
where
listOfMaybeFooId = map constructMaybeFooId texts
constructMaybeFooId :: Text -> Maybe FooId
constructMaybeFooId x = case TR.decimal x of
Left _ -> Nothing
Right (el,_) -> Just $ Key (toPersistValue (el :: Int))
Again, big thanks to David McBride also for this!
I'm also fairly new to Yesod and I gave in and added -XTypeSynonymInstances to the ghc-options in my .cabal file, and so far it's made life a lot easier for me. I'm not sure if it's the most elegant answer to this particular problem, but otherwise I predict you'll run into that instance-of-alias error pretty frequently. P.S. try id = (Key (PersistInt 64 n))

Haskell: can't use "map putStrLn"?

I have a list of strings, and tried this:
ls = [ "banana", "mango", "orange" ]
main = do
map PutStrLn list_of_strings
That didn't work, and I can't understand why.
ghc print-list.hs
print-list.hs:3:0:
Couldn't match expected type `IO t' against inferred type `[IO ()]'
In the expression: main
When checking the type of the function `main'
Any hints? I suppose it has to do with map returning a list and not a value, but I didn't find an easy way to fix this.
Right now the only way I know to print a list of strings is to write a function that will iterate the list, printing each element (print if the list is [a], but print and recurse if it's (a:b)). But it would be much simpler to just use map...
Thanks!
The type of the main function should be IO t (where t is a type variable). The type of map putStrLn ls is [IO ()]. This why you are getting this error message. You can verify this yourself by running the following in ghci:
Prelude> :type map putStrLn ls
map putStrLn ls :: [IO ()]
One solution to the problem is using mapM, which is the "monadic" version of map. Or you can use mapM_ which is the same as mapM but does not collect the returned values from the function. Since you don't care about the return value of putStrLn, it's more appropriate to use mapM_ here. mapM_ has the following type:
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
Here is how to use it:
ls = [ "banana", "mango", "orange" ]
main = mapM_ putStrLn ls
Ayman's answer makes most sense for this situation. In general, if you have [m ()] and you want m (), then use sequence_, where m can be any monad including IO.

Resources