Create error codes for confer

tchoutri · Jun 29, 2024 · 245743f · 245743f
1 parent 9965a51
commit 245743f
Show file tree

Hide file tree

Showing 4 changed files with 57 additions and 29 deletions.
diff --git a/cabal.project b/cabal.project
@@ -10,8 +10,16 @@ documentation: True
 
 tests: True
 
--- package confer
---   ghc-options: -fhpc
+package confer
+  ghc-options: -prof -fprof-auto
+
+profiling: True
+
+library-profiling: True
+
+semaphore: True
+
+jobs: $ncpus
 
 package *
   ghc-options: +RTS -A32m -RTS -j -haddock

diff --git a/src/Confer/CLI/Cmd/Check.hs b/src/Confer/CLI/Cmd/Check.hs
@@ -24,10 +24,10 @@ import System.OsPath qualified as OsPath
 import Validation
 
 import Confer.CLI.Errors (CLIError (..))
+import Confer.CLI.Errors qualified as Errors
 import Confer.Config.Evaluator
 import Confer.Config.Types
 import Confer.Effect.Symlink (Symlink, SymlinkError (..))
-import Confer.Effect.Symlink qualified as Errors
 import Confer.Effect.Symlink qualified as Symlink
 
 check
@@ -49,7 +49,7 @@ check deployments = do
       forM_ errors $
         \e ->
           liftIO $ Text.putStrLn $ Errors.formatSymlinkError e
-      Error.throwError (SymlinkErrors errors)
+    -- Error.throwError (SymlinkErrors errors)
     Success _ -> pure ()
 
 validateSymlink

diff --git a/src/Confer/CLI/Errors.hs b/src/Confer/CLI/Errors.hs
@@ -14,6 +14,7 @@ import Confer.Effect.Symlink (SymlinkError (..))
 import Confer.Effect.Symlink qualified as Symlink
 import Control.Monad.IO.Class (liftIO)
 import Data.Foldable
+import Data.Word (Word8)
 
 data CLIError
   = NoDefaultConfigurationFile
@@ -22,15 +23,35 @@ data CLIError
   | SymlinkErrors (NonEmpty SymlinkError)
   deriving stock (Eq, Show)
 
+newtype ErrorCode = ErrorCode Word8
+  deriving newtype (Eq, Show, Ord)
+
+instance Display ErrorCode where
+  displayBuilder c = "[CONFER-" <> displayBuilder c <> "]"
+
+cliErrorToCode :: CLIError -> ErrorCode
+cliErrorToCode = \case
+  NoDefaultConfigurationFile -> ErrorCode 156
+  NoUserProvidedConfigurationFile{} -> ErrorCode 169
+  NoDeploymentsAvailable{} -> ErrorCode 123
+  SymlinkErrors{} -> ErrorCode 192
+
+symlinkErrorToCode :: SymlinkError -> ErrorCode
+symlinkErrorToCode = \case
+  DoesNotExist{} -> ErrorCode 234
+  IsNotSymlink{} -> ErrorCode 142
+  WrongTarget{} -> ErrorCode 102
+
 reportError :: CLIError -> IO ()
 reportError NoDefaultConfigurationFile =
-  System.die "[!] Could not find configuration file at ./deployments.lua"
-reportError (NoUserProvidedConfigurationFile osPath) = do
+  System.die $ Text.unpack $ display (cliErrorToCode NoDefaultConfigurationFile) <> " Could not find configuration file at ./deployments.lua"
+reportError e@(NoUserProvidedConfigurationFile osPath) = do
   filePath <- OsPath.decodeFS osPath
-  System.die $ "[!] Could not find configuration file at" <> filePath
-reportError (NoDeploymentsAvailable os arch hostname) = do
+  System.die $ Text.unpack $ display (cliErrorToCode e) <> " Could not find configuration file at" <> Text.pack filePath
+reportError e@(NoDeploymentsAvailable os arch hostname) = do
   let message =
-        "[!] Could not find deployments to run on "
+        display (cliErrorToCode e)
+          <> " Could not find deployments to run on "
           <> display arch
           <> "-"
           <> display os
@@ -39,6 +60,23 @@ reportError (NoDeploymentsAvailable os arch hostname) = do
   System.die $ Text.unpack message
 reportError (SymlinkErrors errors) = do
   forM_ errors $
-    \e ->
-      liftIO $ Text.putStrLn $ Symlink.formatSymlinkError e
+    \err ->
+      liftIO $ Text.putStrLn $ formatSymlinkError err
   System.exitFailure
+
+formatSymlinkError :: SymlinkError -> Text
+formatSymlinkError e@(DoesNotExist path) =
+  display (symlinkErrorToCode e)
+    <> display (Text.pack . show $ path)
+    <> " does not exist"
+formatSymlinkError e@(IsNotSymlink path) =
+  display (symlinkErrorToCode e)
+    <> display (Text.pack . show $ path)
+    <> " is not a symbolic link"
+formatSymlinkError e@(WrongTarget linkPath expectedTarget actualTarget) =
+  display (symlinkErrorToCode e)
+    <> display (Text.pack . show $ linkPath)
+    <> " points to "
+    <> display (Text.pack . show $ actualTarget)
+    <> " instead of pointing to "
+    <> display (Text.pack . show $ expectedTarget)
diff --git a/src/Confer/Effect/Symlink.hs b/src/Confer/Effect/Symlink.hs
@@ -6,7 +6,6 @@ module Confer.Effect.Symlink
   , runSymlinkPure
   , Symlink (..)
   , SymlinkError (..)
-  , formatSymlinkError
   ) where
 
 import Control.Exception
@@ -140,20 +139,3 @@ runSymlinkPure virtualFS = reinterpret (State.evalState virtualFS) $ \_ -> \case
                     actualLinkTarget
                 )
       Nothing -> pure $ Left (DoesNotExist linkPath)
-
-formatSymlinkError :: SymlinkError -> Text
-formatSymlinkError (DoesNotExist path) =
-  "[!] "
-    <> display (Text.pack . show $ path)
-    <> " does not exist"
-formatSymlinkError (IsNotSymlink path) =
-  "[!] "
-    <> display (Text.pack . show $ path)
-    <> " is not a symbolic link"
-formatSymlinkError (WrongTarget linkPath expectedTarget actualTarget) =
-  "[!] "
-    <> display (Text.pack . show $ linkPath)
-    <> " points to "
-    <> display (Text.pack . show $ actualTarget)
-    <> " instead of pointing to "
-    <> display (Text.pack . show $ expectedTarget)