Fix IO linking

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 =

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)

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

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

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

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

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

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 ->