~alcinnz/bureaucromancy

ref: c1e09d4ada65150d6bd9c391dd1aa4a1bf20b539 bureaucromancy/app/Main.hs -rw-r--r-- 991 bytes
c1e09d4a — Adrian Cochrane Render onscreen keyboards (not interactive yet). 1 year, 3 months ago
                                                                                
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 qualified Text.HTML.DOM as HTML
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 <- HTML.readFile 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!"