Merge pull request #20 from alan-turing-institute/version

Add --version and --color options

Author: penelopeysm

app/Args.hs

@@ -1,10 +1,14 @@
 module Args (Args (..), getArgs) where
 
+import Data.List.NonEmpty (NonEmpty)
 import qualified Data.Text as T
 import Data.Time.Calendar (Day)
-import Entities (Days (..), Minutes (..), Person (..))
+import Data.Version (showVersion)
+import Data.Word (Word8)
+import Meet.Args (colorFlag, localSwitch, startDateFlag)
+import Meet.Entities (Days (..), Minutes (..), Person (..))
 import Options.Applicative
-import Text.Read (readMaybe)
+import Paths_meet (version)
 
 data Args = Args
   { argsEmails :: [Person],
@@ -14,7 +18,8 @@ data Args = Args
     argsTimespan :: Days,
     argsInPerson :: Int,
     argsFeelingLucky :: Bool,
-    argsShowLocalTime :: Bool
+    argsShowLocalTime :: Bool,
+    argsColors :: Maybe (NonEmpty Word8)
   }
   deriving (Eq, Show)
 
@@ -38,15 +43,7 @@ parseArgs =
           <> help "Duration of the meeting. Defaults to 60 minutes."
           <> value (Minutes 60)
       )
-    <*> optional
-      ( option
-          readDate
-          ( long "startDate"
-              <> short 's'
-              <> metavar "YYYY-MM-DD"
-              <> help "First day to start searching for a meeting on."
-          )
-      )
+    <*> startDateFlag
     <*> option
       (Days <$> auto)
       ( long "timespan"
@@ -68,17 +65,8 @@ parseArgs =
           <> short 'l'
           <> help "Make the app suggest a single best meeting time (and room if needed)."
       )
-    <*> switch
-      ( long "local"
-          <> help "Display meeting times in your local timezone. By default, times are shown in London time."
-      )
-
-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"
+    <*> localSwitch
+    <*> colorFlag
 
 readPerson :: ReadM Person
 readPerson = do
@@ -90,7 +78,10 @@ readPerson = do
         else val <> "@turing.ac.uk"
 
 opts :: ParserInfo Args
-opts = info (parseArgs <**> helper) (fullDesc <> progDesc "Schedule a meeting with the given emails." <> header "meet - a tool to schedule a meeting")
+opts =
+  info
+    (parseArgs <**> helper <**> simpleVersioner ("meet version " ++ showVersion version))
+    (fullDesc <> progDesc "Schedule a meeting with the given emails." <> header ("meet - a tool to schedule a meeting"))
 
 getArgs :: IO Args
 getArgs = execParser opts

app/Main.hs

@@ -3,7 +3,6 @@
 module Main where
 
 import Args (Args (..), getArgs)
-import Azure (fetchSchedules, getToken)
 import Control.Monad (when)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
@@ -16,11 +15,12 @@ import Data.Time.LocalTime
     localTimeToUTC,
     timeZoneOffsetString,
   )
-import Entities (Days (..), Room (..), allRooms)
-import Meetings (chooseBestMeeting, getMeetings)
-import Print (infoPrint, prettyPrint)
+import Meet.Azure (fetchSchedules, getToken)
+import Meet.Entities (Days (..), Room (..), allRooms)
+import Meet.Meetings (chooseBestMeeting, getMeetings)
+import Meet.Print (infoPrint, prettyPrint)
+import Meet.Utils
 import System.Exit (exitSuccess)
-import Utils
 
 main :: IO ()
 main = do
@@ -31,7 +31,6 @@ main = do
       searchStartDate = argsStartDate args
       searchSpanDays = argsTimespan args
       inPerson = argsInPerson args
-      showInLocalTime = argsShowLocalTime args
   nChunks <- gracefulDivide durationMinutes intervalMinutes
 
   -- Default start date is today but in London
@@ -56,13 +55,13 @@ main = do
   let goodMeetings = getMeetings personSchs roomSchs inPerson nChunks startTime' intervalMinutes londonTz
 
   -- Display times in London unless otherwise specified
-  displayTz <- if showInLocalTime then getCurrentTimeZone else pure londonTz
+  displayTz <- if argsShowLocalTime args then getCurrentTimeZone else pure londonTz
   let displayTzText = T.pack $ "UTC" <> timeZoneOffsetString displayTz
 
   case NE.nonEmpty goodMeetings of
     Nothing -> T.putStrLn "No meetings were available. :("
     Just ms -> do
       if argsFeelingLucky args
         then infoPrint displayTz (chooseBestMeeting ms) inPerson
-        else prettyPrint displayTz goodMeetings
+        else prettyPrint (argsColors args) displayTz goodMeetings
       T.putStrLn $ "All times are in " <> displayTzText <> "."

meet.cabal

@@ -1,6 +1,6 @@
 cabal-version:     3.0
 name:              meet
-version:           0.2.0.3
+version:           0.2.0.4
 license:           MIT
 license-file:      LICENSE
 maintainer:        [email protected]
@@ -17,11 +17,12 @@ extra-doc-files: CHANGELOG.md
 
 library
     exposed-modules:
-        Azure
-        Entities
-        Meetings
-        Print
-        Utils
+        Meet.Args
+        Meet.Azure
+        Meet.Entities
+        Meet.Meetings
+        Meet.Print
+        Meet.Utils
 
     hs-source-dirs:     src
     default-language:   Haskell2010
@@ -45,11 +46,12 @@ library
         unix >= 2.8.4 && < 2.9,
         bytestring >= 0.12.1.0 && < 0.13,
         binary >= 0.8.9.1 && < 0.9,
+        optparse-applicative >= 0.18.1 && < 0.19,
 
 executable meet
     main-is:            Main.hs
     hs-source-dirs:     app
-    other-modules:      Args
+    other-modules:      Args, Paths_meet
     default-language:   Haskell2010
     default-extensions: OverloadedStrings ScopedTypeVariables
     ghc-options:        -Wall
@@ -63,7 +65,7 @@ executable meet
 executable meet-rooms
     main-is:            Main.hs
     hs-source-dirs:     rooms
-    other-modules:      Args
+    other-modules:      Args, Paths_meet
     default-language:   Haskell2010
     default-extensions: OverloadedStrings ScopedTypeVariables
     ghc-options:        -Wall

rooms/Args.hs

@@ -1,30 +1,27 @@
 module Args (Args (..), getArgs) where
 
+import Data.List.NonEmpty (NonEmpty)
 import Data.Time.Calendar (Day)
-import Entities (Days (..))
+import Data.Version (showVersion)
+import Data.Word (Word8)
+import Meet.Args (colorFlag, localSwitch, startDateFlag)
+import Meet.Entities (Days (..))
 import Options.Applicative
-import Text.Read (readMaybe)
+import Paths_meet (version)
 
 data Args = Args
   { argsStartDate :: Maybe Day,
     argsTimespan :: Days,
     argsCapacity :: Int,
-    argsShowLocalTime :: Bool
+    argsShowLocalTime :: Bool,
+    argsColors :: Maybe (NonEmpty Word8)
   }
   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."
-          )
-      )
+    <$> startDateFlag
     <*> option
       (Days <$> auto)
       ( long "timespan"
@@ -41,20 +38,14 @@ parseArgs =
           <> help "Minimum capacity needed for the meeting room. Defaults to 0."
           <> value 0
       )
-    <*> switch
-      ( long "local"
-          <> help "Display meeting times in your local timezone. By default, times are shown in London time."
-      )
-
-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"
+    <*> localSwitch
+    <*> colorFlag
 
 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")
+opts =
+  info
+    (parseArgs <**> helper <**> simpleVersioner ("meet-rooms version " ++ showVersion version))
+    (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

@@ -3,17 +3,17 @@
 module Main where
 
 import Args (Args (..), getArgs)
-import Azure (fetchSchedules, getToken)
 import Control.Monad (when)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Time.Calendar (addDays)
 import Data.Time.LocalTime (LocalTime (..), TimeOfDay (..), getCurrentTimeZone, localTimeToUTC, timeZoneOffsetString)
-import Entities (Days (..), Minutes (..), Room (..), allRooms, schedule)
-import Meetings (getRoomMeetings)
-import Print (prettyPrint)
+import Meet.Azure (fetchSchedules, getToken)
+import Meet.Entities (Days (..), Minutes (..), Room (..), allRooms, schedule)
+import Meet.Meetings (getRoomMeetings)
+import Meet.Print (prettyPrint)
+import Meet.Utils
 import System.Exit (exitSuccess)
-import Utils
 
 main :: IO ()
 main = do
@@ -52,7 +52,7 @@ main = do
   let displayTzText = T.pack $ "UTC" <> timeZoneOffsetString displayTz
 
   case goodMeetings of
-    [] -> T.putStrLn "No meetings were available. :("
+    [] -> T.putStrLn "No rooms were available. :("
     _ -> do
-      prettyPrint displayTz goodMeetings
+      prettyPrint (argsColors args) displayTz goodMeetings
       T.putStrLn $ "All times are in " <> displayTzText <> "."

src/Meet/Args.hs

@@ -0,0 +1,55 @@
+-- | Shared argument parsing behaviour
+module Meet.Args (localSwitch, colorFlag, startDateFlag) where
+
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NE
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time.Calendar (Day)
+import Data.Word (Word8)
+import Options.Applicative
+import Text.Read (readMaybe)
+
+localSwitch :: Parser Bool
+localSwitch =
+  switch
+    ( long "local"
+        <> help "Display meeting times in your local timezone. By default, times are shown in London time."
+    )
+
+colorFlag :: Parser (Maybe (NonEmpty Word8))
+colorFlag =
+  option
+    readColors
+    ( long "color"
+        <> short 'c'
+        <> metavar "COLOR"
+        <> help "Colours to be used for output table formatting. Colours here refer to 256-colour terminal colours, and are specified as a comma-separated list of integers between 0 and 255 (inclusive). Pass a value of 'none' to remove colours. Defaults to '35,128', which is green and purple."
+        <> value (Just $ NE.fromList [35, 128])
+    )
+
+startDateFlag :: Parser (Maybe Day)
+startDateFlag =
+  optional
+    ( option
+        readDate
+        ( long "startDate"
+            <> short 's'
+            <> metavar "YYYY-MM-DD"
+            <> help "First day to start searching for a meeting on."
+        )
+    )
+
+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"
+
+readColors :: ReadM (Maybe (NonEmpty Word8))
+readColors = do
+  val <- str
+  pure $ case val of
+    "none" -> Nothing
+    _ -> Just $ NE.fromList $ map (read . T.unpack) $ T.splitOn "," val

src/Azure.hs renamed to src/Meet/Azure.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 
-module Azure
+module Meet.Azure
   ( getToken,
     getAvailabilityText,
     fetchSchedules,
@@ -22,15 +22,15 @@ import qualified Data.Text.IO as T
 import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime)
 import Data.Time.Format.ISO8601 (iso8601Show)
 import qualified Data.Vector as V
-import Entities (Availability (..), HasSchedule, Minutes (..), Person (..), Room (..), Schedule (..))
 import GHC.Generics
+import Meet.Entities (Availability (..), HasSchedule, Minutes (..), Person (..), Room (..), Schedule (..))
+import Meet.Print (prettyThrow)
 import Network.HTTP.Req
-import Print (prettyThrow)
 import System.Directory (XdgDirectory (..), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
 import System.Exit (ExitCode (..))
 import System.FilePath (takeDirectory)
-import System.Process (readProcessWithExitCode, spawnCommand)
 import System.Posix.Files (setFileMode)
+import System.Process (readProcessWithExitCode, spawnCommand)
 
 data Token = Token
   { accessToken :: Text,

src/Entities.hs renamed to src/Meet/Entities.hs

@@ -1,4 +1,4 @@
-module Entities
+module Meet.Entities
   ( Availability (..),
     Schedule (..),
     HasSchedule,

src/Meetings.hs renamed to src/Meet/Meetings.hs

@@ -1,6 +1,5 @@
-module Meetings (Meeting (..), chooseBestMeeting, getMeetings, getRoomMeetings) where
+module Meet.Meetings (Meeting (..), chooseBestMeeting, getMeetings, getRoomMeetings) where
 
-import Entities (Minutes (..))
 import Data.Foldable1 (maximumBy)
 import Data.List (findIndices, transpose)
 import Data.List.NonEmpty (NonEmpty)
@@ -21,7 +20,7 @@ import Data.Time.LocalTime
     zonedTimeToLocalTime,
     zonedTimeToUTC,
   )
-import Entities (Availability (..), Person (..), Room (..), Schedule (..))
+import Meet.Entities (Availability (..), Minutes (..), Person (..), Room (..), Schedule (..))
 
 data RelativeMeeting = RelativeMeeting
   { startIndex :: Int,