haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added pretty-yaml sample

Browse Source
This commit is contained in:
Snoyman 2010-03-04 14:19:52 -08:00
parent 465188e166
commit e857927e2d
2 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
examples/pretty-yaml.hs Normal file
View File

@ -0,0 +1,38 @@
{-# LANGUAGE QuasiQuotes #-}
import Yesod
import Data.Object.Yaml
import Network.Wai.Handler.SimpleServer
import Web.Encodings
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
data PY = PY TemplateGroup
instance YesodTemplate PY where
getTemplateGroup (PY tg) = tg
defaultTemplateAttribs _ _ = return
instance Yesod PY where
resources = [$mkResources|
/:
GET: homepageH
POST: showYamlH
|]
homepageH :: Handler PY RepHtml
homepageH = templateHtml "pretty-yaml" return
showYamlH :: Handler PY RepHtmlJson
showYamlH = do
rr <- getRawRequest
(_, files) <- liftIO $ rawRequestBody rr
fi <- case lookup "yaml" files of
Nothing -> invalidArgs [("yaml", "Missing input")]
Just x -> return x
to <- decode $ B.concat $ L.toChunks $ fileContent fi
let ho' = fmap Text to
templateHtmlJson "pretty-yaml" ho' $ \ho ->
return . setHtmlAttrib "yaml" (Scalar $ cs ho :: HtmlObject)
main :: IO ()
main = do
putStrLn "Running..."
loadTemplateGroup "examples" >>= toWaiApp . PY >>= run 3000

16
examples/pretty-yaml.st Normal file
View File

@ -0,0 +1,16 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8">
<title>Pretty YAML</title>
</head>
<body>
<form method="post" action="." enctype="multipart/form-data">
File name: <input type="file" name="yaml">
<input type="submit">
</form>
$if(yaml)$
<div>$yaml$</div>
$endif$
</body>
</html>