initial commit

app/Main.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Network.HTTP.Types (status400)
+import Data.ByteString.Lazy qualified as BL
+import Data.Either (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.Time.LocalTime
+import Ical
+import Lucid (renderText)
+import Network.HTTP.Simple
+import Network.Wai.Middleware.Static
+import Render
+import Web.Scotty
+import qualified Data.Text.Lazy as TL
+import Text.Printf (printf)
+
+getFromUrl :: String -> IO T.Text
+getFromUrl url = do
+  r <- parseRequest url
+  response <- httpLBS r
+  let rBody = getResponseBody response
+  let rText = TE.decodeUtf8 (BL.toStrict rBody)
+  pure $ T.replace "\n " " " $ T.replace "\r\n" "\n" rText
+
+main :: IO ()
+main =
+  scotty
+    3456
+    ( do
+        middleware $ staticPolicy (noDots >-> addBase "static")
+
+        get "/" $ do
+          linesArray <- liftIO $ getFromUrl "https://cdav.chipburners.club/public/main/"
+          timeNow <- liftIO $ getCurrentTime
+          tmz <- liftIO $ getCurrentTimeZone
+
+          let today = utcToLocalTime tmz timeNow
+              dayToday = localDay today
+              endD = addDays 30 dayToday
+              events = readCalendar linesArray
+              validEvents = take 5 $ getEventsFromTo (rights events) dayToday endD
+          -- TODO: errors
+          -- errors = lefts events
+
+          html $ renderText $ renderFrontpage validEvents
+        get "/monthView/" $ do
+          timeNow <- liftIO $ getCurrentTime
+          tmz <- liftIO $ getCurrentTimeZone
+
+          let today = utcToLocalTime tmz timeNow
+              dayToday = localDay today
+              (y, m, _) = toGregorian dayToday
+          redirect $ TL.pack $ printf "/monthView/%s/%s" (show y) (show m) 
+
+        get "/monthView/:year/:month" $ do
+          year :: Year <- pathParam "year"
+          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
+
+                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
+
+                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