commit 6667a969b7792111127747a3bf3640b3249e2fa1 Author: Daniel Kauss Serna Date: Mon Jan 26 13:19:50 2026 +0100 initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..392441a --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +flake.lock +dist-newstyle diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..a3e2a69 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +Copyright (c) 2026, Daniel Kauss + + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..027d06a --- /dev/null +++ b/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 diff --git a/chipburners-club.cabal b/chipburners-club.cabal new file mode 100644 index 0000000..5bee1ef --- /dev/null +++ b/chipburners-club.cabal @@ -0,0 +1,89 @@ +cabal-version: 3.0 +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- Initial package description 'chipburners-club' generated by +-- 'cabal init'. For further documentation, see: +-- http://haskell.org/cabal/users-guide/ +-- +-- The name of the package. +name: chipburners-club + +-- The package version. +-- See the Haskell package versioning policy (PVP) for standards +-- guiding when and how versions should be incremented. +-- https://pvp.haskell.org +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: BSD-3-Clause + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Daniel Kauss Serna + +-- An email address to which users can send suggestions, bug reports, and patches. +maintainer: daniel.kauss.serna@gmail.com + +-- A copyright notice. +-- copyright: +category: Web +build-type: Simple + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +-- extra-doc-files: CHANGELOG.md + +-- Extra source files to be distributed with the package, such as examples, or a tutorial module. +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable chipburners-club + -- Import common warning flags. + import: warnings + ghc-options: -threaded + + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + other-modules: Ical, Render + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + extra-libraries: z zstd + + -- Other library packages from which modules are imported. + build-depends: + base ^>=4.20.2.0, + http-conduit, + text, + bytestring, + containers, + scotty, + wai-middleware-static, + lucid, + http-types, + time + + -- Directories containing source files. + hs-source-dirs: app, src + + -- Base language which the package is written in. + default-language: GHC2024 diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..2029728 --- /dev/null +++ b/flake.nix @@ -0,0 +1,34 @@ +{ + description = "Chipburners home page"; + + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; + flake-utils.url = "github:numtide/flake-utils"; + }; + + outputs = { self, nixpkgs, flake-utils }: + flake-utils.lib.eachDefaultSystem (system: + let + pkgs = import nixpkgs { inherit system; }; + haskellApp = pkgs.haskellPackages.callCabal2nix "chipburners-club" ./. { + inherit (pkgs) zlib zstd; + }; + in + { + packages.default = haskellApp; + + devShells.default = pkgs.mkShell { + buildInputs = with pkgs; [ + ghc + cabal-install + haskell-language-server + zlib + zstd + pkg-config + ]; + shellHook = '' + export LD_LIBRARY_PATH="${pkgs.lib.makeLibraryPath [ pkgs.zlib pkgs.zstd ]}:$LD_LIBRARY_PATH" + ''; + }; + }); +} diff --git a/src/Ical.hs b/src/Ical.hs new file mode 100644 index 0000000..7fa7370 --- /dev/null +++ b/src/Ical.hs @@ -0,0 +1,226 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ical (Event (..), readCalendar, getEventsFromTo, groupEvents) where + +import Data.Function (on) +import Data.List (groupBy, sort, sortBy, sortOn) +import Data.Map qualified as M +import Data.Maybe (fromMaybe) +import Data.Ord (comparing) +import Data.Text qualified as T +import Data.Text.Read qualified as R +import Data.Time (Day, DayOfWeek (Monday), addDays, addGregorianMonthsClip, addGregorianYearsClip, defaultTimeLocale, parseTimeM, weekFirstDay) +import Data.Time.Calendar.WeekDate (toWeekDate) +import Data.Time.LocalTime + +data Limit = Count Int | Until Day | NoLimit + deriving (Show, Eq) + +data Frequency + = Daily + | Weekly {byDays :: [Int]} + | Monthly + | Yearly + | NoFreq + deriving (Show, Eq) + +data RRule = RRule + { freq :: Frequency, + interval :: Int, + limit :: Limit + } + deriving (Show, Eq) + +data Event = Event + { summary :: T.Text, + euid :: T.Text, + description :: T.Text, + location :: T.Text, + dtStart :: LocalTime, + dtEnd :: LocalTime, + rrule :: RRule + } + deriving (Show) + +readCalendar :: T.Text -> [Either String Event] +readCalendar input = + let allBlocks = map T.lines $ T.splitOn "BEGIN:VEVENT" input + eventBlocks = drop 1 allBlocks -- Skip the header before the first VEVENT + in map toEvent eventBlocks + +groupEvents :: [Event] -> [(Day, [Event])] +groupEvents events = + let sorted = sortOn dtStart events + grouped = groupBy ((==) `on` getDay) sorted + in map (\g -> (getDay (head g), g)) grouped + +getDay :: Event -> Day +getDay = localDay . dtStart + +getEventsFromTo :: [Event] -> Day -> Day -> [Event] +getEventsFromTo input startDay endDay = + -- let allEvents = foldl (\x y -> x ++ (expandEvent y endDay)) [] input + -- sorted = sortBy (comparing dtStart) allEvents + -- remove events that are after to avoid expanding, maybe not more efficent + let validEvents = filter ((< endDay) . getDay) input + allEvents = concatMap (\e -> expandEvent e endDay) validEvents + sorted = sortBy (comparing dtStart) allEvents + in filter ((> startDay) . getDay) sorted + +streamDates :: Day -> RRule -> [Day] +streamDates start (RRule freq interval _) = case freq of + NoFreq -> [start] + Daily -> iterate (addDays $ toInteger interval) start + Monthly -> [addGregorianMonthsClip (toInteger $ n * interval) start | n <- [0 ..]] + Yearly -> [addGregorianYearsClip (toInteger $ n * interval) start | n <- [0 ..]] + Weekly days -> + let stepDays = toInteger (7 * interval) + targetOffsets = + if null days + then [dayOfWeekToInt start] + else sort days + + mondayOfStart = weekFirstDay Monday start + + weekMondays = iterate (addDays stepDays) mondayOfStart + in [ d + | monday <- weekMondays, + offset <- targetOffsets, + let d = addDays (toInteger offset) monday, + d >= start + ] + +applyLimit :: Limit -> [Day] -> [Day] +applyLimit lim dates = case lim of + NoLimit -> dates + Until u -> takeWhile (<= u) dates + Count c -> take c dates + +expandEvent :: Event -> Day -> [Event] +expandEvent e@(Event _ _ _ _ start end rule) maxViewDate = + let startDate = localDay start + duration = diffLocalTime end start + + infiniteStream = streamDates startDate rule + + validRuleDates = applyLimit (limit rule) infiniteStream + + -- TODO: I think its alway sorted so this works + visibleDates = takeWhile (<= maxViewDate) validRuleDates + in [ e + { dtStart = newStart, + dtEnd = addLocalTime duration newStart, + rrule = rule {freq = NoFreq} + } + | d <- visibleDates, + let newStart = start {localDay = d} + ] + +dayOfWeekToInt :: Day -> Int +dayOfWeekToInt d = + let (_, _, dInt) = toWeekDate d + in dInt - 1 + +parseDate :: T.Text -> Either String LocalTime +parseDate input = + let str = T.unpack input + fmtDateTime = "%Y%m%dT%H%M%S" + fmtDate = "%Y%m%d" + in case parseTimeM True defaultTimeLocale fmtDateTime str of + Just t -> Right t + Nothing -> case parseTimeM True defaultTimeLocale fmtDate str of + Just t -> Right t + Nothing -> Left $ "Could not parse date: " ++ str + +parseLine :: T.Text -> (T.Text, T.Text) +parseLine line = + let (key, value) = T.breakOn ":" line + in ( T.takeWhile (/= ';') key, + T.drop 1 value + ) + +daynameToInt :: T.Text -> Either String Int +daynameToInt day + | day == "MO" = Right 0 + | day == "TU" = Right 1 + | day == "WE" = Right 2 + | day == "TH" = Right 3 + | day == "FR" = Right 4 + | day == "SA" = Right 5 + | day == "SU" = Right 6 + | otherwise = Left "Invalid week day" + +-- TODO: clean this up +parseRRule :: T.Text -> Either String RRule +parseRRule "" = Right $ RRule NoFreq 0 NoLimit +parseRRule input = do + let params = M.fromList $ map parsePair $ T.splitOn ";" input + + freq <- lookupParam "FREQ" params + + let interval = fromMaybe 1 $ do + val <- M.lookup "INTERVAL" params + case R.decimal val of + Right (n, _) -> Just n + _ -> Nothing + + limit <- case (M.lookup "COUNT" params, M.lookup "UNTIL" params) of + (Just c, _) -> do + (n, _) <- R.decimal c "Invalid COUNT" + pure $ Count n + (_, Just d) -> do + date <- parseDate d <+?> "Invalid UNTIL date: " + pure $ Until $ localDay date + _ -> pure NoLimit + + case freq of + "DAILY" -> Right $ RRule Daily interval limit + "WEEKLY" -> do + days <- parseByDay $ M.lookup "BYDAY" params + Right $ RRule (Weekly days) interval limit + "MONTHLY" -> Right $ RRule Monthly interval limit + "YEARLY" -> Right $ RRule Yearly interval limit + _ -> Left $ "Unknown FREQ: " ++ T.unpack freq + where + parsePair t = let (k, v) = T.breakOn "=" t in (k, T.drop 1 v) + + lookupParam key m = case M.lookup key m of + Just v -> Right v + Nothing -> Left "Missing FREQ in RRULE" + + parseByDay Nothing = Right [] + parseByDay (Just txt) = traverse daynameToInt $ T.splitOn "," txt + +toEvent :: [T.Text] -> Either String Event +toEvent input = do + let params = M.fromList $ map parseLine input + + let require p = maybe (Left $ "Missing property: " ++ T.unpack p) Right $ M.lookup p params + let optional opt p = M.findWithDefault opt p params + + summText <- require "SUMMARY" + uid <- require "UID" + startText <- require "DTSTART" + endText <- require "DTEND" + + let loc = optional "No location" "LOCATION" + let descriptionText = optional "No description" "DESCRIPTION" + let rruleTxt = M.lookup "RRULE" params + + rrule <- case rruleTxt of + Just txt -> parseRRule txt + Nothing -> Right $ RRule NoFreq 0 NoLimit + + startDate <- parseDate startText <+?> "Error reading start Date: " + endDate <- parseDate endText <+?> "Error reading end Date: " + pure $ Event summText uid descriptionText loc startDate endDate rrule + +-- This is very nice, replace Left with a different Left +() :: Either e a -> String -> Either String a +Left _ msg = Left msg +Right x _ = Right x + +-- Append prev Left to the end +(<+?>) :: Either String a -> String -> Either String a +Left x <+?> msg = Left $ msg ++ x +Right x <+?> _ = Right x diff --git a/src/Render.hs b/src/Render.hs new file mode 100644 index 0000000..95f615e --- /dev/null +++ b/src/Render.hs @@ -0,0 +1,224 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Render (renderFrontpage, renderMonthview) where + +import Control.Monad (forM_) +import Data.Maybe (fromMaybe) +import Data.Text qualified as T +import Data.Time (Day, MonthOfYear, Year, addDays, addGregorianMonthsClip, dayOfWeek, defaultTimeLocale, formatTime, fromGregorian, toGregorian) +import Ical +import Lucid +import Text.Printf (printf) + +renderHead :: Html () +renderHead = do + doctype_ + head_ $ do + meta_ [charset_ "UTF-8"] + meta_ + [ name_ "viewport", + content_ "width=device-width, initial-scale=1.0" + ] + meta_ + [ name_ "description", + content_ "Chipburners home page" + ] + title_ "Chipburners" + link_ [rel_ "stylesheet", href_ "/style.css"] + +renderHeader :: Int -> Html () +renderHeader active = + header_ [class_ "site-header"] $ do + nav_ [] $ do + ul_ [class_ "nav-list"] $ do + li_ $ a_ [href_ "/", getActive 0] "Chip" + li_ $ a_ [href_ "/monthView", getActive 1] "Eventos" + li_ $ a_ [href_ "/wiki", getActive 2] "Wiki" + li_ $ a_ [href_ "/contact", getActive 3] "Contacto" + where + getActive cur = if cur == active then class_ "active" else class_ "inactive" + +renderImage :: T.Text -> T.Text -> T.Text -> Html () +renderImage url caption alt = + figure_ $ do + img_ + [ src_ url, + alt_ alt, + loading_ "lazy" + ] + figcaption_ $ toHtml caption + +renderSideEvent :: Event -> Html () +renderSideEvent e = + li_ $ do + span_ [class_ "event-time"] $ + toHtml (formatTime defaultTimeLocale "%H:%M" (dtStart e)) + span_ [class_ "event-title"] $ do + let uid = euid e + a_ [href_ ("/monthView#" <> uid), class_ "event-link"] $ toHtml (summary e) + +renderDayGroup :: (Day, [Event]) -> Html () +renderDayGroup (day, events) = + li_ [class_ "event-group"] $ do + time_ + [ datetime_ $ T.pack (formatTime defaultTimeLocale "%Y-%m-%d" day), + class_ "date-header" + ] + $ toHtml + $ T.pack (formatTime defaultTimeLocale "%A %d.%m.%y" day) + ul_ [class_ "daily-events"] $ + mapM_ renderSideEvent events + +renderEventList :: [Event] -> Html () +-- mapM_ only cares about the monad I think? So it throws away the () part +-- mapM applies the monad to everz element of the list and returns monad with a list? +renderEventList events = mapM_ renderDayGroup (groupEvents events) + +renderFrontpage :: [Event] -> Html () +renderFrontpage events = do + doctype_ + html_ [lang_ "es"] $ do + renderHead + body_ $ do + renderHeader 0 + div_ [class_ "wrapper"] $ do + div_ [class_ "layout"] $ do + main_ [id_ "main-content", class_ "content"] $ do + section_ [class_ "intro"] $ do + h1_ "Chipburners_" + p_ [class_ "lead"] $ + "Frase motivadora aqui" + p_ $ do + "Buenos dias, " + br_ [] + "Somos un grupo d personas y entidades interesados en infromatica y \ + \las technologias relacionadas. " + br_ [] + "Este hackerspace ha sido creado como manera d juntar gente con intereses \ + \similares y compartir conocimientos. " + br_ [] + "Contactanos en " + a_ [href_ "/contact"] "signal" + "!" + + section_ [class_ "image-gallery"] $ do + renderImage "example.com" "Imagen sobre algo" "Imagen interesante" + + aside_ [class_ "sidebar"] $ do + section_ [class_ "events-panel"] $ do + h2_ "Eventos" + renderEventList events + +chunksOf :: Int -> [a] -> [[a]] +chunksOf _ [] = [] +chunksOf n xs = + let (ys, zs) = splitAt n xs + in ys : chunksOf n zs + +padZero :: Int -> String +padZero n = if n < 10 then "0" ++ show n else show n + +renderCalendarEvent :: Event -> Html () +renderCalendarEvent e = do + let uid = euid e + li_ [class_ "event-item"] $ do + -- (toHtml $ summary e) + a_ [href_ ("#" <> uid), class_ "event-link"] $ toHtml (summary e) + div_ [class_ "event-popup", id_ uid] $ do + h1_ [] $ do + (toHtml $ summary e) + a_ + [ href_ ("#None"), + class_ "close-btn" + ] + "×" + p_ [class_ "lead"] $ + toHtml $ + T.pack $ + printf + "%s -> %s - %s" + (formatTime defaultTimeLocale "%A %d.%m.%y" $ dtStart e) + (formatTime defaultTimeLocale "%H:%M" $ dtStart e) + (formatTime defaultTimeLocale "%H:%M" $ dtEnd e) + + p_ [] $ + toHtml $ + description e + +renderMonthview :: (Year, MonthOfYear) -> Day -> [(Day, [Event])] -> Html () +renderMonthview (year, month) today groupedEvents = do + let firstOfMonth = fromGregorian year month 1 + wd = dayOfWeek firstOfMonth + + daysToSubtract = fromEnum wd - 1 + startOfGrid = addDays (fromIntegral (-daysToSubtract)) firstOfMonth + + gridDays = [addDays i startOfGrid | i <- [0 .. 41]] + weeks = chunksOf 7 gridDays + + prevMonthDay = addGregorianMonthsClip (-1) firstOfMonth + nextMonthDay = addGregorianMonthsClip 1 firstOfMonth + (py, pm, _) = toGregorian prevMonthDay + (cy, cm, _) = toGregorian today + (ny, nm, _) = toGregorian nextMonthDay + + mkLink y m label = + a_ + [ href_ $ T.pack $ printf "/monthView/%s/%s" (show y) (padZero m), + class_ "nav-link" + ] + label + + renderHead + renderHeader 1 + div_ [class_ "calendar-wrapper"] $ do + header_ [class_ "calendar-header"] $ do + h1_ [class_ "view-title"] "Vista mensual" + + nav_ [class_ "calendar-nav"] $ do + mkLink py pm "« Mes pasado" + mkLink cy cm "Este mes" + mkLink ny nm "Mes siguiente »" + + h2_ [class_ "month-name"] $ + toHtml $ + formatTime defaultTimeLocale "%B %Y" $ + fromGregorian year month 1 + + table_ [class_ "calendar-table"] $ do + thead_ $ do + tr_ $ do + th_ "Lunes" + th_ "Martes" + th_ "Miercoles" + th_ "Jueves" + th_ "Viernes" + th_ "Sabado" + th_ "Domingo" + + tbody_ $ do + forM_ weeks $ \week -> do + tr_ $ do + forM_ week $ \d -> do + let (_, dM, dD) = toGregorian d + isCurrentMonth = dM == month + isToday = d == today + + baseClasses = [] + monthClass = if isCurrentMonth then [] else ["other-month"] + todayClass = if isToday then ["current-day"] else [] + finalClass = T.intercalate " " (baseClasses ++ monthClass ++ todayClass) + + -- TODO: lookup very slow :( + dayEvents = fromMaybe [] (lookup d groupedEvents) + + -- cool + td_ ([class_ finalClass | not (T.null finalClass)]) $ do + span_ [class_ "day-number"] (toHtml $ show dD) + + if null dayEvents + then return () + else ul_ [class_ "event-list"] $ do + forM_ dayEvents $ \e -> + renderCalendarEvent e diff --git a/static/Geo-Regular.woff2 b/static/Geo-Regular.woff2 new file mode 100644 index 0000000..c9610f9 Binary files /dev/null and b/static/Geo-Regular.woff2 differ diff --git a/static/monthView.html b/static/monthView.html new file mode 100644 index 0000000..f246aa2 --- /dev/null +++ b/static/monthView.html @@ -0,0 +1,157 @@ + + + + + + Month View Calendar Template + + + + +
+
+

Month View

+ + + +

October 2023

+
+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
MonTueWedThuFriSatSun
+ 25 + + 26 + + 27 + + 28 + + 29 + + 30 + + 1 +
    +
  • Rent Due
    • +
+
+ 2 + + 3 +
    +
  • Team Meeting (10am)
    • +
  • Project Deadline
    • +
+ 		+ 4 + + 5 + + 6 +
    +
  • Dentist Appt
    • +
+ 		+ 7 +
    +
  • Grocery shopping
    • +
+ 		+ 8 +
910111213 + 14 +
    +
  • Birthday Party
    • +
+ 		15
1617 + 18 +
    +
  • Server Maintenance
    • +
+ 		19202122
23242526272829
30 + 31 +
    +
  • Halloween Party
    • +
+ 		12345
+
+ + + diff --git a/static/style.css b/static/style.css new file mode 100644 index 0000000..d4bd1fb --- /dev/null +++ b/static/style.css @@ -0,0 +1,469 @@ +/* +:root { + --black-base: #141414; + --black-surface: #1f1f1f; + --black-elevated: #10101a; + --black4: #0f0d0c; + + --accent-red: #e88a80; + --accent-orange: #d3a07a; + --accent-cream: #eed9bf; + + --text-main: #d7d4f5; + --ui-ice: #e3e8f5; + --ui-blue: #afb8e6; + + --grey-muted: #808080; + --grid-color: rgba(207, 216, 230, 0.1); + + --font-main: "Geo", "Courier New", monospace; + --spacing-md: 2rem; + --spacing-sm: 1rem; +} +*/ + +:root { + --black-base: #0d0f12; + --black-surface: #161a1f; + --black-elevated: #21262d; + + --accent-red: #e88a80; + --accent-orange: #d3a07a; + --accent-cream: #eed9bf; + + --text-main: #c9d1d9; + --ui-blue: #8fa1d0; + --ui-ice: #e3e8f5; + + --grey-muted: #6e7681; + --grid-color: rgba(143, 161, 208, 0.08); + --highlight-soft: rgba(240, 240, 255, 0.07); + --highlight-hard: rgba(240, 240, 255, 0.13); + --highlight-red: rgba(232, 138, 128, 0.05); + + --font-main: "Geo", "Courier New", monospace; + --spacing-md: 2rem; + --spacing-sm: 1rem; +} + +@font-face { + font-family: Geo; + src: url("/Geo-Regular.woff2"); + /* url of the font */ +} + +/* idk this is good? */ +*, +*::before, +*::after { + box-sizing: border-box; +} + +body { + background-color: var(--black-base); + /* grid, idk */ + /* background-image: */ + /* linear-gradient(var(--grid-color) 1px, transparent 1px), */ + /* linear-gradient(90deg, var(--grid-color) 1px, transparent 1px); */ + /* background-size: 30px 30px; */ + + color: var(--accent-cream); + font-family: var(--font-main); + font-weight: 400; + font-size: 25px; + line-height: 1.2; + margin: 0; + padding-bottom: 50px; +} + + +img { + max-width: 100%; + height: auto; + display: block; + border: 1px solid var(--grey-muted); +} + +h1, +h2, +h3 { + margin-top: 0; + font-weight: 400; + text-transform: uppercase; + letter-spacing: 1px; +} + +a { + color: var(--ui-ice); + text-decoration: none; + border-bottom: 1px dashed transparent; + transition: color 0.2s, border-color 0.2s; +} + +a:hover, +a:focus { + color: var(--accent-orange); + border-bottom-color: var(--accent-orange); + outline: none; +} + +.site-header { + padding: var(--spacing-sm); + margin-bottom: var(--spacing-md); + background: var(--black-surface); + border-image: linear-gradient(to right, + var(--accent-red), var(--accent-orange), var(--text-main), var(--ui-ice), var(--ui-blue)) 1; + border-bottom: 1px solid var(--grey-muted); +} + +.nav-list { + padding: 0; + margin: 0 auto; + max-width: 600px; + display: flex; + justify-content: center; + gap: 30px; + list-style-type: none; + flex-wrap: wrap; + /* Idk if his is good */ +} + +.nav-list a { + font-size: 1.2rem; + padding: 5px 10px; +} + +/* Maybe change back to single line */ +.nav-list a:hover, +.nav-list a.active { + border-bottom: 2px solid var(--text-main); +} + +.wrapper { + max-width: 1100px; + margin: 0 auto; + padding: 0 var(--spacing-sm); +} + +.layout { + display: flex; + gap: 3rem; + align-items: flex-start; +} + +.content { + /* background-color: var(--black4); */ + flex: 2.5; + min-width: 0; + border-left: 2px solid var(--accent-red); + padding-left: var(--spacing-md); + padding-right: var(--spacing-md); + padding-bottom: var(--spacing-md); +} + +.content h1 { + color: var(--accent-red); + font-size: 2.5rem; + margin-bottom: 0.5rem; +} + +.lead { + font-size: 1.2rem; + color: var(--accent-orange); + margin-bottom: var(--spacing-md); +} + +figure { + margin: 0; + background: var(--black-soft); + padding: 10px; + border: 1px solid var(--grey-muted); +} + +figcaption { + font-size: 0.9rem; + color: var(--grey-muted); + margin-top: 5px; + text-align: right; +} + +.sidebar { + flex: 1; + /* background: var(--black3); */ + border-left: 1px solid var(--ui-blue); + padding: var(--spacing-sm); + /* Idk maybe this is bad*/ + position: sticky; + top: 20px; +} + +.events-panel h2 { + color: var(--ui-blue); + font-size: 1.5rem; + border-bottom: 1px solid var(--ui-blue); + padding-bottom: 10px; + margin-bottom: 15px; +} + +.event-list { + list-style: none; + padding: 0; + margin: 0; +} + +.event-group { + margin-bottom: 20px; +} + +.date-header { + display: block; + color: var(--text-main); + font-weight: bold; + margin-bottom: 8px; + text-transform: uppercase; +} + +.daily-events { + list-style: none; + padding-left: 0; + margin: 0; + border-left: 1px dashed var(--grey-muted); +} + +.daily-events li { + display: flex; + /* justify-content: space-between; */ + padding: 5px 10px; + color: var(--ui-ice); + transition: background-color 0.1s; +} + +.daily-events li:hover { + background-color: var(--highlight-soft); +} + +.event-time { + color: var(--grey-muted); + font-size: 0.9em; +} + +.event-title { + /* text-align: right; */ + text-align: left; + padding-left: 12px; +} + +@media (max-width: 800px) { + .layout { + flex-direction: column; + gap: var(--spacing-md); + } + + .content { + border-left: none; + border-top: 2px solid var(--accent-red); + padding: var(--spacing-sm); + } + + .sidebar { + width: 100%; + position: static; + } + + .site-header { + margin-bottom: 1rem; + } +} + +/* Calendar ,TODO move to another file? */ + +.calendar-wrapper { + max-width: 1200px; + margin: 25px auto; + background: var(--black-surface); + padding: 25px; + border: 1px solid var(--grey-muted); +} + +.calendar-header { + text-align: center; + margin-bottom: 30px; + border-bottom: 2px solid var(--accent-red); + border-image: linear-gradient(to right, var(--accent-red), var(--accent-orange), var(--text-main), var(--ui-ice), var(--ui-blue)) 1; + padding-bottom: 20px; +} + +.view-title { + font-size: 1rem; + color: var(--text-main); + margin: 0 0 5px 0; + text-transform: uppercase; + letter-spacing: 2px; +} + +.month-name { + font-size: 3rem; + margin: 5px 0; + color: var(--accent-red); + text-transform: uppercase; +} + +.calendar-nav { + display: flex; + justify-content: center; + gap: 20px; + margin-bottom: 20px; +} + +.nav-link { + text-decoration: none; + color: var(--ui-ice); + font-weight: 400; + padding: 8px 20px; + border: 1px dashed var(--ui-ice); + transition: all 0.2s ease; + text-transform: uppercase; + font-size: 0.9rem; +} + +.nav-link:hover { + background-color: var(--accent-orange); + color: var(--black-base); + border-style: solid; + border-color: var(--accent-orange); +} + +.calendar-table { + width: 100%; + border-collapse: collapse; + table-layout: fixed; + background-color: var(--black4); +} + +.calendar-table th { + background-color: var(--black-elevated); + color: var(--ui-blue); + padding: 15px; + text-align: center; + border: 1px solid var(--grey-muted); + font-weight: 400; + text-transform: uppercase; + font-size: 0.8rem; +} + +.calendar-table td { + border: 1px solid var(--grid-color); + height: 140px; + vertical-align: top; + padding: 10px; + background-color: transparent; + transition: background-color 0.1s; +} + +.calendar-table td:hover { + background-color: var(--highlight-soft); +} + +.calendar-table td.other-month { + background-color: var(--black-base); + color: var(--grey-muted); +} + +.day-number { + font-weight: 400; + font-size: 1.3rem; + margin-bottom: 10px; + display: block; + color: var(--text-main); +} + +.current-day { + background-color: var(--highlight-red) !important; +} + +.current-day .day-number { + color: var(--accent-red); + text-decoration: underline; + text-underline-offset: 4px; +} + +.event-item { + background-color: var(--black-surface); + color: var(--ui-blue); + padding: 2px 3px; + margin-bottom: 6px; + border: 1px solid var(--ui-blue); + border-left: 2px solid var(--ui-blue); + font-size: 1.3rem; + /*! white-space: nowrap; */ + overflow: hidden; + text-overflow: None; + transition: background-color 0.1s; +} + +.event-item a:hover { + text-decoration: none; +} + +.event-item:hover { + /* kinda cool, maybe later more*/ + /* transform: translateX(3px); */ + /* this breaks the popup :( */ + /* filter: brightness(1.2); */ + background-color: var(--highlight-hard); +} + +.event-popup { + display: block; + opacity: 0; + visibility: hidden; + position: fixed; + top: 10%; + left: 10%; + background: var(--black-base); + width: 80%; + height: 80%; + padding: 20px; + z-index: 1; + border: 3px solid; + border-image: linear-gradient(to right, var(--accent-red), var(--accent-orange), var(--text-main), var(--ui-ice), var(--ui-blue)) 1; + transition: opacity 0.1; +} + +.event-popup h1 { + border-bottom: 1px solid var(--text-main); + display: flex; + justify-content: space-between; +} + +.event-popup:target { + visibility: visible; + opacity: 1; +} + +/* .show .event-popup { */ +/* visibility: visible; */ +/* -webkit-animation: fadeIn 0.1s; */ +/* animation: fadeIn 0.1s */ +/* } */ + +/* Add animation (fade in the popup) */ +@-webkit-keyframes fadeIn { + from { + opacity: 0; + } + + to { + opacity: 1; + } +} + +@keyframes fadeIn { + from { + opacity: 0; + } + + to { + opacity: 1; + } +}