meet-rooms application

meet.cabal

@@ -49,3 +49,17 @@ executable meet
         time,
         text,
         optparse-applicative
+
+executable meet-rooms
+    main-is:            Main.hs
+    hs-source-dirs:     rooms
+    other-modules:      Args
+    default-language:   Haskell2010
+    default-extensions: OverloadedStrings ScopedTypeVariables
+    ghc-options:        -Wall
+    build-depends:
+        base ^>=4.17 || ^>=4.18 || ^>=4.19,
+        meet,
+        time,
+        text,
+        optparse-applicative

rooms/Args.hs

@@ -0,0 +1,55 @@
+module Args (Args (..), getArgs) where
+
+import Data.Time.Calendar (Day)
+import Entities (Days (..))
+import Options.Applicative
+import Text.Read (readMaybe)
+
+data Args = Args
+  { argsStartDate :: Maybe Day,
+    argsTimespan :: Days,
+    argsCapacity :: Int
+  }
+  deriving (Eq, Show)
+
+parseArgs :: Parser Args
+parseArgs =
+  Args
+    <$> optional
+      ( option
+          readDate
+          ( long "startDate"
+              <> short 's'
+              <> metavar "YYYY-MM-DD"
+              <> help "First day to start searching for a meeting room on."
+          )
+      )
+    <*> option
+      (Days <$> auto)
+      ( long "timespan"
+          <> short 't'
+          <> metavar "DAYS"
+          <> help "Number of days to look ahead when searching for meeting slots. Defaults to 1, i.e., search only on the start date."
+          <> value (Days 1)
+      )
+    <*> option
+      auto
+      ( long "capacity"
+          <> short 'c'
+          <> metavar "PEOPLE"
+          <> help "Minimum capacity needed for the meeting room. Defaults to 0."
+          <> value 0
+      )
+
+readDate :: ReadM Day
+readDate = do
+  s <- str
+  case readMaybe s of
+    Just d -> pure d
+    Nothing -> error "Date must be specified in YYYY-MM-DD format"
+
+opts :: ParserInfo Args
+opts = info (parseArgs <**> helper) (fullDesc <> progDesc "Find a meeting room" <> header "meet-rooms - find a meeting room for a pre-existing meeting")
+
+getArgs :: IO Args
+getArgs = execParser opts

rooms/Main.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Main where
+
+import Args (Args (..), getArgs)
+import Azure (fetchSchedules, getToken)
+import Control.Monad (when)
+import qualified Data.Text.IO as T
+import Data.Time.Calendar (addDays)
+import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..), getCurrentTimeZone, localTimeToUTC)
+import Entities (Days (..), Minutes (..), Room (..), schedule, allRooms)
+import Meetings (getRoomMeetings)
+import Print (prettyPrint)
+import System.Exit (exitSuccess)
+import Utils
+
+main :: IO ()
+main = do
+  args <- getArgs
+  let searchStartDate = argsStartDate args
+      searchSpanDays = argsTimespan args
+      minCapacity = argsCapacity args
+
+  startDate' <- case searchStartDate of
+    Just d -> pure d
+    Nothing -> localDay <$> getCurrentLocalTime
+
+  localTz <- getCurrentTimeZone
+  let startTime' = localTimeToUTC localTz $ LocalTime startDate' (TimeOfDay 8 30 0)
+  let endDate' = addDays (fromIntegral $ unDays searchSpanDays - 1) startDate'
+      endTime' = localTimeToUTC localTz $ LocalTime endDate' (TimeOfDay 17 30 0)
+
+  let okRooms = filter ((>= minCapacity) . capacity) allRooms
+  when (null okRooms) $ do
+    T.putStrLn "No rooms that meet your criteria were available. :("
+    T.putStrLn "Perhaps try reducing the number of people who need to be in-person?"
+    exitSuccess
+
+  token <- getToken
+  (_, roomSchs) <- fetchSchedules token [] okRooms startTime' endTime' (Minutes 30)
+  let totalChunks = case roomSchs of
+        [] -> 0
+        s : _ -> length (schedule s)
+  let goodMeetings = getRoomMeetings roomSchs minCapacity totalChunks startTime' (Minutes 30) localTz
+
+  case goodMeetings of
+    [] -> T.putStrLn "No meetings were available. :("
+    _ -> prettyPrint goodMeetings

src/Meetings.hs

@@ -1,4 +1,4 @@
-module Meetings (Meeting (..), chooseBestMeeting, getMeetings) where
+module Meetings (Meeting (..), chooseBestMeeting, getMeetings, getRoomMeetings) where
 
 import Entities (Minutes (..))
 import Data.Foldable1 (maximumBy)
@@ -147,3 +147,10 @@ getMeetings personSchedules roomSchedules inPerson nChunks startTime' intervalMi
       relativeMeetingsWithRooms = map (addRoomsToMeeting roomSchedules) relativeMeetings
       meetings = map (absolutiseMeetings startTime' intervalMinutes localTz) relativeMeetingsWithRooms
    in filter (isMeetingGood inPerson) meetings
+
+getRoomMeetings :: [Schedule Room] -> Int -> Int -> UTCTime -> Minutes -> TimeZone -> [Meeting]
+getRoomMeetings roomSchedules inPerson totalChunks startTime' intervalMinutes localTz =
+  let relativeMeetings = map (makeRelativeMeeting 1 []) [0 .. totalChunks - 1]
+      relativeMeetingsWithRooms = map (addRoomsToMeeting roomSchedules) relativeMeetings
+      meetings = map (absolutiseMeetings startTime' intervalMinutes localTz) relativeMeetingsWithRooms
+   in filter (isMeetingGood inPerson) meetings