{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use maybe" #-} module Hooks where import Protolude ( Applicative (pure), IO, Maybe (..), Show, otherwise, ($), (&), (<&>), ) import Protolude qualified as P import Control.Arrow ((>>>)) import Data.Aeson qualified as Aeson import Data.Text (Text) import Data.Text qualified as T import Options.Applicative.Arrows (left) import Prettyprinter (Doc, annotate, pretty) import Prettyprinter.Render.Terminal (AnsiStyle, Color (Red, Yellow)) import System.FilePath (takeExtension) import System.Process (readProcess) import Config (Config, Hook (body, filePath, interpreter)) import ImportTask (ImportTask) import Utils (colr, ()) data HookTiming = PreEvent | PostEvent deriving (Show) data HookType = LaunchHook | AddHook | ModifyHook | ExitHook deriving (Show) data HookEvent = HookEvent HookType HookTiming deriving (Show) -- | Output of a hook that must be parsed by TaskLite data HookResult = BasicHookResult { message :: Maybe Text , warning :: Maybe Text , error :: Maybe Text } | TaskHookResult { task :: Maybe ImportTask , message :: Maybe Text , warning :: Maybe Text , error :: Maybe Text } deriving (Show, P.Generic) instance Aeson.FromJSON HookResult where parseJSON = Aeson.withObject "HookResult" $ \v -> do taskMb <- v Aeson..:? "task" messageMb <- v Aeson..:? "message" warningMb <- v Aeson..:? "warning" errorMb <- v Aeson..:? "error" case taskMb of Just task -> pure $ TaskHookResult task messageMb warningMb errorMb Nothing -> pure $ BasicHookResult messageMb warningMb errorMb data ExecMode = ExecFile | ExecStdin type String = [P.Char] executeHooks :: Text -> [Hook] -> IO [P.Either Text HookResult] executeHooks stdinText hooks = do let stdinStr = T.unpack stdinText getInterpreter :: String -> (String, [String], ExecMode) getInterpreter s = if | s `P.elem` ["javascript", "js", "node", "node.js"] -> ("node", ["-e"], ExecStdin) | s `P.elem` ["lua"] -> ("lua", ["-e"], ExecStdin) | s `P.elem` ["python", "python3", "py"] -> ("python3", ["-c"], ExecStdin) | s `P.elem` ["ruby", "rb"] -> ("ruby", ["-e"], ExecStdin) | s `P.elem` ["v", "vsh"] -> -- `crun` keeps the binary after execution ("v", ["-raw-vsh-tmp-prefix", "_v_executable_"], ExecFile) | otherwise -> ("", [""], ExecFile) hookToResult <- P.sequence $ hooks <&> \hook -> do case hook.filePath of Just fPath -> do case fPath & takeExtension & P.drop 1 of "" -> -- Is executed with shell readProcess fPath [] stdinStr ext -> do let (interpreter, cliFlags, execMode) = getInterpreter ext case execMode of ExecStdin -> do fileContent <- P.readFile fPath readProcess interpreter (P.concat [cliFlags, [T.unpack fileContent]]) stdinStr ExecFile -> do readProcess interpreter (P.concat [cliFlags, [fPath]]) stdinStr --- Nothing -> do let (interpreter, cliFlags, _) = getInterpreter (T.unpack hook.interpreter) readProcess interpreter (P.concat [cliFlags, [T.unpack hook.body]]) stdinStr let parsedHookResults :: [P.Either Text HookResult] = hookToResult & P.filter (T.pack >>> T.strip >>> T.null >>> P.not) <&> ( ( \hookOutput -> do Aeson.eitherDecodeStrictText (T.pack hookOutput) ) >>> left T.pack ) pure parsedHookResults formatHookResult :: Config -> HookResult -> Doc AnsiStyle formatHookResult conf hookResult = "" pretty hookResult.message annotate (colr conf Yellow) (pretty hookResult.warning) annotate (colr conf Red) (pretty hookResult.error) ""