Added pretty-yaml sample

yesodweb · Mar 4, 2010 · e857927 · e857927
1 parent 465188e
commit e857927
Show file tree

Hide file tree

Showing 2 changed files with 54 additions and 0 deletions.
diff --git a/examples/pretty-yaml.hs b/examples/pretty-yaml.hs
@@ -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
diff --git a/examples/pretty-yaml.st b/examples/pretty-yaml.st
@@ -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>