From 07b976ccd89cc8a4b5d0624ee2223d64add4615d Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Mon, 19 Jun 2023 15:56:32 +0200 Subject: feat(users/Profpatsch): init whatcd-resolver Change-Id: Ieb377fb8caa60e716703153dfeca5173f9a6779d Reviewed-on: https://cl.tvl.fyi/c/depot/+/8830 Reviewed-by: Profpatsch Tested-by: BuildkiteCI --- users/Profpatsch/whatcd-resolver/src/Tool.hs | 75 ++++++++++++++++++++++++++++ 1 file changed, 75 insertions(+) create mode 100644 users/Profpatsch/whatcd-resolver/src/Tool.hs (limited to 'users/Profpatsch/whatcd-resolver/src/Tool.hs') diff --git a/users/Profpatsch/whatcd-resolver/src/Tool.hs b/users/Profpatsch/whatcd-resolver/src/Tool.hs new file mode 100644 index 000000000000..066f68bbe0df --- /dev/null +++ b/users/Profpatsch/whatcd-resolver/src/Tool.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Tool where + +import Data.Error.Tree +import Label +import PossehlAnalyticsPrelude +import System.Environment qualified as Env +import System.Exit qualified as Exit +import System.FilePath (()) +import System.Posix qualified as Posix +import ValidationParseT + +data Tool = Tool + { -- | absolute path to the executable + toolPath :: FilePath + } + deriving stock (Show) + +-- | Reads all tools from the @toolsEnvVar@ variable or aborts. +readTools :: + Label "toolsEnvVar" Text -> + -- | Parser for Tools we bring with us at build time. + -- + -- These are executables that we need available, and that we have to ship with the distribution of @pa-cli@. + ToolParserT IO tools -> + IO tools +readTools env toolParser = + Env.lookupEnv (env.toolsEnvVar & textToString) >>= \case + Nothing -> do + Exit.die [fmt|Please set {env.toolsEnvVar} to a directory with all tools we need (see `Tools` in the code).|] + Just toolsDir -> + (Posix.fileExist toolsDir & ifTrueOrErr () [fmt|{env.toolsEnvVar} directory does not exist: {toolsDir}|]) + & thenValidate + ( \() -> + (Posix.getFileStatus toolsDir <&> Posix.isDirectory) + & ifTrueOrErr () [fmt|{env.toolsEnvVar} does not point to a directory: {toolsDir}|] + ) + & thenValidate + (\() -> toolParser.unToolParser toolsDir) + <&> first (errorTree [fmt|Could not find all tools in {env.toolsEnvVar}|]) + >>= \case + Failure err -> Exit.die (err & prettyErrorTree & textToString) + Success t -> pure t + +newtype ToolParserT m a = ToolParserT + { unToolParser :: + FilePath -> + m (Validation (NonEmpty Error) a) + } + deriving + (Functor, Applicative) + via (ValidationParseT FilePath m) + +-- | Given a file path and the name of the tool executable, see whether it is an executable and return its full path. +readTool :: Text -> ToolParserT IO Tool +readTool exeName = ToolParserT $ \toolDir -> do + let toolPath :: FilePath = toolDir (exeName & textToString) + let read' = True + let write = False + let exec = True + Posix.fileExist toolPath + & ifTrueOrErr () [fmt|Tool does not exist: {toolPath}|] + & thenValidate + ( \() -> + Posix.fileAccess toolPath read' write exec + & ifTrueOrErr (Tool {..}) [fmt|Tool is not readable/executable: {toolPath}|] + ) + +-- | helper +ifTrueOrErr :: Functor f => a -> Text -> f Bool -> f (Validation (NonEmpty Error) a) +ifTrueOrErr true err io = + io <&> \case + True -> Success true + False -> Failure $ singleton $ newError err -- cgit 1.4.1