~alcinnz/bureaucromancy

ref: 4e46e68a618bedfb66e14ca4e8b975198175ab44 bureaucromancy/app/Main.hs -rw-r--r-- 992 bytes
4e46e68a — Adrian Cochrane Add infrastructure for parsing documents. 1 year, 4 months ago
                                                                                
fa8b4fac Adrian Cochrane
9ecdfe8a Adrian Cochrane
fa8b4fac Adrian Cochrane
4e46e68a Adrian Cochrane
fa8b4fac Adrian Cochrane
4e46e68a Adrian Cochrane
fa8b4fac Adrian Cochrane
4e46e68a Adrian Cochrane
fa8b4fac Adrian Cochrane
9ecdfe8a Adrian Cochrane
4e46e68a Adrian Cochrane
fa8b4fac Adrian Cochrane
4e46e68a Adrian Cochrane
fa8b4fac Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
{-# 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

import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Text.Lazy (fromStrict)
import qualified Data.Text as Txt
import Text.XML (readFile, def)
import Data.Maybe (fromJust)

main :: IO ()
main = do
  args <- getArgs
  let (filename, ident) = case args of
        n:anchor:_ -> (n, anchor)
        [n] -> (n, "0")
        [] -> ("form.html", "0")
  doc <- Text.XML.readFile def filename
  runEnv 2018 $ servePage $ fromJust $ parseDocument doc $ Txt.pack ident

servePage :: Form -> Application
servePage form req respond = do
    ret <- renderPage form (pathInfo req) (queryString req)
    case ret of
        Just txt -> respond $ responseLBS status200 [] $ encodeUtf8 $ fromStrict txt
        Nothing -> respond $ responseLBS status404 [] "Unknown input or operation!"