never executed always true always false
1 module PureClaw.Tools.Cron
2 ( -- * Tool registration
3 cronTool
4 -- * Scheduler handle
5 , CronHandle (..)
6 , mkCronHandle
7 , mkNoOpCronHandle
8 ) where
9
10 import Control.Exception
11 import Data.Aeson
12 import Data.Aeson.Types
13 import Data.IORef
14 import Data.Text (Text)
15 import Data.Text qualified as T
16
17 import PureClaw.Handles.Channel
18 import PureClaw.Providers.Class
19 import PureClaw.Scheduler.Cron
20 import PureClaw.Tools.Registry
21
22 -- | Handle for managing the cron scheduler. Wraps an IORef-based
23 -- scheduler with operations the agent can call.
24 data CronHandle = CronHandle
25 { _crh_add :: Text -> CronExpr -> IO () -> IO Bool
26 , _crh_remove :: Text -> IO Bool
27 , _crh_list :: IO [(Text, Text)] -- ^ (name, cron expression as text)
28 }
29
30 -- | Create a real cron handle backed by an IORef scheduler.
31 mkCronHandle :: IORef CronScheduler -> CronHandle
32 mkCronHandle ref = CronHandle
33 { _crh_add = \name expr action -> do
34 let job = CronJob { _cj_name = name, _cj_expr = expr, _cj_action = action }
35 atomicModifyIORef' ref $ \sched -> (addJob job sched, ())
36 pure True
37 , _crh_remove = \name ->
38 atomicModifyIORef' ref $ \sched ->
39 let before = length (schedulerJobNames sched)
40 sched' = removeJob name sched
41 after = length (schedulerJobNames sched')
42 in (sched', before /= after)
43 , _crh_list = do
44 sched <- readIORef ref
45 pure [(name, formatCronExpr expr)
46 | (name, expr) <- schedulerJobNames sched]
47 }
48
49 -- | No-op cron handle for testing.
50 mkNoOpCronHandle :: CronHandle
51 mkNoOpCronHandle = CronHandle
52 { _crh_add = \_ _ _ -> pure True
53 , _crh_remove = \_ -> pure True
54 , _crh_list = pure []
55 }
56
57 -- | Create a cron tool for agent-managed scheduled jobs.
58 -- When the agent adds a cron job, the action sends a message to the
59 -- channel with the job name (for cron result delivery).
60 cronTool :: ChannelHandle -> CronHandle -> (ToolDefinition, ToolHandler)
61 cronTool ch crh = (def, handler)
62 where
63 def = ToolDefinition
64 { _td_name = "cron"
65 , _td_description = "Manage scheduled cron jobs. Actions: add (create a job), remove (delete a job), list (show all jobs)."
66 , _td_inputSchema = object
67 [ "type" .= ("object" :: Text)
68 , "properties" .= object
69 [ "action" .= object
70 [ "type" .= ("string" :: Text)
71 , "enum" .= (["add", "remove", "list"] :: [Text])
72 , "description" .= ("The action to perform" :: Text)
73 ]
74 , "name" .= object
75 [ "type" .= ("string" :: Text)
76 , "description" .= ("Job name (for add, remove)" :: Text)
77 ]
78 , "schedule" .= object
79 [ "type" .= ("string" :: Text)
80 , "description" .= ("Cron expression, e.g. '*/5 * * * *' (for add)" :: Text)
81 ]
82 , "message" .= object
83 [ "type" .= ("string" :: Text)
84 , "description" .= ("Message to send when job fires (for add)" :: Text)
85 ]
86 ]
87 , "required" .= (["action"] :: [Text])
88 ]
89 }
90
91 handler = ToolHandler $ \input ->
92 case parseEither parseAction input of
93 Left err -> pure (T.pack err, True)
94 Right action -> dispatch action input
95
96 dispatch :: Text -> Value -> IO (Text, Bool)
97 dispatch "add" input =
98 case parseEither parseAdd input of
99 Left err -> pure (T.pack err, True)
100 Right (name, schedule, message) ->
101 case parseCronExpr schedule of
102 Left err -> pure ("Invalid cron expression: " <> T.pack err, True)
103 Right expr -> do
104 let action = _ch_send ch (OutgoingMessage ("[cron:" <> name <> "] " <> message))
105 result <- try @SomeException (_crh_add crh name expr action)
106 case result of
107 Left e -> pure (T.pack (show e), True)
108 Right True -> pure ("Added cron job: " <> name <> " (" <> schedule <> ")", False)
109 Right False -> pure ("Failed to add job: " <> name, True)
110 dispatch "remove" input =
111 case parseEither parseName input of
112 Left err -> pure (T.pack err, True)
113 Right name -> do
114 result <- _crh_remove crh name
115 if result
116 then pure ("Removed cron job: " <> name, False)
117 else pure ("Job not found: " <> name, True)
118 dispatch "list" _ = do
119 jobs <- _crh_list crh
120 if null jobs
121 then pure ("No cron jobs scheduled", False)
122 else pure (T.intercalate "\n" [name <> " — " <> expr | (name, expr) <- jobs], False)
123 dispatch action _ = pure ("Unknown action: " <> action, True)
124
125 parseAction :: Value -> Parser Text
126 parseAction = withObject "CronInput" $ \o -> o .: "action"
127
128 parseAdd :: Value -> Parser (Text, Text, Text)
129 parseAdd = withObject "CronAddInput" $ \o ->
130 (,,) <$> o .: "name" <*> o .: "schedule" <*> o .: "message"
131
132 parseName :: Value -> Parser Text
133 parseName = withObject "CronNameInput" $ \o -> o .: "name"
134
135 -- | Format a CronExpr back to its text representation.
136 formatCronExpr :: CronExpr -> Text
137 formatCronExpr expr = T.intercalate " "
138 [ formatField (_ce_minute expr)
139 , formatField (_ce_hour expr)
140 , formatField (_ce_dayOfMonth expr)
141 , formatField (_ce_month expr)
142 , formatField (_ce_dayOfWeek expr)
143 ]
144
145 -- | Format a CronField to text.
146 formatField :: CronField -> Text
147 formatField Wildcard = "*"
148 formatField (Exact n) = T.pack (show n)
149 formatField (Range lo hi) = T.pack (show lo) <> "-" <> T.pack (show hi)
150 formatField (Step base n) = formatField base <> "/" <> T.pack (show n)
151 formatField (ListField fs) = T.intercalate "," (map formatField fs)