nomsable webring

(just messing around for now)

1 files changed, 32 insertions, 0 deletions

diff --git a/pkgs/nomsring/Main.hs b/pkgs/nomsring/Main.hs
new file mode 100644
index 0000000..5c70491
--- /dev/null
+++ b/pkgs/nomsring/Main.hs
@@ -0,0 +1,32 @@
+module Main where
+
+import Network.CGI (CGIResult, runCGI, getInput, output, redirect, pathInfo, CGI, outputNotFound, liftIO)
+import Data.CircularList (CList, fromList, rotR, rotateTo, focus, rotL)
+import Data.Maybe(fromJust, fromMaybe)
+import Data.Functor ((<&>))
+
+webring :: CList String
+webring = fromList
+  [ "stuebinm.eu"
+  , "nwex.de"
+  ]
+
+main :: IO ()
+main = runCGI $ do
+  path <- pathInfo
+  case path of
+    "/" -> output "nomsable websites"
+    "/next" -> rotate True
+    "/previous" -> rotate False
+    _ -> outputNotFound path
+
+rotate :: Bool -> CGI CGIResult
+rotate backwards = do
+  from <- getInput "from" <&> fromMaybe (focus' webring)
+  case rotateTo from webring of
+    Nothing -> redirect ("https://" <> focus' webring)
+    Just ring -> redirect ("https://" <> focus' (step ring))
+    where step = if backwards then rotL else rotR
+
+focus' :: CList c -> c
+focus' = fromJust . focus