Skip to content

Commit

Permalink
First creation logic
Browse files Browse the repository at this point in the history
  • Loading branch information
tchoutri committed May 28, 2024
1 parent f51f922 commit 66359cf
Show file tree
Hide file tree
Showing 3 changed files with 26 additions and 10 deletions.
10 changes: 7 additions & 3 deletions src/Confer/Cmd/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -53,6 +56,7 @@ check = do
Success _ -> pure ()
Left e -> error e


validateSymlink
:: (Symlink :> es)
=> Fact
Expand All @@ -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 "
Expand Down
18 changes: 12 additions & 6 deletions src/Confer/Cmd/Deploy.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
--
Expand All @@ -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
8 changes: 7 additions & 1 deletion src/Confer/Effect/Symlink.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module Confer.Effect.Symlink
, deleteSymlink
, testSymlink
, runSymlinkIO
, verifyExistingSymlink
, Symlink(..)
, SymlinkError(..)
) where
Expand Down Expand Up @@ -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)
)

0 comments on commit 66359cf

Please sign in to comment.