From 66359cf33e9a3a906a8c0ccccfdc343d8afe306f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= <theophile@choutri.eu>
Date: Tue, 28 May 2024 13:36:24 +0200
Subject: [PATCH] First creation logic

---
 src/Confer/Cmd/Check.hs      | 10 +++++++---
 src/Confer/Cmd/Deploy.hs     | 18 ++++++++++++------
 src/Confer/Effect/Symlink.hs |  8 +++++++-
 3 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/src/Confer/Cmd/Check.hs b/src/Confer/Cmd/Check.hs
index 91aa228..329cbdc 100644
--- a/src/Confer/Cmd/Check.hs
+++ b/src/Confer/Cmd/Check.hs
@@ -2,6 +2,8 @@ module Confer.Cmd.Check (check) where
 
 import Control.Monad
 import Control.Placeholder
+import Data.Vector (Vector)
+import Data.Vector qualified as Vector
 import Data.Foldable
 import Data.Function
 import Data.List.NonEmpty
@@ -40,8 +42,9 @@ check = do
                 currentOS
                 currentArch
                 allDeployments
-        result <- sequenceA . join <$> forM deployments $ \deployment ->
-          forM deployment.facts $ \fact -> do
+        result <- mconcat . Vector.toList <$> do
+          let facts :: Vector Fact = foldMap (.facts) deployments
+          forM facts $ \fact -> do
             liftIO $ Text.putStrLn $ "[+] Checking " <> display fact
             validateSymlink fact
         case result of
@@ -53,6 +56,7 @@ check = do
           Success _ -> pure ()
     Left e -> error e
 
+
 validateSymlink
   :: (Symlink :> es)
   => Fact
@@ -73,7 +77,7 @@ formatSymlinkError (IsNotSymlink path) =
   "[!] "
     <> display (Text.pack . show $ path)
     <> " is not a symbolic link"
-forratSymlinkError (WrongTarget linkPath expectedTarget actualTarget) =
+formatSymlinkError (WrongTarget linkPath expectedTarget actualTarget) =
   "[!] "
     <> display (Text.pack . show $ linkPath)
     <> " points to "
diff --git a/src/Confer/Cmd/Deploy.hs b/src/Confer/Cmd/Deploy.hs
index 780e0e6..198f15b 100644
--- a/src/Confer/Cmd/Deploy.hs
+++ b/src/Confer/Cmd/Deploy.hs
@@ -3,9 +3,13 @@ module Confer.Cmd.Deploy (deploy) where
 import Control.Placeholder
 import Data.Vector (Vector)
 import Effectful
+import Control.Monad
 import Effectful.FileSystem (FileSystem)
+import Effectful.FileSystem qualified as FileSystem
+import System.OsPath (OsPath, (</>))
+import System.OsPath qualified as OsPath
 
-import Confer.Effect.Symlink 
+import Confer.Effect.Symlink
 import Confer.Config.Types
 -- | Take a filtered and checked list of deployments.
 --
@@ -20,11 +24,13 @@ deploy
      , Symlink :> es
      , IOE :> es
      )
-  => (Vector Deployment)
+  => Vector Deployment
   -> Eff es ()
 deploy deployments = do
-  forM_ deployments $ \d -> 
-    forM_ d.facts $ \f -> do
+  forM_ deployments $ \d ->
+    forM_ d.facts $ \fact -> do
       let osPath = fact.destination </> fact.source
-      exists <- FileSystem.doesPathExist osPath
-      createSymlink f.source f.destination
+      filepath <- liftIO $ OsPath.decodeFS osPath
+      exists <- FileSystem.doesPathExist filepath
+      unless exists $
+        createSymlink fact.source fact.destination
diff --git a/src/Confer/Effect/Symlink.hs b/src/Confer/Effect/Symlink.hs
index c8c8169..2a158a6 100644
--- a/src/Confer/Effect/Symlink.hs
+++ b/src/Confer/Effect/Symlink.hs
@@ -3,6 +3,7 @@ module Confer.Effect.Symlink
   , deleteSymlink
   , testSymlink
   , runSymlinkIO
+  , verifyExistingSymlink
   , Symlink(..)
   , SymlinkError(..)
   ) where
@@ -88,4 +89,9 @@ verifyExistingSymlink linkPath expectedLinkTarget = do
   actualLinkTarget <- FileSystem.getSymbolicLinkTarget linkPath
   if actualLinkTarget == expectedLinkTarget
   then pure (Right ())
-  else pure (Left (WrongTarget linkPath))
+  else pure $ Left
+    (WrongTarget
+      (OsPath.unsafeEncodeUtf linkPath)
+      (OsPath.unsafeEncodeUtf expectedLinkTarget)
+      (OsPath.unsafeEncodeUtf actualLinkTarget)
+    )