{-# LANGUAGE OverloadedStrings #-} module Main where import Network.Wai.Handler.Warp import Network.Wai import Network.HTTP.Types import System.Environment (getArgs) import Text.HTML.Form.WebApp import Text.HTML.Form.Query import Text.HTML.Form import Data.Text.Lazy.Encoding (encodeUtf8) import qualified Data.Text.Encoding as Txt import Data.Text.Lazy (fromStrict) import qualified Data.Text as Txt import qualified Text.HTML.DOM as HTML import Data.Maybe (fromJust, fromMaybe) main :: IO () main = do args <- getArgs let (filename, ident) = case args of n:anchor:_ -> (n, anchor) [n] -> (n, "0") [] -> ("form.html", "0") doc <- HTML.readFile filename let form = ensureButtons $ fromJust $ parseDocument doc $ Txt.pack ident putStrLn "http://127.0.0.1:2018/" runEnv 2018 $ servePage form servePage :: Form -> Application servePage form req respond = do ret <- renderPage form (pathInfo req) (queryString req) case ret of Just (Right txt) -> respond $ responseLBS status200 [] $ encodeUtf8 $ fromStrict txt Just (Left qs) -> respond $ responseLBS status200 [] $ encodeUtf8 $ fromStrict $ Txt.pack $ renderQueryString' [(utf8 k, utf8 $ fromMaybe "" v) | (k, v) <- qs] Nothing -> respond $ responseLBS status404 [] "Unknown input or operation!" utf8 = Txt.unpack . Txt.decodeUtf8