From e107ba28a27e4ed9f1f4f6cb7e4ef0a360eeaf79 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Wed, 5 Jun 2024 18:35:49 +0200 Subject: [PATCH] Fix IO linking --- app/Main.hs | 7 +------ src/Confer/CLI/Cmd/Check.hs | 5 ++--- src/Confer/CLI/Cmd/Deploy.hs | 14 +++++++++----- src/Confer/CLI/Errors.hs | 24 ++++++++++++++++++++++++ src/Confer/Config/ConfigFile.hs | 26 ++++++++++++++++++++------ src/Confer/Config/Evaluator.hs | 15 +++++++++++---- src/Confer/Config/Types.hs | 14 ++++++++++++-- src/Confer/Effect/Symlink.hs | 3 ++- 8 files changed, 81 insertions(+), 27 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index bf9a647..cffebfc 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,7 +10,6 @@ import Effectful.Error.Static import Effectful.FileSystem import Options.Applicative import Options.Applicative.Types -import System.Exit qualified as System import System.OsPath import System.OsPath qualified as OsPath @@ -47,11 +46,7 @@ main = do & runEff case result of Right _ -> pure () - Left NoDefaultConfigurationFile -> - liftIO $ System.die "Could not find configuration file at ./deployments.lua" - Left (NoUserProvidedConfigurationFile osPath) -> do - filePath <- liftIO $ OsPath.decodeFS osPath - liftIO $ System.die $ "Could not find configuration file at" <> filePath + Left e -> reportError e parseOptions :: Parser Options parseOptions = diff --git a/src/Confer/CLI/Cmd/Check.hs b/src/Confer/CLI/Cmd/Check.hs index 49bfb85..2758d3f 100644 --- a/src/Confer/CLI/Cmd/Check.hs +++ b/src/Confer/CLI/Cmd/Check.hs @@ -17,7 +17,7 @@ import Effectful.FileSystem (FileSystem) import Effectful.FileSystem qualified as FileSystem import System.Exit qualified as System import System.Info qualified as System -import System.OsPath (OsPath, ()) +import System.OsPath (OsPath) import System.OsPath qualified as OsPath import Validation @@ -52,8 +52,7 @@ validateSymlink => Fact -> Eff es (Validation (NonEmpty SymlinkError) ()) validateSymlink fact = do - let osPath = fact.destination fact.source - result <- Symlink.testSymlink osPath + result <- Symlink.testSymlink fact.destination case result of Right _ -> pure $ Success () Left e -> pure $ Failure (NE.singleton e) diff --git a/src/Confer/CLI/Cmd/Deploy.hs b/src/Confer/CLI/Cmd/Deploy.hs index 1901fc6..50116a1 100644 --- a/src/Confer/CLI/Cmd/Deploy.hs +++ b/src/Confer/CLI/Cmd/Deploy.hs @@ -2,11 +2,13 @@ module Confer.CLI.Cmd.Deploy (deploy) where import Control.Monad import Control.Placeholder +import Data.Text.Display +import Data.Text.IO qualified as Text import Data.Vector (Vector) import Effectful import Effectful.FileSystem (FileSystem) import Effectful.FileSystem qualified as FileSystem -import System.OsPath (OsPath, ()) +import System.OsPath (OsPath) import System.OsPath qualified as OsPath import Confer.Config.Types @@ -30,8 +32,10 @@ deploy deploy deployments = do forM_ deployments $ \d -> forM_ d.facts $ \fact -> do - let osPath = fact.destination fact.source - filepath <- liftIO $ OsPath.decodeFS osPath - exists <- FileSystem.doesPathExist filepath - unless exists $ + filepath <- liftIO $ OsPath.decodeFS fact.destination + destinationPathExists <- FileSystem.doesPathExist filepath + unless destinationPathExists $ do + liftIO $ + Text.putStrLn $ + "[🔗] " <> display fact createSymlink fact.source fact.destination diff --git a/src/Confer/CLI/Errors.hs b/src/Confer/CLI/Errors.hs index bf05b40..7de3fab 100644 --- a/src/Confer/CLI/Errors.hs +++ b/src/Confer/CLI/Errors.hs @@ -1,8 +1,32 @@ module Confer.CLI.Errors where +import Data.Text (Text) +import Data.Text qualified as Text +import Data.Text.Display +import System.Exit qualified as System import System.OsPath (OsPath) +import System.OsPath qualified as OsPath + +import Confer.Config.Types data CLIError = NoDefaultConfigurationFile | NoUserProvidedConfigurationFile OsPath + | NoDeploymentsAvailable DeploymentOS DeploymentArchitecture Text deriving stock (Eq, Show) + +reportError :: CLIError -> IO () +reportError NoDefaultConfigurationFile = + System.die "[!] Could not find configuration file at ./deployments.lua" +reportError (NoUserProvidedConfigurationFile osPath) = do + filePath <- OsPath.decodeFS osPath + System.die $ "[!] Could not find configuration file at" <> filePath +reportError (NoDeploymentsAvailable os arch hostname) = do + let message = + "[!] Could not find deployments to run on " + <> display arch + <> "-" + <> display os + <> " " + <> hostname + System.die $ Text.unpack message diff --git a/src/Confer/Config/ConfigFile.hs b/src/Confer/Config/ConfigFile.hs index 073501d..e0b296b 100644 --- a/src/Confer/Config/ConfigFile.hs +++ b/src/Confer/Config/ConfigFile.hs @@ -2,13 +2,18 @@ module Confer.Config.ConfigFile ( processConfiguration ) where +import Control.Monad (when) import Control.Placeholder import Data.Text qualified as Text +import Data.Text.Display +import Data.Text.IO qualified as Text import Data.Vector (Vector) +import Data.Vector qualified as Vector import Effectful import Effectful.Error.Static import Effectful.FileSystem (FileSystem) import Effectful.FileSystem qualified as FileSystem +import Network.HostName import System.Info qualified as System import System.OsPath (OsPath) import System.OsPath qualified as OsPath @@ -35,11 +40,20 @@ processConfiguration mConfigurationFilePath = do Right allDeployments -> do let currentOS = OS (Text.pack System.os) let currentArch = Arch (Text.pack System.arch) - pure $ - adjustConfiguration - currentOS - currentArch - allDeployments + currentHost <- Text.pack <$> liftIO getHostName + liftIO $ Text.putStrLn $ "Hostname: " <> currentHost <> " (detected)" + liftIO $ Text.putStrLn $ "OS: " <> display currentOS <> " (detected)" + liftIO $ Text.putStrLn $ "Architecture: " <> display currentArch <> " (detected)" + let deployments = + adjustConfiguration + currentHost + currentOS + currentArch + allDeployments + when (Vector.null deployments) $ + throwError $ + NoDeploymentsAvailable currentOS currentArch currentHost + pure deployments Left e -> error e determineConfigurationFilePath @@ -60,7 +74,7 @@ determineConfigurationFilePath mCLIConfigFilePath = >>= \case False -> throwError NoDefaultConfigurationFile True -> - FileSystem.makeRelativeToCurrentDirectory "deployments.lua" + FileSystem.makeAbsolute "deployments.lua" >>= (liftIO . OsPath.encodeFS) checkCLIOptions :: Maybe OsPath -> Maybe OsPath diff --git a/src/Confer/Config/Evaluator.hs b/src/Confer/Config/Evaluator.hs index 8834bd9..20a5451 100644 --- a/src/Confer/Config/Evaluator.hs +++ b/src/Confer/Config/Evaluator.hs @@ -5,6 +5,7 @@ module Confer.Config.Evaluator import Control.Monad (void) import Control.Placeholder +import Data.Text (Text) import Data.Text qualified as Text import Data.Text.IO qualified as Text import Data.Vector (Vector) @@ -27,17 +28,22 @@ import System.OsPath.Encoding qualified as OsPath import Confer.API.Host qualified as API import Confer.API.User qualified as API import Confer.Config.Types +import Data.Maybe (isNothing) +import System.Directory qualified as Directory +import System.IO.Unsafe qualified as Unsafe adjustConfiguration - :: DeploymentOS + :: Text + -> DeploymentOS -> DeploymentArchitecture -> Vector Deployment -> Vector Deployment -adjustConfiguration os arch deployments = +adjustConfiguration hostname os arch deployments = Vector.filter ( \d -> (d.os == AllOS || d.os == os) && (d.architecture == AllArchs || d.architecture == arch) + && (d.hostname == Just hostname || isNothing d.hostname) ) deployments @@ -92,7 +98,8 @@ peekFact index = Lua.retrieving "fact" $ do peekOsPath :: Peeker Exception OsPath peekOsPath index = do - result <- Lua.peekText index - case OsPath.encodeWith utf8 utf16le (Text.unpack result) of + result <- Lua.peekString index + let absolutePath = Unsafe.unsafePerformIO $ Directory.makeAbsolute result + case OsPath.encodeWith utf8 utf16le absolutePath of Right p -> pure p Left e -> fail $ OsPath.showEncodingException e diff --git a/src/Confer/Config/Types.hs b/src/Confer/Config/Types.hs index 9ea2e6b..04cd863 100644 --- a/src/Confer/Config/Types.hs +++ b/src/Confer/Config/Types.hs @@ -12,7 +12,7 @@ import Data.Text (Text) import Data.Text.Display import Data.Text.Internal.Builder qualified as Builder import Data.Vector (Vector) -import System.OsPath (OsPath, ()) +import System.OsPath (OsPath) import System.OsPath qualified as OsPath import GHC.Generics @@ -27,8 +27,10 @@ data Fact = Fact instance Display Fact where displayBuilder Fact{name, source, destination} = Builder.fromText name + <> ": " + <> Builder.fromString (fromJust (OsPath.decodeUtf source)) <> " ~> " - <> Builder.fromString (fromJust (OsPath.decodeUtf (destination source))) + <> Builder.fromString (fromJust (OsPath.decodeUtf destination)) data Deployment = Deployment { hostname :: Maybe Text @@ -47,11 +49,19 @@ maybeToDeploymentOS :: Maybe Text -> DeploymentOS maybeToDeploymentOS Nothing = AllOS maybeToDeploymentOS (Just t) = OS t +instance Display DeploymentOS where + displayBuilder (OS t) = displayBuilder t + displayBuilder AllOS = "all systems" + data DeploymentArchitecture = AllArchs | Arch Text deriving stock (Show, Eq) +instance Display DeploymentArchitecture where + displayBuilder (Arch t) = displayBuilder t + displayBuilder AllArchs = "all architectures" + maybeToDeploymentArchitecture :: Maybe Text -> DeploymentArchitecture maybeToDeploymentArchitecture Nothing = AllArchs maybeToDeploymentArchitecture (Just t) = Arch t diff --git a/src/Confer/Effect/Symlink.hs b/src/Confer/Effect/Symlink.hs index 953f99e..fe58b63 100644 --- a/src/Confer/Effect/Symlink.hs +++ b/src/Confer/Effect/Symlink.hs @@ -62,7 +62,8 @@ runSymlinkIO = interpret $ \_ -> \case sourceType <- liftIO $ do metadata <- Directory.getFileMetadata source pure $ Directory.fileTypeFromMetadata metadata - sourcePath <- liftIO $ OsPath.decodeFS source + sourceFilePath <- liftIO $ OsPath.decodeFS source + sourcePath <- FileSystem.makeAbsolute sourceFilePath destinationPath <- liftIO $ OsPath.decodeFS destination case sourceType of File ->