daniel_kauss/chipburners_web
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Calendar event now points to wiki

Browse source
This commit is contained in:
Daniel Kauss Serna 2026-02-06 11:45:23 +01:00
parent 6ee5998e82
commit 0b7e284986
2 changed files with 27 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/Ical.hs
View file

@ -35,6 +35,7 @@ data Event = Event
{ summary :: T.Text, { summary :: T.Text,
euid :: T.Text, euid :: T.Text,
description :: T.Text, description :: T.Text,
url :: T.Text,
location :: T.Text, location :: T.Text,
dtStart :: LocalTime, dtStart :: LocalTime,
dtEnd :: LocalTime, dtEnd :: LocalTime,
@ -97,7 +98,7 @@ applyLimit lim dates = case lim of
Count c -> take c dates Count c -> take c dates
expandEvent :: Event -> Day -> [Event] expandEvent :: Event -> Day -> [Event]
expandEvent e@(Event _ _ _ _ start end rule) maxViewDate = expandEvent e@(Event _ _ _ _ _ start end rule) maxViewDate =
let startDate = localDay start let startDate = localDay start
duration = diffLocalTime end start duration = diffLocalTime end start
@ -198,6 +199,7 @@ toEvent input = do
let optional opt p = M.findWithDefault opt p params let optional opt p = M.findWithDefault opt p params
summText <- require "SUMMARY" summText <- require "SUMMARY"
url <- require "URL"
uid <- require "UID" uid <- require "UID"
startText <- require "DTSTART" startText <- require "DTSTART"
endText <- require "DTEND" endText <- require "DTEND"
@ -212,7 +214,7 @@ toEvent input = do
startDate <- parseDate startText <+?> "Error reading start Date: " startDate <- parseDate startText <+?> "Error reading start Date: "
endDate <- parseDate endText <+?> "Error reading end Date: " endDate <- parseDate endText <+?> "Error reading end Date: "
pure $ Event summText uid descriptionText loc startDate endDate rrule pure $ Event summText uid descriptionText url loc startDate endDate rrule
-- This is very nice, replace Left with a different Left -- This is very nice, replace Left with a different Left
(<?>) :: Either e a -> String -> Either String a (<?>) :: Either e a -> String -> Either String a

45
src/Render.hs
View file

@ -117,30 +117,31 @@ padZero n = if n < 10 then "0" ++ show n else show n
renderCalendarEvent :: Lang -> Event -> Html () renderCalendarEvent :: Lang -> Event -> Html ()
renderCalendarEvent lang e = do renderCalendarEvent lang e = do
let uid = euid e -- let uid = euid e
li_ [class_ "event-item"] $ do li_ [class_ "event-item"] $ do
-- (toHtml $ summary e) -- (toHtml $ summary e)
a_ [href_ ("#" <> uid), class_ "event-link"] $ toHtml (summary e) a_ [href_ $ url e, class_ "event-link"] $ toHtml (summary e)
div_ [class_ "event-popup", id_ uid] $ do -- a_ [href_ ("#" <> uid), class_ "event-link"] $ toHtml (summary e)
h1_ [] $ do -- div_ [class_ "event-popup", id_ uid] $ do
(toHtml $ summary e) -- h1_ [] $ do
a_ -- (toHtml $ summary e)
[ href_ ("#None"), -- a_
class_ "close-btn" -- [ href_ ("#None"),
] -- class_ "close-btn"
"×" -- ]
p_ [class_ "lead"] $ -- "×"
toHtml $ -- p_ [class_ "lead"] $
T.pack $ -- toHtml $
printf -- T.pack $
"%s -> %s - %s" -- printf
(formatTime (getLocale lang) "%A %d.%m.%y" $ dtStart e) -- "%s -> %s - %s"
(formatTime defaultTimeLocale "%H:%M" $ dtStart e) -- (formatTime (getLocale lang) "%A %d.%m.%y" $ dtStart e)
(formatTime defaultTimeLocale "%H:%M" $ dtEnd e) -- (formatTime defaultTimeLocale "%H:%M" $ dtStart e)
-- (formatTime defaultTimeLocale "%H:%M" $ dtEnd e)
p_ [] $ --
toHtml $ -- p_ [] $
description e -- toHtml $
-- description e
renderMonthview :: Lang -> (Year, MonthOfYear) -> Day -> [(Day, [Event])] -> Html () renderMonthview :: Lang -> (Year, MonthOfYear) -> Day -> [(Day, [Event])] -> Html ()
renderMonthview lang (year, month) today groupedEvents = do renderMonthview lang (year, month) today groupedEvents = do