summaryrefslogtreecommitdiff
path: root/pkgs/nomsring/Main.hs
blob: 1cc2d7c26eab807e6cb6fbe3a5bb9c10527cb166 (plain)
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
34
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"
  , "noms.ing"
  , "nwex.de"
  , "nurflossen.de/hajar/cynthia"
  ]

main :: IO ()
main = runCGI $ do
  path <- pathInfo
  case path of
    "/" -> redirect "https://noms.ing"
    "/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