You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
|
|
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
module Commands.EDT ( getEdt ) where
import Conf ( Config(..) , Group(..) ) import Control.Monad.IO.Class ( MonadIO , liftIO ) import qualified Data.Array as Ar import qualified Data.CaseInsensitive as CI import Data.List ( sortOn ) import qualified Data.Map.Strict as Map import Data.Maybe ( fromMaybe ) import qualified Data.Text as TS import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Encoding as TE import qualified Data.Time as DT import qualified Data.Time.Calendar.Easter as DT import qualified Network.HTTP.Simple as HTTP import qualified Text.ICalendar.Parser as IP import qualified Text.ICalendar.Types as IT import Text.Printf ( printf ) import qualified Text.Regex.PCRE as Re import qualified Text.URI as Uri
getEdt :: Config -> Map.Map TS.Text TS.Text -> IO TS.Text getEdt conf@Config {..} opts = do cal_req <- HTTP.httpLBS req let cal = IP.parseICalendar (IP.DecodingFunctions TE.decodeUtf8 (CI.mk . TE.decodeUtf8)) (TS.unpack group) (HTTP.getResponseBody cal_req) dates <- readDate date tz <- DT.getTimeZone $ DT.UTCTime (head dates) $ DT.secondsToDiffTime 43200 let message = case cal of Left _ -> "I don't know this group, alternatively ADE doesn't work" Right (vcal@IT.VCalendar { IT.vcEvents = evm } : _, _) -> TS.unlines . map (\d -> if not (null (ev d)) then "**" `TS.append` TS.pack (show d) `TS.append` "**\n" `TS.append` renderEvents tz (ev d) else "No classes for the selected dates" ) $ dates where ev :: DT.Day -> [IT.VEvent] ev d = sortOn IT.veDTStart . filter (inDate d) . map snd . Map.toList $ evm _ -> "An unexpected error has occured" return message where group :: TS.Text group = fromMaybe "" $ Map.lookup "group" opts date :: TS.Text date = fromMaybe "week" $ Map.lookup "day" opts url :: String url = TS.unpack . groupAde . fromMaybe (Group 0 0 dummyAddress) . (`Map.lookup` configGroups) . fromMaybe "" . Map.lookup "group" $ opts req = HTTP.parseRequest_ url
-- not a place where you'll find valid ICS so we know the group must be wrong dummyAddress :: TS.Text dummyAddress = "https://example.com"
readDate :: TS.Text -> IO [DT.Day] readDate dtT = do DT.UTCTime today _ <- DT.getCurrentTime return $ case TS.unpack dtT of "today" -> [today] "tomorrow" -> [DT.addDays 1 today] "week" -> map (`DT.addDays` lastSunday) [1 .. 7] where lastweek :: DT.Day lastweek = DT.addDays (-6) today lastSunday = DT.sundayAfter lastweek [dd, du, '/', md, mu, '/', yk, yh, yd, yu] -> [DT.fromGregorian (read [yk, yh, yd, yu]) (read [md, mu]) (read [dd, du])] _ -> [today]
inDate :: DT.Day -> IT.VEvent -> Bool inDate date ev@IT.VEvent { veDTStart = mdts } = evDay == date where evDay :: DT.Day evDay = case mdts of Just dts -> case dts of IT.DTStartDateTime dt _ -> case dt of IT.FloatingDateTime lt -> DT.localDay lt IT.UTCDateTime ut -> DT.utctDay ut IT.ZonedDateTime lt _ -> DT.localDay lt IT.DTStartDate da _ -> IT.dateValue da Nothing -> DT.fromGregorian 0 0 0
renderEvents :: DT.TimeZone -> [IT.VEvent] -> TS.Text renderEvents tz = TS.unlines . map renderEvent where renderEvent :: IT.VEvent -> TS.Text renderEvent ev = TS.pack $ printf "*%02d:%02d → %02d:%02d* : **%s** with **%s** in **%s**" (DT.todHour $ startT ev) (DT.todMin $ startT ev) (DT.todHour $ endT ev) (DT.todMin $ endT ev) (summary ev) (teacher ev) (room ev)
startT :: IT.VEvent -> DT.TimeOfDay startT IT.VEvent { veDTStart = Just (IT.DTStartDateTime dt _) } = case dt of IT.FloatingDateTime lt -> DT.localTimeOfDay lt IT.UTCDateTime ut -> snd . DT.utcToLocalTimeOfDay tz . DT.timeToTimeOfDay $ DT.utctDayTime ut IT.ZonedDateTime lt _ -> DT.localTimeOfDay lt startT _ = DT.TimeOfDay 0 0 0 endT :: IT.VEvent -> DT.TimeOfDay endT IT.VEvent { veDTEndDuration = Just (Left (IT.DTEndDateTime dt _)) } = case dt of IT.FloatingDateTime lt -> DT.localTimeOfDay lt IT.UTCDateTime ut -> snd . DT.utcToLocalTimeOfDay tz . DT.timeToTimeOfDay $ DT.utctDayTime ut IT.ZonedDateTime lt txt -> DT.localTimeOfDay lt endT _ = DT.TimeOfDay 0 0 0 summary IT.VEvent { veSummary = Just IT.Summary { summaryValue = x } } = x summary _ = "Unknown" room IT.VEvent { veLocation = Just IT.Location { locationValue = x } } = x room _ = "Unknown" teacher :: IT.VEvent -> String teacher IT.VEvent { veDescription = Just IT.Description { descriptionValue = val } } = if '\n' `elem` teacher' then "Unknown" else teacher' where teacher' = if uncurry (>) (Ar.bounds marray) then "Unknown" else fst . last . Ar.elems $ marray
marray = if null matches then Ar.listArray (1, 0) [] else head matches matches = Re.matchAllText teacherRe $ T.unpack val teacher _ = "Unknown" teacherRe = Re.makeRegexOpts Re.compMultiline Re.execBlank ("^\\n\\n.+\\n(.+)\\n" :: String)
|