path: root/Omni/Agent/Tools/Calendar.hs

{-# 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 .:? "range" .!= "today 7d"))
        <*> (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 .: "calendar"))
        <*> (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 </ (v .: "query")