From 7f11cf1617aed8930598d7bd908ee1625cbc97f7 Mon Sep 17 00:00:00 2001
From: Daniel Schadt <kingdread@gmx.de>
Date: Sun, 1 Mar 2020 18:10:12 +0100
Subject: rewrite imgHostMain

The right-drift was not nice to look at, so we're now doing the dispatch
using a small helper method.
---
 src/Lib.hs | 29 ++++++++++++++++++++---------
 1 file changed, 20 insertions(+), 9 deletions(-)

(limited to 'src')

diff --git a/src/Lib.hs b/src/Lib.hs
index 2b5f0a1..5a48f3f 100644
--- a/src/Lib.hs
+++ b/src/Lib.hs
@@ -291,12 +291,23 @@ handleUpload = do
 -- Depending on the given parameters, this either dispatches to
 -- 'handleCleanup', 'handleUpload' or just returns the 'indexPage'.
 imgHostMain :: App CGIResult
-imgHostMain = do
-    cleanup <- getInput "cleanup"
-    case cleanup of
-      Just _ -> handleCleanup
-      Nothing -> do
-          method <- requestMethod
-          case method of
-            "POST" -> handleUpload
-            _ -> output indexPage
+imgHostMain = dispatch [ (doCleanup, handleCleanup)
+                       , (doUpload, handleUpload)
+                       , (doDefault, output indexPage)
+                       ]
+    where
+        dispatch :: [(App Bool, App CGIResult)] -> App CGIResult
+        dispatch ((c, a):as) = do
+            take_that <- c
+            if take_that then a
+                         else dispatch as
+        dispatch [] = do
+            setStatus 500 "Internal Server Error"
+            output "No dispatch could be done :("
+
+        doCleanup :: App Bool
+        doCleanup = isJust <$> getInput "cleanup"
+        doUpload :: App Bool
+        doUpload = ("POST" ==) <$> requestMethod
+        doDefault :: App Bool
+        doDefault = return True
-- 
cgit v1.2.3