68 lines
1.7 KiB
Haskell
68 lines
1.7 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
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
|
|
import Data.Object.String
|
|
|
|
data PY = PY
|
|
|
|
mkYesod "PY" [$parseRoutes|
|
|
/ Homepage GET POST
|
|
|]
|
|
|
|
instance Yesod PY where
|
|
approot _ = "http://localhost:3000"
|
|
|
|
template :: Monad m => TempArgs url m -> Hamlet url m ()
|
|
template = [$hamlet|
|
|
!!!
|
|
%html
|
|
%head
|
|
%meta!charset=utf-8
|
|
%title Pretty YAML
|
|
%body
|
|
%form!method=post!action=.!enctype=multipart/form-data
|
|
File name:
|
|
%input!type=file!name=yaml
|
|
%input!type=submit
|
|
$if hasYaml
|
|
%div ^yaml^
|
|
|]
|
|
|
|
data TempArgs url m = TempArgs
|
|
{ hasYaml :: Bool
|
|
, yaml :: Hamlet url m ()
|
|
}
|
|
|
|
getHomepage :: Handler PY RepHtml
|
|
getHomepage = hamletToRepHtml
|
|
$ template $ TempArgs False (return ())
|
|
|
|
--FIXMEpostHomepage :: Handler PY RepHtmlJson
|
|
postHomepage :: Handler PY RepHtml
|
|
postHomepage = do
|
|
rr <- getRequest
|
|
(_, files) <- liftIO $ reqRequestBody rr
|
|
fi <- case lookup "yaml" files of
|
|
Nothing -> invalidArgs [("yaml", "Missing input")]
|
|
Just x -> return x
|
|
so <- liftIO $ decode $ B.concat $ L.toChunks $ fileContent fi
|
|
{- FIXME
|
|
let ho' = fmap Text to
|
|
templateHtmlJson "pretty-yaml" ho' $ \ho ->
|
|
return . setHtmlAttrib "yaml" (Scalar $ cs ho :: HtmlObject)
|
|
-}
|
|
let ho = cs (so :: StringObject) :: HtmlObject
|
|
hamletToRepHtml $ template $ TempArgs True (cs ho)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
putStrLn "Running..."
|
|
toWaiApp PY >>= run 3000
|