More

app/Main.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds         #-}
 {-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE QuasiQuotes       #-}
 
 module Main where
 
@@ -12,6 +14,7 @@ import           Data.ByteString                ( ByteString )
 import           Data.Functor                   ( (<&>) )
 import           Data.Maybe
 import           Data.Semigroup                 ( (<>) )
+import           Data.String.QQ
 import           Data.Text                      ( Text )
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
@@ -29,6 +32,7 @@ import           System.Exit
 
 
 
+
 data Options = Options
   { optVerbose :: Bool
   , optCache :: Bool
@@ -102,50 +106,64 @@ installCabalOpts = InstallCabalOptions <$> optional
 
 
 toSettings :: Options -> Settings
-toSettings Options{..} =
-  let cache = optCache
-  in Settings{..}
+toSettings Options {..} = let cache = optCache in Settings { .. }
 
 
+-- TODO: something better than Show instance for errors
+
 main :: IO ()
 main = do
-  e <-
-    customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
-      >>= \opt@Options {..} -> do
-        let settings = toSettings opt
-        -- wrapper to run effects with settings
-        let run = flip runReaderT settings . runStderrLoggingT . runE
-                @'[ FileError
-                     , ArchiveError
-                     , ProcessError
-                     , URLException
-                     , PlatformResultError
-                     , NoDownload
-                     , NoCompatibleArch
-                     , DistroNotFound
-                     , TagNotFound
-                    ]
+  -- logger interpreter
+  let runLogger = runStderrLoggingT
 
-        case optCommand of
+  customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
+    >>= \opt@Options {..} -> do
+          let settings = toSettings opt
+          -- wrapper to run effects with settings
+          let
+            runInstTool =
+              runLogger
+                . flip runReaderT settings
+                . runE
+                  @'[FileError, ArchiveError, ProcessError, URLException, PlatformResultError, NoDownload, NoCompatibleArch, DistroNotFound, TagNotFound, AlreadyInstalled]
+
+          case optCommand of
             InstallGHC (InstallGHCOptions {..}) ->
-              run
-                $ do
-                    d <- liftIO $ ghcupBaseDir
-                    case ghcVer of
-                      Just ver -> liftE $ installTool (ToolRequest GHC ver)
-                                              Nothing
-                                              (OwnSpec availableDownloads)
-                      Nothing -> do
-                        ver <-
-                          getRecommended availableDownloads GHC
-                            ?? TagNotFound Recommended GHC
-                        liftE $ installTool (ToolRequest GHC ver) Nothing (OwnSpec availableDownloads)
-            InstallCabal (InstallCabalOptions {..}) -> undefined
-
+              void
+                $ (runInstTool $ do
+                      v <- maybe
+                        (  getRecommended availableDownloads GHC
+                        ?? TagNotFound Recommended GHC
+                        )
+                        pure
+                        ghcVer
+                      liftE $ installTool (ToolRequest GHC v)
+                                          Nothing
+                                          (OwnSpec availableDownloads)
+                    )
+                >>= \case
+                      VRight _ -> pure ()
+                      VLeft (V (AlreadyInstalled treq)) ->
+                        runLogger $ $(logWarn)
+                          (T.pack (show treq) <> [s| already installed|])
+                      VLeft e -> die (color Red $ show e)
+            InstallCabal (InstallCabalOptions {..}) ->
+              void
+                $   (runInstTool $ do
+                      v <- maybe
+                        (  getRecommended availableDownloads Cabal
+                        ?? TagNotFound Recommended Cabal
+                        )
+                        pure
+                        cabalVer
+                      liftE $ installTool (ToolRequest Cabal v)
+                                          Nothing
+                                          (OwnSpec availableDownloads)
+                    )
+                >>= \case
+                      VRight _ -> pure ()
+                      VLeft (V (AlreadyInstalled treq)) ->
+                        runLogger $ $(logWarn)
+                          (T.pack (show treq) <> [s| already installed|])
+                      VLeft e -> die (color Red $ show e)
   pure ()
-
-
-  -- print error, if any
-  -- case e of
-    -- Right () -> pure ()
-    -- Left  t  -> die (color Red $ t)