{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NoImplicitPrelude #-} -- | Calendar tool using khal CLI. -- -- Provides calendar access for agents via local khal/CalDAV. -- -- : out omni-agent-tools-calendar -- : dep aeson -- : dep process module Omni.Agent.Tools.Calendar ( -- * Tools calendarListTool, calendarAddTool, calendarSearchTool, -- * Direct API listEvents, addEvent, searchEvents, listCalendars, -- * Testing main, test, ) where import Alpha import Data.Aeson ((.!=), (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson import qualified Data.Text as Text import qualified Omni.Agent.Engine as Engine import qualified Omni.Test as Test import System.Process (readProcessWithExitCode) main :: IO () main = Test.run test test :: Test.Tree test = Test.group "Omni.Agent.Tools.Calendar" [ Test.unit "calendarListTool has correct schema" <| do let tool = calendarListTool Engine.toolName tool Test.@=? "calendar_list", Test.unit "calendarAddTool has correct schema" <| do let tool = calendarAddTool Engine.toolName tool Test.@=? "calendar_add", Test.unit "calendarSearchTool has correct schema" <| do let tool = calendarSearchTool Engine.toolName tool Test.@=? "calendar_search", Test.unit "listCalendars returns calendars" <| do result <- listCalendars case result of Left _ -> pure () Right cals -> (not (null cals) || null cals) Test.@=? True ] defaultCalendars :: [String] defaultCalendars = ["BenSimaShared", "Kate"] listEvents :: Text -> Maybe Text -> IO (Either Text Text) listEvents range maybeCalendar = do let rangeArg = if Text.null range then "today 7d" else Text.unpack range calArgs = case maybeCalendar of Just cal -> ["-a", Text.unpack cal] Nothing -> concatMap (\c -> ["-a", c]) defaultCalendars formatArg = ["-f", "[{calendar}] {title} | {start-time} - {end-time}"] result <- try <| readProcessWithExitCode "khal" (["list"] <> calArgs <> formatArg <> [rangeArg, "-o"]) "" case result of Left (e :: SomeException) -> pure (Left ("khal error: " <> tshow e)) Right (exitCode, stdoutStr, stderrStr) -> case exitCode of ExitSuccess -> pure (Right (Text.pack stdoutStr)) ExitFailure code -> pure (Left ("khal failed (" <> tshow code <> "): " <> Text.pack stderrStr)) addEvent :: Text -> Text -> Maybe Text -> Maybe Text -> Maybe Text -> IO (Either Text Text) addEvent calendarName eventSpec location alarm description = do let baseArgs = ["new", "-a", Text.unpack calendarName] locArgs = maybe [] (\l -> ["-l", Text.unpack l]) location alarmArgs = maybe [] (\a -> ["-m", Text.unpack a]) alarm specParts = Text.unpack eventSpec descParts = maybe [] (\d -> ["::", Text.unpack d]) description allArgs = baseArgs <> locArgs <> alarmArgs <> [specParts] <> descParts result <- try <| readProcessWithExitCode "khal" allArgs "" case result of Left (e :: SomeException) -> pure (Left ("khal error: " <> tshow e)) Right (exitCode, stdoutStr, stderrStr) -> case exitCode of ExitSuccess -> pure (Right ("Event created: " <> Text.pack stdoutStr)) ExitFailure code -> pure (Left ("khal failed (" <> tshow code <> "): " <> Text.pack stderrStr)) searchEvents :: Text -> IO (Either Text Text) searchEvents query = do let calArgs = concatMap (\c -> ["-a", c]) defaultCalendars result <- try <| readProcessWithExitCode "khal" (["search"] <> calArgs <> [Text.unpack query]) "" case result of Left (e :: SomeException) -> pure (Left ("khal error: " <> tshow e)) Right (exitCode, stdoutStr, stderrStr) -> case exitCode of ExitSuccess -> pure (Right (Text.pack stdoutStr)) ExitFailure code -> pure (Left ("khal failed (" <> tshow code <> "): " <> Text.pack stderrStr)) listCalendars :: IO (Either Text [Text]) listCalendars = do result <- try <| readProcessWithExitCode "khal" ["printcalendars"] "" case result of Left (e :: SomeException) -> pure (Left ("khal error: " <> tshow e)) Right (exitCode, stdoutStr, stderrStr) -> case exitCode of ExitSuccess -> pure (Right (filter (not <. Text.null) (Text.lines (Text.pack stdoutStr)))) ExitFailure code -> pure (Left ("khal failed (" <> tshow code <> "): " <> Text.pack stderrStr)) calendarListTool :: Engine.Tool calendarListTool = Engine.Tool { Engine.toolName = "calendar_list", Engine.toolDescription = "List upcoming calendar events. Use to check what's scheduled. " <> "Range can be like 'today', 'tomorrow', 'today 7d', 'next week', etc. " <> "Available calendars: BenSimaShared, Kate.", Engine.toolJsonSchema = Aeson.object [ "type" .= ("object" :: Text), "properties" .= Aeson.object [ "range" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Time range like 'today 7d', 'tomorrow', 'next week' (default: today 7d)" :: Text) ], "calendar" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Filter to specific calendar: 'BenSimaShared' or 'Kate' (default: both)" :: Text) ] ], "required" .= ([] :: [Text]) ], Engine.toolExecute = executeCalendarList } executeCalendarList :: Aeson.Value -> IO Aeson.Value executeCalendarList v = case Aeson.fromJSON v of Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e]) Aeson.Success (args :: CalendarListArgs) -> do result <- listEvents (clRange args) (clCalendar args) case result of Left err -> pure (Aeson.object ["error" .= err]) Right events -> pure ( Aeson.object [ "success" .= True, "events" .= events ] ) data CalendarListArgs = CalendarListArgs { clRange :: Text, clCalendar :: Maybe Text } deriving (Generic) instance Aeson.FromJSON CalendarListArgs where parseJSON = Aeson.withObject "CalendarListArgs" <| \v -> (CalendarListArgs (v .:? "calendar") calendarAddTool :: Engine.Tool calendarAddTool = Engine.Tool { Engine.toolName = "calendar_add", Engine.toolDescription = "Add a new calendar event. The event_spec format is: " <> "'START [END] SUMMARY' where START/END are dates or times. " <> "Examples: '2024-12-25 Christmas', 'tomorrow 10:00 11:00 Meeting', " <> "'friday 14:00 1h Doctor appointment'.", Engine.toolJsonSchema = Aeson.object [ "type" .= ("object" :: Text), "properties" .= Aeson.object [ "calendar" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Calendar name to add to (e.g., 'BenSimaShared', 'Kate')" :: Text) ], "event_spec" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Event specification: 'START [END] SUMMARY' (e.g., 'tomorrow 10:00 11:00 Team meeting')" :: Text) ], "location" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Location of the event (optional)" :: Text) ], "alarm" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Alarm time before event, e.g., '15m', '1h', '1d' (optional)" :: Text) ], "description" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Detailed description of the event (optional)" :: Text) ] ], "required" .= (["calendar", "event_spec"] :: [Text]) ], Engine.toolExecute = executeCalendarAdd } executeCalendarAdd :: Aeson.Value -> IO Aeson.Value executeCalendarAdd v = case Aeson.fromJSON v of Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e]) Aeson.Success (args :: CalendarAddArgs) -> do result <- addEvent (caCalendar args) (caEventSpec args) (caLocation args) (caAlarm args) (caDescription args) case result of Left err -> pure (Aeson.object ["error" .= err]) Right msg -> pure ( Aeson.object [ "success" .= True, "message" .= msg ] ) data CalendarAddArgs = CalendarAddArgs { caCalendar :: Text, caEventSpec :: Text, caLocation :: Maybe Text, caAlarm :: Maybe Text, caDescription :: Maybe Text } deriving (Generic) instance Aeson.FromJSON CalendarAddArgs where parseJSON = Aeson.withObject "CalendarAddArgs" <| \v -> (CalendarAddArgs (v .: "event_spec") <*> (v .:? "location") <*> (v .:? "alarm") <*> (v .:? "description") calendarSearchTool :: Engine.Tool calendarSearchTool = Engine.Tool { Engine.toolName = "calendar_search", Engine.toolDescription = "Search for calendar events by text. Finds events matching the query " <> "in title, description, or location.", Engine.toolJsonSchema = Aeson.object [ "type" .= ("object" :: Text), "properties" .= Aeson.object [ "query" .= Aeson.object [ "type" .= ("string" :: Text), "description" .= ("Search text to find in events" :: Text) ] ], "required" .= (["query"] :: [Text]) ], Engine.toolExecute = executeCalendarSearch } executeCalendarSearch :: Aeson.Value -> IO Aeson.Value executeCalendarSearch v = case Aeson.fromJSON v of Aeson.Error e -> pure (Aeson.object ["error" .= Text.pack e]) Aeson.Success (args :: CalendarSearchArgs) -> do result <- searchEvents (csQuery args) case result of Left err -> pure (Aeson.object ["error" .= err]) Right events -> pure ( Aeson.object [ "success" .= True, "results" .= events ] ) newtype CalendarSearchArgs = CalendarSearchArgs { csQuery :: Text } deriving (Generic) instance Aeson.FromJSON CalendarSearchArgs where parseJSON = Aeson.withObject "CalendarSearchArgs" <| \v -> CalendarSearchArgs