From fa8b4face21b0a32e01a2b4e2669f7dce1a43626 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 31 Aug 2023 13:11:12 +1200
Subject: [PATCH] Assemble testscript as locally-run webserver, adjust
 namespace.

---
 app/Main.hs                                    | 17 ++++++++++++++++-
 bureaucromancy.cabal                           |  4 ++--
 src/Network/HTTP/Form.hs                       |  3 ---
 src/Text/HTML/Form.hs                          |  3 +++
 src/{Network/HTTP => Text/HTML}/Form/WebApp.hs |  8 ++++----
 5 files changed, 25 insertions(+), 10 deletions(-)
 delete mode 100644 src/Network/HTTP/Form.hs
 create mode 100644 src/Text/HTML/Form.hs
 rename src/{Network/HTTP => Text/HTML}/Form/WebApp.hs (51%)

diff --git a/app/Main.hs b/app/Main.hs
index 76e4cc6..076722f 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,5 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Main where
 
+import Network.Wai.Handler.Warp
+import Network.Wai
+import Network.HTTP.Types
+
+import Text.HTML.Form.WebApp
+import Data.Text.Lazy.Encoding (encodeUtf8)
+import Data.Text.Lazy (fromStrict)
+
 main :: IO ()
 main = do
-  putStrLn "Hello, Haskell!"
+  runEnv 2018 servePage
+
+servePage 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!"
diff --git a/bureaucromancy.cabal b/bureaucromancy.cabal
index 142dff5..be79257 100644
--- a/bureaucromancy.cabal
+++ b/bureaucromancy.cabal
@@ -62,7 +62,7 @@ library
     import:           warnings
 
     -- Modules exported by the library.
-    exposed-modules:  Network.HTTP.Form, Network.HTTP.Form.WebApp
+    exposed-modules:  Text.HTML.Form, Text.HTML.Form.WebApp
 
     -- Modules included in this library but not exported.
     -- other-modules:
@@ -95,7 +95,7 @@ executable bureaucromancy
     -- Other library packages from which modules are imported.
     build-depends:
         base ^>=4.16.4.0,
-        bureaucromancy, warp
+        bureaucromancy, warp, wai, http-types, text
 
     -- Directories containing source files.
     hs-source-dirs:   app
diff --git a/src/Network/HTTP/Form.hs b/src/Network/HTTP/Form.hs
deleted file mode 100644
index e449203..0000000
--- a/src/Network/HTTP/Form.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module Network.HTTP.Form (Form(..)) where
-
-data Form = Form
diff --git a/src/Text/HTML/Form.hs b/src/Text/HTML/Form.hs
new file mode 100644
index 0000000..9bf71c0
--- /dev/null
+++ b/src/Text/HTML/Form.hs
@@ -0,0 +1,3 @@
+module Text.HTML.Form (Form(..)) where
+
+data Form = Form
diff --git a/src/Network/HTTP/Form/WebApp.hs b/src/Text/HTML/Form/WebApp.hs
similarity index 51%
rename from src/Network/HTTP/Form/WebApp.hs
rename to src/Text/HTML/Form/WebApp.hs
index 6823ff7..08ac5a7 100644
--- a/src/Network/HTTP/Form/WebApp.hs
+++ b/src/Text/HTML/Form/WebApp.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Network.HTTP.Form.WebApp (renderPage) where
+module Text.HTML.Form.WebApp (renderPage, Form(..)) where
 
 import Data.ByteString as BS
 import Data.Text as Txt
-import Network.HTTP.Form (Form(..))
+import Text.HTML.Form (Form(..))
 
-renderPage :: Form -> [Text] -> [(ByteString, Maybe ByteString)] -> IO Text
-renderPage _ _ _ = return ""
+renderPage :: Form -> [Text] -> [(ByteString, Maybe ByteString)] -> IO (Maybe Text)
+renderPage _ _ _ = return $ Just ""
-- 
2.30.2