cleanup main

This commit is contained in:
Daniel Kauss Serna 2026-01-26 14:09:44 +01:00
parent 6667a969b7
commit acebe8903a
2 changed files with 30 additions and 56 deletions

View file

@ -1,21 +1,21 @@
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Types (status400)
import Control.Monad (when)
import Data.ByteString.Lazy qualified as BL
import Data.Either (rights)
import Data.Either (lefts, rights)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Time (addDays, getCurrentTime)
import Data.Time (MonthOfYear, Year, fromGregorian, toGregorian)
import Data.Text.Lazy qualified as TL
import Data.Time (MonthOfYear, Year, addDays, fromGregorian, getCurrentTime, toGregorian)
import Data.Time.LocalTime
import Ical
import Lucid (renderText)
import Network.HTTP.Simple
import Network.HTTP.Types (status400)
import Network.Wai.Middleware.Static
import Render
import Web.Scotty
import qualified Data.Text.Lazy as TL
import Text.Printf (printf)
import Web.Scotty
getFromUrl :: String -> IO T.Text
getFromUrl url = do
@ -42,8 +42,9 @@ main =
endD = addDays 30 dayToday
events = readCalendar linesArray
validEvents = take 5 $ getEventsFromTo (rights events) dayToday endD
-- TODO: errors
-- errors = lefts events
errors = lefts events
when (not $ null errors) $ do
liftIO $ print errors
html $ renderText $ renderFrontpage validEvents
get "/monthView/" $ do
@ -53,58 +54,32 @@ main =
let today = utcToLocalTime tmz timeNow
dayToday = localDay today
(y, m, _) = toGregorian dayToday
redirect $ TL.pack $ printf "/monthView/%s/%s" (show y) (show m)
redirect $ TL.pack $ printf "/monthView/%s/%s" (show y) (show m)
get "/monthView/:year/:month" $ do
year :: Year <- pathParam "year"
month :: MonthOfYear <- pathParam "month"
month :: MonthOfYear <- pathParam "month"
if (year <= 2000 || year >= 3000 || month < 1 || month > 12)
then do
status status400
text "Invalid date"
else do
linesArray <- liftIO $ getFromUrl "https://cdav.chipburners.club/public/main/"
timeNow <- liftIO $ getCurrentTime
tmz <- liftIO $ getCurrentTimeZone
then do
status status400
text "Invalid date"
else do
linesArray <- liftIO $ getFromUrl "https://cdav.chipburners.club/public/main/"
timeNow <- liftIO $ getCurrentTime
tmz <- liftIO $ getCurrentTimeZone
let firstOfMonth = fromGregorian year month 1
start = addDays (-7) firstOfMonth
end = addDays (37) firstOfMonth
today = utcToLocalTime tmz timeNow
dayToday = localDay today
events = readCalendar linesArray
validEvents = getEventsFromTo (rights events) start end
groupedEvents = groupEvents validEvents
-- dayToday = localDay today
-- (y, m, _) = toGregorian dayToday
-- errors = lefts events
let firstOfMonth = fromGregorian year month 1
start = addDays (-7) firstOfMonth
end = addDays (37) firstOfMonth
today = utcToLocalTime tmz timeNow
dayToday = localDay today
events = readCalendar linesArray
validEvents = getEventsFromTo (rights events) start end
groupedEvents = groupEvents validEvents
errors = lefts events
when (not $ null errors) $ do
liftIO $ print errors
html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
-- get "/greet/:name" $ do
-- name <- param "name"
-- "Hello, " <> name <> "! Hope you're enjoying Haskell."
html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
)
-- pure finalHtml
-- let event = toEvent ["SUMMARY:Hello!", "Random Line", "DTSTART:20260123T140000", "DTEND:20260123T140000", "RRULE:FREQ=WEEKLY;BYDAY=MO,TU,SA;COUNT=7"]
-- case event of
-- Right eve -> case parseDate "20260226T140000" of
-- Right c -> print $ expandEvent eve (localDay c)
-- _ -> print "Failed parse date"
-- _ -> print "failed event parse"
--
-- linesArray <- getFromUrl "https://cdav.chipburners.club/public/main/"
-- linesArray <- getFromUrl "http://www.upv.es/ical/3F60368113136708712FBB9C9243EDDC339D45EB9EAA9004F084E8DCF0F37A8F1AB9C2153EC8F12E1DFDFF671D7A52CE"
-- print (readCalendar linesArray)
-- end <- getCurrentTime
-- tmz <- getCurrentTimeZone
-- let today = utcToLocalTime tmz end
-- let endD = addDays 30 (localDay today)
-- let events = getNextEventsUntil (rights (readCalendar linesArray)) 10 endD
-- updateIndexHtml events
-- print
-- events