From acebe8903a6205a426264abc62599f6f655a53cd Mon Sep 17 00:00:00 2001 From: Daniel Kauss Serna Date: Mon, 26 Jan 2026 14:09:44 +0100 Subject: [PATCH] cleanup main --- app/Main.hs | 85 +++++++++++++++++++---------------------------------- src/Ical.hs | 1 - 2 files changed, 30 insertions(+), 56 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 027d06a..366217a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/src/Ical.hs b/src/Ical.hs index 7fa7370..f634f09 100644 --- a/src/Ical.hs +++ b/src/Ical.hs @@ -105,7 +105,6 @@ expandEvent e@(Event _ _ _ _ start end rule) maxViewDate = validRuleDates = applyLimit (limit rule) infiniteStream - -- TODO: I think its alway sorted so this works visibleDates = takeWhile (<= maxViewDate) validRuleDates in [ e { dtStart = newStart,