cleanup main

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.Text.Lazy qualified as TL
-import Data.Time (MonthOfYear, Year, fromGregorian, toGregorian)
+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
+            then do
-                  status status400
+              status status400
-                  text "Invalid date"
+              text "Invalid date"
-              else do
+            else do
-                linesArray <- liftIO $ getFromUrl "https://cdav.chipburners.club/public/main/"
+              linesArray <- liftIO $ getFromUrl "https://cdav.chipburners.club/public/main/"
-                timeNow <- liftIO $ getCurrentTime
+              timeNow <- liftIO $ getCurrentTime
-                tmz <- liftIO $ getCurrentTimeZone
+              tmz <- liftIO $ getCurrentTimeZone
 
-                let firstOfMonth = fromGregorian year month 1
+              let firstOfMonth = fromGregorian year month 1
-                    start = addDays (-7) firstOfMonth
+                  start = addDays (-7) firstOfMonth
-                    end = addDays (37) firstOfMonth
+                  end = addDays (37) firstOfMonth
-                    today = utcToLocalTime tmz timeNow
+                  today = utcToLocalTime tmz timeNow
-                    dayToday = localDay today
+                  dayToday = localDay today
-                    events = readCalendar linesArray
+                  events = readCalendar linesArray
-                    validEvents = getEventsFromTo (rights events) start end 
+                  validEvents = getEventsFromTo (rights events) start end
-                    groupedEvents = groupEvents validEvents
+                  groupedEvents = groupEvents validEvents
-                    -- dayToday = localDay today
+                  errors = lefts events
-                    -- (y, m, _) = toGregorian dayToday
+              when (not $ null errors) $ do
-                -- errors = lefts events
+                liftIO $ print errors
 
-                html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
+              html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
-
-
-          -- get "/greet/:name" $ do
-          --   name <- param "name"
-          --   "Hello, " <> name <> "! Hope you're enjoying Haskell."
     )
-
--- 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

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,