From ba6dc562a6bcacdc2597b4af6294a9096cd1a2bc Mon Sep 17 00:00:00 2001 From: Adrian Sieber Date: Thu, 16 May 2024 15:04:35 +0000 Subject: [PATCH] Hooks: Add support for Lua, add tests, improve docs --- docs-source/cli/hooks.md | 228 ++++++++++++++++++---------------- tasklite-core/source/Cli.hs | 29 ++--- tasklite-core/source/Lib.hs | 78 ++++++++---- tasklite-core/source/Utils.hs | 43 ++++--- tasklite/app/Main.hs | 5 +- tasklite/package.yaml | 3 + tasklite/tasklite.cabal | 4 + tasklite/test/CliSpec.hs | 120 ++++++++++++++++-- tasklite/test/Spec.hs | 6 +- tasklite/test/Utils.hs | 30 +++++ 10 files changed, 371 insertions(+), 175 deletions(-) create mode 100644 tasklite/test/Utils.hs diff --git a/docs-source/cli/hooks.md b/docs-source/cli/hooks.md index 95a4a77..d361985 100644 --- a/docs-source/cli/hooks.md +++ b/docs-source/cli/hooks.md @@ -1,114 +1,110 @@ # Hooks -Hooks can either be specified via the config file -or via hook files. -But make sure that all hook files are executable, -otherwise they won't be picked up by TaskLite. +Hooks are scripts that can be executed +at various stages of TaskLite's execution. --- --- +## Configuration + +Hooks can either be specified via the config file or via hook files. + +If the files have an extension (e.g. `post-add.lua`) the corresponding +interpreter will be used. +Otherwise the file will be executed as a shell script. +Currently supported interpreters are: `lua`, `python3`, `ruby`, `node`. + +If the hook files are shell scripts, they must be executable (`chmod +x`). +Otherwise they can't be executed directly by TaskLite. + +It's recommended to use [Lua](https://www.lua.org/) for hooks +as it's simple, lightweight, and has the best performance. +Futhermore, future versions of TaskLite will include a Lua interpreter +for even better performance. + ## Stages Following stages are available: -- `pre-launch` - After reading all configs, - but before any TaskLite code is executed. - Can be used to prevent execution of TaskLite. -- `post-launch` - After reading CLI arguments, - setting up the database and running all migrations. -- `pre-add` - Right before adding a new task. - Can be used to prevent addition of task. -- `post-add` - After new task was added. -- `pre-modify` - Right before a task gets modified. - Can be used to prevent modification of task. -- `post-modify` - After task was modified. -- `pre-exit` - Pre printing results -- `post-exit` - Last thing before program termination - - - -The hooks receive data from TaskLite via stdin. -Possible fields are: - -```json5 +- Launch + - `pre-launch` - After reading all configs, + but before any TaskLite code is executed. + Can be used to prevent execution of TaskLite. + - `post-launch` - After reading CLI arguments, + setting up the database and running all migrations. +- Add + - `pre-add` - Right before adding a new task. + Can be used to prevent addition of task. + - `post-add` - After new task was added. +- Modify + - `pre-modify` - Right before a task gets modified. + Can be used to prevent modification of task. + - `post-modify` - After task was modified. +- Exit + - `pre-exit` - Pre printing results + - `post-exit` - Last thing before program termination + +The hooks receive JSON data from TaskLite via stdin. +We're using JSON5 here for better readability. + +Included fields are: + +```js { arguments: […], // Command line arguments (after `tasklite`) - taskOriginal: {}, // Task before any modifications by TaskLite - taskModified: {}, // Modified task + … // Stage specific fields (see below) } ``` -After execution, every called hook must print a JSON object to stdout -(even if it's empty). +After execution, a called hook can print a JSON object to stdout. All fields of the JSON are optional. -Explanation of possible values: +Possible values: -```json5 +```js { message: "…", // A message to display on stdout - taskModified: "…", // New version of the task as computed by your script - tasksToAdd: […], // Additional tasks to add + warning: "…", // A warning to display on stderr + error: "…", // An error to display on stderr + … // Any other fields you want to include } ``` -Hooks can write to stderr at any time, but it is not recommended. -Rather write a `{message: ''}` object to stdout and +Hooks can write to stdout at any time, but it's not recommended. +Rather write a `{ message: "…" }` object to stdout and let TaskLite print the message with improved formatting and coloring. - -Legend: - -- ❌ = Not available -- `->` = Must return following object (fields optional) on stdout - +Same goes for stderr. - - - + + + - + - - + + @@ -122,12 +118,13 @@ Legend: @@ -138,14 +135,10 @@ Legend: taskAdded: {} } - + @@ -159,12 +152,13 @@ Legend: @@ -179,53 +173,77 @@ Legend: - - + + - - + +
EventInputSuccess
(exitcode == 0)		Error
(exitcode != 0)		StdinStdout on Success
(exitcode == 0)		Stdout on Error
(exitcode != 0)
pre‑launch ❌
--> {
-  message: "…",
-}
{ message: "…", … }
 - 
-> {message: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates
post‑launch
-{
-  arguments: […]
-}
-      
-{
-  message: "…"
-}
-      
{ arguments: […] }
{ message: "…", … }
 - 
{stderr: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates 
 {
   taskToAdd: {},
-  message: "…"
+  message: "…",
+  …,
 }
- 
{stderr: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates 
-{
-  message: "…"
-}
-      
{ message: "…", … }
 - 
{stderr: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates 
 {
   taskModified: {},
-  message: "…"
+  message: "…",
+  …
 }
- 
{stderr: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates 
 {
   taskModified: {},
-  message: "…"
+  message: "…",
+  …
 }
- 
{stderr: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates
pre‑exit
-{}
-      
-{
-  message: "…"
-}
-      
❌
{ message: "…", … }
 - 
{stderr: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates
post‑exit
-{}
-      
-{
-  message: "…"
-}
-      
❌
{ message: "…", … }
 - 
{stderr: "…"}
- Processing terminates + 
{ message: "…", … }
+ Processing terminates
-  +## Debugging To see the JSON for a single task run: ```sh -tl ndjson | head -n 1 | jq +tl ndjson | grep $ULID_OF_TASK | head -n 1 | jq +``` + + +## Examples + +### Shell + +**Pre launch:** + +```sh +stdin=$(cat) + +>&2 echo "File > pre-launch: Input via stdin:" +>&2 echo "$stdin" +echo "{}" +``` + +**Post launch:** + +```sh +stdin=$(cat) + +>&2 echo "File > post-launch: Input via stdin:" +>&2 echo "$stdin" +echo "{}" +``` + +**Pre add:** + +```sh +stdin=$(cat) + +>&2 echo "File > pre-add: Input via stdin:" +>&2 echo "$stdin" +echo "{}" ``` diff --git a/tasklite-core/source/Cli.hs b/tasklite-core/source/Cli.hs index 1be90c9..156ae2a 100644 --- a/tasklite-core/source/Cli.hs +++ b/tasklite-core/source/Cli.hs @@ -4,6 +4,7 @@ {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use camelCase" #-} +{-# HLINT ignore "Replace case with maybe" #-} module Cli where @@ -1259,22 +1260,20 @@ executeCLiCommand conf now connection progName args = do ExternalCommand cmd argsMb -> handleExternalCommand conf cmd argsMb -printOutput :: String -> Config -> IO () -printOutput appName config = do - let dataPath = config.dataDir - +printOutput :: String -> Maybe [String] -> Config -> IO () +printOutput appName argsMb config = do configNormDataDir <- - if null dataPath + if null config.dataDir then do xdgDataDir <- getXdgDirectory XdgData appName pure $ config{dataDir = xdgDataDir} - else case T.stripPrefix "~/" $ T.pack dataPath of + else case T.stripPrefix "~/" $ T.pack config.dataDir of Nothing -> pure config Just rest -> do homeDir <- getHomeDirectory pure $ config{dataDir = homeDir T.unpack rest} - let hooksPath = configNormDataDir & hooks & directory + let hooksPath = configNormDataDir.hooks.directory configNormHookDir <- if null hooksPath @@ -1282,8 +1281,8 @@ printOutput appName config = do pure $ configNormDataDir { hooks = - (configNormDataDir & hooks) - { directory = dataDir configNormDataDir "hooks" + configNormDataDir.hooks + { directory = configNormDataDir.dataDir "hooks" } } else case T.stripPrefix "~/" $ T.pack hooksPath of @@ -1293,12 +1292,12 @@ printOutput appName config = do pure $ configNormDataDir { hooks = - (configNormDataDir & hooks) + configNormDataDir.hooks { directory = homeDir T.unpack rest } } - let hooksPathNorm = configNormHookDir & hooks & directory + let hooksPathNorm = configNormHookDir.hooks.directory createDirectoryIfMissing True hooksPathNorm @@ -1328,7 +1327,7 @@ printOutput appName config = do let configNorm = addHookFilesToConfig configNormHookDir hookFilesPermContent - preLaunchResult <- executeHooks "" (configNorm.hooks & launch & pre) + preLaunchResult <- executeHooks "" configNorm.hooks.launch.pre putDoc preLaunchResult connection <- setupConnection configNorm @@ -1343,7 +1342,9 @@ printOutput appName config = do now = timeFromElapsedP nowElapsed :: DateTime progName <- getProgName - args <- getArgs + args <- case argsMb of + Just args -> pure args + Nothing -> getArgs postLaunchResult <- executeHooks ( TL.toStrict $ @@ -1351,7 +1352,7 @@ printOutput appName config = do Aeson.encode $ object ["arguments" .= args] ) - (configNorm.hooks & launch & post) + configNorm.hooks.launch.post putDoc postLaunchResult doc <- executeCLiCommand configNorm now connection progName args diff --git a/tasklite-core/source/Lib.hs b/tasklite-core/source/Lib.hs index 3bd3f9f..c72ff6a 100644 --- a/tasklite-core/source/Lib.hs +++ b/tasklite-core/source/Lib.hs @@ -195,7 +195,7 @@ import Config ( utcFormat, utcFormatShort ), - HookSet (pre), + HookSet (post, pre), HooksConfig (add), defaultConfig, ) @@ -511,19 +511,43 @@ addTask conf connection bodyWords = do -- TODO: Add tags and notes to task ] ) - (conf.hooks & add & pre) + conf.hooks.add.pre putDoc preAddResult insertRecord "tasks" connection task warnings <- insertTags connection Nothing task tags - pure $ - warnings - <$$> ( "🆕 Added task" - <+> dquotes (pretty task.body) - <+> "with id" - <+> dquotes (pretty task.ulid) - ) + -- TODO: Use RETURNING clause in `insertRecord` instead + (insertedTasks :: [FullTask]) <- + queryNamed + connection + "SELECT * FROM tasks_view WHERE ulid == :ulid" + [":ulid" := task.ulid] + + case insertedTasks of + [insertedTask] -> do + postAddResult <- + executeHooks + ( TL.toStrict $ + TL.decodeUtf8 $ + Aeson.encode $ + object + [ "arguments" .= args + , "taskAdded" .= insertedTask + -- TODO: Add tags and notes to task + ] + ) + conf.hooks.add.post + putDoc postAddResult + + pure $ + warnings + <$$> ( "🆕 Added task" + <+> dquotes (pretty task.body) + <+> "with id" + <+> dquotes (pretty task.ulid) + ) + _ -> pure "Task could not be added" logTask :: Config -> Connection -> [Text] -> IO (Doc AnsiStyle) @@ -1103,15 +1127,15 @@ repeatTasks conf connection duration ids = do queryNamed connection [sql| - UPDATE tasks - SET - repetition_duration = :repetition_duration, - group_ulid = :group_ulid - WHERE - ulid == :ulid AND - recurrence_duration IS NULL - RETURNING recurrence_duration - |] + UPDATE tasks + SET + repetition_duration = :repetition_duration, + group_ulid = :group_ulid + WHERE + ulid == :ulid AND + recurrence_duration IS NULL + RETURNING recurrence_duration + |] [ ":repetition_duration" := durationIsoText , ":group_ulid" := groupUlid , ":ulid" := task.ulid @@ -1167,15 +1191,15 @@ recurTasks conf connection duration ids = do queryNamed connection [sql| - UPDATE tasks - SET - recurrence_duration = :recurrence_duration, - group_ulid = :group_ulid - WHERE - ulid == :ulid AND - repetition_duration IS NULL - RETURNING repetition_duration - |] + UPDATE tasks + SET + recurrence_duration = :recurrence_duration, + group_ulid = :group_ulid + WHERE + ulid == :ulid AND + repetition_duration IS NULL + RETURNING repetition_duration + |] [ ":recurrence_duration" := durationIsoText , ":group_ulid" := groupUlid , ":ulid" := task.ulid diff --git a/tasklite-core/source/Utils.hs b/tasklite-core/source/Utils.hs index da8787d..e0a171a 100644 --- a/tasklite-core/source/Utils.hs +++ b/tasklite-core/source/Utils.hs @@ -92,6 +92,7 @@ import Base32 (decode) import Config (Config (bodyStyle, utcFormat), Hook (body, filePath, interpreter)) import Control.Arrow ((>>>)) import Prettyprinter.Internal.Type (Doc (Empty)) +import System.FilePath (takeExtension) import System.Random (mkStdGen) @@ -315,27 +316,33 @@ numDigits base num = executeHooks :: Text -> [Hook] -> IO (Doc AnsiStyle) executeHooks stdinText hooks = do - let stdinStr = T.unpack stdinText - cmdOutput <- forM hooks $ \hook -> + let + stdinStr = T.unpack stdinText + getInterpreter s = + if + | s `P.elem` ["javascript", "js", "node", "node.js"] -> ("node", "-e") + | s `P.elem` ["lua"] -> ("lua", "-e") + | s `P.elem` ["python", "python3", "py"] -> ("python3", "-c") + | s `P.elem` ["ruby", "rb"] -> ("ruby", "-e") + | otherwise -> pure mempty + + cmdOutput <- forM hooks $ \hook -> do case hook.filePath of - Just fPath -> readProcess fPath [] stdinStr + Just fPath -> do + case fPath & takeExtension & P.drop 1 of + "" -> + -- Is excuted with shell + readProcess fPath [] stdinStr + ext -> do + let (interpreter, cliFlag) = getInterpreter ext + fileContent <- P.readFile fPath + readProcess interpreter [cliFlag, T.unpack fileContent] stdinStr + --- Nothing -> do - let ipret = hook.interpreter - if - | ipret `P.elem` ["ruby", "rb"] -> - readProcess "ruby" ["-e", T.unpack hook.body] stdinStr - | ipret `P.elem` ["javascript", "js", "node", "node.js"] -> - readProcess "node" ["-e", T.unpack hook.body] stdinStr - | ipret `P.elem` ["python", "python3", "py"] -> - readProcess "python3" ["-c", T.unpack hook.body] stdinStr - | otherwise -> - pure mempty + let (interpreter, cliFlag) = getInterpreter hook.interpreter + readProcess interpreter [cliFlag, T.unpack hook.body] stdinStr - pure $ - cmdOutput - <&> T.pack - & T.unlines - & pretty + pure $ cmdOutput <&> T.pack & T.unlines & pretty applyColorMode :: Config -> IO Config diff --git a/tasklite/app/Main.hs b/tasklite/app/Main.hs index da4f5eb..fc55fb7 100644 --- a/tasklite/app/Main.hs +++ b/tasklite/app/Main.hs @@ -7,6 +7,7 @@ import Protolude ( Bool (True), Either (..), IO, + Maybe (Nothing), die, writeFile, ($), @@ -49,7 +50,7 @@ main = do case configResult2 of Left error2 -> die $ T.pack $ prettyPrintParseException error2 - Right configUser -> printOutput appName configUser + Right configUser -> printOutput appName Nothing configUser else die $ T.pack $ prettyPrintParseException error Right configUser -> - printOutput appName configUser + printOutput appName Nothing configUser diff --git a/tasklite/package.yaml b/tasklite/package.yaml index 7c3dca2..fe07dd7 100644 --- a/tasklite/package.yaml +++ b/tasklite/package.yaml @@ -62,5 +62,8 @@ tests: main: Spec.hs source-dirs: test dependencies: + - directory - hspec >= 2.11 && < 3.0 - optparse-applicative >= 0.16 && < 0.19 + - template-haskell >= 2.17 && < 2.23 + - temporary >= 1.3 && < 1.4 diff --git a/tasklite/tasklite.cabal b/tasklite/tasklite.cabal index 462206d..5dfe8bf 100644 --- a/tasklite/tasklite.cabal +++ b/tasklite/tasklite.cabal @@ -65,6 +65,7 @@ test-suite tasklite-test main-is: Spec.hs other-modules: CliSpec + Utils Paths_tasklite autogen-modules: Paths_tasklite @@ -83,8 +84,11 @@ test-suite tasklite-test ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wno-orphans -Wredundant-constraints -Wunused-packages build-depends: base >=4.18 && <5 + , directory , hspec >=2.11 && <3.0 , optparse-applicative >=0.16 && <0.19 , protolude ==0.3.* , tasklite-core + , template-haskell >=2.17 && <2.23 + , temporary ==1.3.* default-language: GHC2021 diff --git a/tasklite/test/CliSpec.hs b/tasklite/test/CliSpec.hs index fc7cf0a..f3404b3 100644 --- a/tasklite/test/CliSpec.hs +++ b/tasklite/test/CliSpec.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE QuasiQuotes #-} + module CliSpec where -import Protolude (($), (&)) +import Protolude (Maybe (Just, Nothing), ($), (&), (<>)) import Protolude qualified as P import Options.Applicative ( @@ -11,16 +13,36 @@ import Options.Applicative ( parserFailure, renderFailure, ) -import Test.Hspec (Spec, describe, it, shouldContain) +import Test.Hspec (Spec, describe, it, shouldBe, shouldContain) + +import Cli (commandParserInfo, printOutput) +import Config (Config, Hook (Hook), HookSet (HookSet), defaultConfig) +import Config qualified +import System.Directory ( + Permissions (executable, readable), + emptyPermissions, + setPermissions, + ) +import Utils (raw) + -import Cli (commandParserInfo) -import Config (defaultConfig) +createHook :: Config -> P.FilePath -> P.Text -> P.IO () +createHook conf name content = do + let filePath = conf.hooks.directory <> "/" <> name + P.writeFile filePath content + setPermissions + filePath + ( emptyPermissions + { executable = P.True + , readable = P.True + } + ) -spec :: Spec -spec = do +spec :: P.FilePath -> Spec +spec tmpDirPath = do describe "CLI" $ do - it "should include header, body, and footer in help output" $ do + it "includes header, body, and footer in help output" $ do let failure :: ParserFailure ParserHelp = parserFailure @@ -33,3 +55,87 @@ spec = do helpText `shouldContain` "Usage: xxx" helpText `shouldContain` "developed by" + + it "prints current version" $ do + _ <- printOutput "test-app" (Just ["version"]) defaultConfig + () `shouldBe` () + + it "calls task lifecycle hooks (add, modify) stored in config" $ do + let + getLuaHook body = + Hook + { Config.filePath = Nothing + , Config.interpreter = "lua" + , Config.body = body + } + preAddHook = + getLuaHook + [raw| + print("🏃 Executing pre-add script …") + print("ℹ️ Receives an object with arguments:", io.read("*a")) + |] + postAddHook = + getLuaHook + [raw| + print("🏃 Executing post-add script …") + print("ℹ️ Receives an object with arguments:", io.read("*a")) + |] + preModifyHook = + getLuaHook + [raw| + print("🏃 Executing pre-modify script …") + print("ℹ️ Receives an object with arguments:", io.read("*a")) + |] + postModifyHook = + getLuaHook + [raw| + print("🏃 Executing post-modify script …") + print("ℹ️ Receives an object with arguments:", io.read("*a")) + |] + testConf = + defaultConfig + { Config.hooks = + defaultConfig.hooks + { Config.add = + HookSet + { pre = [preAddHook] + , post = [postAddHook] + } + , Config.modify = + HookSet + { pre = [preModifyHook] + , post = [postModifyHook] + } + } + } + + _ <- printOutput "test-app" (Just ["add", "buy milk"]) testConf + + () `shouldBe` () + + it "calls launch hooks stored in files" $ do + let + testConf = + defaultConfig + { Config.hooks = + defaultConfig.hooks{Config.directory = tmpDirPath} + } + hookFor = createHook testConf + + hookFor + "pre-launch.lua" + [raw| + print("🏃 Executing pre-launch script …") + print("ℹ️ Receives no input:", io.read("*a")) + |] + + hookFor + "post-launch.lua" + [raw| + print("🏃 Executing post-launch script …") + print("ℹ️ Receives an object with arguments:", io.read("*a")) + |] + + _ <- printOutput "test-app" (Just ["head"]) testConf + + () `shouldBe` () diff --git a/tasklite/test/Spec.hs b/tasklite/test/Spec.hs index bf8e810..637d26a 100644 --- a/tasklite/test/Spec.hs +++ b/tasklite/test/Spec.hs @@ -1,4 +1,5 @@ -import Protolude (IO) +import Protolude (IO, ($)) +import System.IO.Temp (withSystemTempDirectory) import Test.Hspec (hspec) import CliSpec qualified @@ -6,4 +7,5 @@ import CliSpec qualified main :: IO () main = do - hspec CliSpec.spec + withSystemTempDirectory "tasklite-test" $ \dirPath -> do + hspec $ CliSpec.spec dirPath diff --git a/tasklite/test/Utils.hs b/tasklite/test/Utils.hs new file mode 100644 index 0000000..a6f73d8 --- /dev/null +++ b/tasklite/test/Utils.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} + +module Utils where + +import Protolude (pure, (.)) +import Protolude.Error (error) + +import Language.Haskell.TH (Exp (LitE), Lit (StringL)) +import Language.Haskell.TH.Quote ( + QuasiQuoter (QuasiQuoter, quoteDec, quoteExp, quotePat, quoteType), + ) + + +raw :: QuasiQuoter +raw = + QuasiQuoter + { quoteExp = pure . LitE . StringL + , quotePat = \_ -> + error + "Illegal raw string QuasiQuote \ + \(allowed as expression only, used as a pattern)" + , quoteType = \_ -> + error + "Illegal raw string QuasiQuote \ + \(allowed as expression only, used as a type)" + , quoteDec = \_ -> + error + "Illegal raw string QuasiQuote \ + \(allowed as expression only, used as a declaration)" + }