cleanup main
This commit is contained in:
parent
6667a969b7
commit
acebe8903a
2 changed files with 30 additions and 56 deletions
81
app/Main.hs
81
app/Main.hs
|
|
@ -1,21 +1,21 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
import Network.HTTP.Types (status400)
|
import Control.Monad (when)
|
||||||
import Data.ByteString.Lazy qualified as BL
|
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 qualified as T
|
||||||
import Data.Text.Encoding qualified as TE
|
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 Data.Time.LocalTime
|
||||||
import Ical
|
import Ical
|
||||||
import Lucid (renderText)
|
import Lucid (renderText)
|
||||||
import Network.HTTP.Simple
|
import Network.HTTP.Simple
|
||||||
|
import Network.HTTP.Types (status400)
|
||||||
import Network.Wai.Middleware.Static
|
import Network.Wai.Middleware.Static
|
||||||
import Render
|
import Render
|
||||||
import Web.Scotty
|
|
||||||
import qualified Data.Text.Lazy as TL
|
|
||||||
import Text.Printf (printf)
|
import Text.Printf (printf)
|
||||||
|
import Web.Scotty
|
||||||
|
|
||||||
getFromUrl :: String -> IO T.Text
|
getFromUrl :: String -> IO T.Text
|
||||||
getFromUrl url = do
|
getFromUrl url = do
|
||||||
|
|
@ -42,8 +42,9 @@ main =
|
||||||
endD = addDays 30 dayToday
|
endD = addDays 30 dayToday
|
||||||
events = readCalendar linesArray
|
events = readCalendar linesArray
|
||||||
validEvents = take 5 $ getEventsFromTo (rights events) dayToday endD
|
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
|
html $ renderText $ renderFrontpage validEvents
|
||||||
get "/monthView/" $ do
|
get "/monthView/" $ do
|
||||||
|
|
@ -60,51 +61,25 @@ main =
|
||||||
month :: MonthOfYear <- pathParam "month"
|
month :: MonthOfYear <- pathParam "month"
|
||||||
|
|
||||||
if (year <= 2000 || year >= 3000 || month < 1 || month > 12)
|
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
|
|
||||||
|
|
|
||||||
|
|
@ -105,7 +105,6 @@ expandEvent e@(Event _ _ _ _ start end rule) maxViewDate =
|
||||||
|
|
||||||
validRuleDates = applyLimit (limit rule) infiniteStream
|
validRuleDates = applyLimit (limit rule) infiniteStream
|
||||||
|
|
||||||
-- TODO: I think its alway sorted so this works
|
|
||||||
visibleDates = takeWhile (<= maxViewDate) validRuleDates
|
visibleDates = takeWhile (<= maxViewDate) validRuleDates
|
||||||
in [ e
|
in [ e
|
||||||
{ dtStart = newStart,
|
{ dtStart = newStart,
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue