Browse Source

some fixes

master
Annwan 3 years ago
parent
commit
6640ecc4e8
  1. 49
      app/Commands/EDT.hs
  2. 16
      app/Commands/Reminds.hs
  3. 16
      app/Main.hs
  4. 2
      stack.yaml

49
app/Commands/EDT.hs

@ -39,25 +39,36 @@ getEdt conf@Config {..} opts = do
(HTTP.getResponseBody cal_req) (HTTP.getResponseBody cal_req)
dates <- readDate date dates <- readDate date
tz <- DT.getTimeZone $ DT.UTCTime (head dates) $ DT.secondsToDiffTime 43200 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"
let
message =
case
(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 ""
)
$ 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"
)
of
"" -> "No classes for the selected period"
s -> s
return message return message
where where
group :: TS.Text group :: TS.Text

16
app/Commands/Reminds.hs

@ -53,14 +53,14 @@ scheduleRemind :: E.EventSystem -> Remind -> DiscordHandler ()
scheduleRemind ev Remind {..} = do scheduleRemind ev Remind {..} = do
void $ withRunInIO $ \runInIo -> void $ withRunInIO $ \runInIo ->
E.addEvent ev rmdDatetime E.addEvent ev rmdDatetime
$ void
$ runInIo
$ restCall
$ CreateMessage rmdChannel
$ "<@"
`T.append` T.pack (show rmdUser)
`T.append` "> **Reminder**\n"
`T.append` rmdMessage
$ void
$ runInIo
$ restCall
$ CreateMessage rmdChannel
$ "<@"
<> T.pack (show rmdUser)
<> "> **Reminder**\n"
<> rmdMessage
registerRemind :: Remind -> IO () registerRemind :: Remind -> IO ()
registerRemind Remind {..} = do registerRemind Remind {..} = do

16
app/Main.hs

@ -168,14 +168,14 @@ pushgroupedt conf@Config {..} day glist = do
(\(gn, Group { groupChannel = gc }) -> do (\(gn, Group { groupChannel = gc }) -> do
edt <- liftIO $ getEdt conf $ Map.fromList [("group", gn), ("day", day)] edt <- liftIO $ getEdt conf $ Map.fromList [("group", gn), ("day", day)]
liftIO liftIO
$ TIO.putStrLn
$ "Putting out time table for group "
`T.append` gn
`T.append` " in "
`T.append` T.pack (show gc)
`T.append` ":\n"
`T.append` edt
restCall $ R.CreateMessage gc (edt `T.append` "\nAutomatic time table")
$ TIO.putStrLn
$ "Putting out time table for group "
<> gn
<> " in "
<> T.pack (show gc)
<> ":\n"
<> edt
restCall $ R.CreateMessage gc edt
return () return ()
) )
glist glist

2
stack.yaml

@ -7,7 +7,7 @@ extra-deps:
- emoji-0.1.0.2 - emoji-0.1.0.2
- iCalendar-0.4.0.5 - iCalendar-0.4.0.5
- mime-0.4.0.2 - mime-0.4.0.2
- discord-haskell-1.12.1
- discord-haskell-1.12.5
- control-event-1.3 - control-event-1.3
- HDBC-sqlite3-2.3.3.1 - HDBC-sqlite3-2.3.3.1
## My fork of discord-haskell to PR bug fixes and have them before merge ## My fork of discord-haskell to PR bug fixes and have them before merge

Loading…
Cancel
Save