cleanup main
This commit is contained in:
parent
6667a969b7
commit
acebe8903a
2 changed files with 30 additions and 56 deletions
85
app/Main.hs
85
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.Time (MonthOfYear, Year, fromGregorian, toGregorian)
|
||||
import Data.Text.Lazy qualified as TL
|
||||
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
|
||||
status status400
|
||||
text "Invalid date"
|
||||
else do
|
||||
linesArray <- liftIO $ getFromUrl "https://cdav.chipburners.club/public/main/"
|
||||
timeNow <- liftIO $ getCurrentTime
|
||||
tmz <- liftIO $ getCurrentTimeZone
|
||||
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
|
||||
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
|
||||
errors = lefts events
|
||||
when (not $ null errors) $ do
|
||||
liftIO $ print errors
|
||||
|
||||
html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
|
||||
|
||||
|
||||
-- get "/greet/:name" $ do
|
||||
-- name <- param "name"
|
||||
-- "Hello, " <> name <> "! Hope you're enjoying Haskell."
|
||||
html $ renderText $ renderMonthview (year, month) dayToday groupedEvents
|
||||
)
|
||||
|
||||
-- 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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue