13 changed files with 499 additions and 1497 deletions
--- a/TODO.md
+++ b/TODO.md
@ -4,13 +4,17 @@

 * download progress

+* Downloads from URL
+* set                Set currently active GHC version
+* list               Show available GHCs and other tools
 * upgrade            Upgrade this script in-place
-* maybe: changelog          Show the changelog of a GHC release (online)
-* maybe: print-system-reqs  Print an approximation of system requirements
+* rm                 Remove an already installed GHC
+* debug-info         Print debug info (e.g. detected system/distro)
+* changelog          Show the changelog of a GHC release (online)
+* print-system-reqs  Print an approximation of system requirements

 * testing (especially distro detection -> unit tests)

-* TODO: cleanup temp files after use

 ## Old

@ -22,6 +26,7 @@
 * check for new version on start
 * tarball tags as well as version tags?

+* --copy-compiler-tools
 * installing multiple versions in parallel?
 * how to version and extend the format of the downloads file? Compatibility?
 * how to propagate updates? Automatically? Might solve the versioning problem
--- a/app/Main.hs
+++ b/app/Main.hs
@ -0,0 +1,177 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE QuasiQuotes       #-}
+
+module Main where
+
+import           Control.Monad.Logger
+import           Control.Monad.Reader
+import           Control.Monad.IO.Class
+import           Data.Bifunctor
+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
+import           Data.Traversable
+import           Data.Versions
+import           GHCup
+import           GHCup.File
+import           GHCup.Prelude
+import           GHCup.Types
+import           Haskus.Utils.Variant.Excepts
+import           HPath
+import           Options.Applicative
+import           System.Console.Pretty
+import           System.Exit
+
+
+
+
+data Options = Options
+  { optVerbose :: Bool
+  , optCache   :: Bool
+  , optCommand :: Command
+  }
+
+data Command
+  = InstallGHC InstallGHCOptions
+  | InstallCabal InstallCabalOptions
+
+data InstallGHCOptions = InstallGHCOptions
+  { ghcVer :: Maybe Version
+  }
+
+data InstallCabalOptions = InstallCabalOptions
+  { cabalVer :: Maybe Version
+  }
+
+
+opts :: Parser Options
+opts =
+  Options
+    <$> switch
+          (short 'v' <> long "verbose" <> help "Whether to enable verbosity")
+    <*> switch (short 'c' <> long "cache" <> help "Whether to cache downloads")
+    <*> com
+
+
+com :: Parser Command
+com = subparser
+  (  command
+      "install-ghc"
+      (   InstallGHC
+      <$> (info (installGHCOpts <**> helper)
+                (progDesc "Install a GHC version")
+          )
+      )
+  <> command
+       "install-cabal"
+       (   InstallCabal
+       <$> (info (installCabalOpts <**> helper)
+                 (progDesc "Install a cabal-install version")
+           )
+       )
+  )
+
+installGHCOpts :: Parser InstallGHCOptions
+installGHCOpts = InstallGHCOptions <$> optional
+  (option
+    (eitherReader
+      (\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
+    )
+    (short 'v' <> long "version" <> metavar "VERSION" <> help
+      "The GHC version to install"
+    )
+  )
+
+
+installCabalOpts :: Parser InstallCabalOptions
+installCabalOpts = InstallCabalOptions <$> optional
+  (option
+    (eitherReader
+      (\s -> bimap (const "Not a valid version") id . version . T.pack $ s)
+    )
+    (short 'v' <> long "version" <> metavar "VERSION" <> help
+      "The Cabal version to install"
+    )
+  )
+
+
+toSettings :: Options -> Settings
+toSettings Options {..} = let cache = optCache in Settings { .. }
+
+
+-- TODO: something better than Show instance for errors
+
+main :: IO ()
+main = do
+  -- logger interpreter
+  let runLogger = runStderrLoggingT
+
+  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
+                      , NotInstalled
+                      ]
+
+          case optCommand of
+            InstallGHC (InstallGHCOptions {..}) ->
+              void
+                $   (runInstTool $ do
+                      v <- maybe
+                        (  getRecommended availableDownloads GHC
+                        ?? TagNotFound Recommended GHC
+                        )
+                        pure
+                        ghcVer
+                      liftE $ installTool (ToolRequest GHC v)
+                                          Nothing
+                                          (OwnSpec availableDownloads)
+                    )
+                >>= \case
+                      VRight _ -> runLogger $ $(logInfo) ([s|GHC installation successful|])
+                      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 _ -> runLogger $ $(logInfo) ([s|Cabal installation successful|])
+                      VLeft (V (AlreadyInstalled treq)) ->
+                        runLogger $ $(logWarn)
+                          (T.pack (show treq) <> [s| already installed|])
+                      VLeft e -> die (color Red $ show e)
+  pure ()
--- a/app/ghcup-gen/AvailableDownloads.hs
+++ b/app/ghcup-gen/AvailableDownloads.hs
@ -1,127 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-
-
-module AvailableDownloads where
-
-import qualified Data.Map                      as M
-import           GHCup.Prelude
-import           GHCup.Types
-import           HPath
-import           URI.ByteString.QQ
-
-
-
-- TODO: version quasiquoter
-availableDownloads :: AvailableDownloads
-availableDownloads = M.fromList
-  [ ( GHC
-    , M.fromList
-      [ ( [vver|8.6.5|]
-        , VersionInfo [Latest] $ M.fromList
-          [ ( A_64
-            , M.fromList
-              [ ( Linux UnknownLinux
-                , M.fromList
-                  [ ( Nothing
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-fedora27-linux.tar.xz|]
-                      (Just ([rel|ghc-8.6.5|] :: Path Rel))
-                    )
-                  ]
-                )
-              , ( Linux Ubuntu
-                , M.fromList
-                  [ ( Nothing
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-deb9-linux.tar.xz|]
-                      (Just ([rel|ghc-8.6.5|] :: Path Rel))
-                    )
-                  ]
-                )
-              , ( Linux Debian
-                , M.fromList
-                  [ ( Nothing
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian9-linux.tar.xz|]
-                      (Just ([rel|ghc-8.6.5|] :: Path Rel))
-                    )
-                  , ( Just $ [vers|8|]
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian8-linux.tar.xz|]
-                      (Just ([rel|ghc-8.6.5|] :: Path Rel))
-                    )
-                  ]
-                )
-              ]
-            )
-          ]
-        ),
-        ( [vver|8.4.4|]
-        , VersionInfo [Latest] $ M.fromList
-          [ ( A_64
-            , M.fromList
-              [ ( Linux UnknownLinux
-                , M.fromList
-                  [ ( Nothing
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-fedora27-linux.tar.xz|]
-                      (Just ([rel|ghc-8.4.4|] :: Path Rel))
-                    )
-                  ]
-                )
-              , ( Linux Ubuntu
-                , M.fromList
-                  [ ( Nothing
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.4.4/ghc-8.4.4-x86_64-deb9-linux.tar.xz|]
-                      (Just ([rel|ghc-8.4.4|] :: Path Rel))
-                    )
-                  ]
-                )
-              , ( Linux Debian
-                , M.fromList
-                  [ ( Nothing
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian9-linux.tar.xz|]
-                      (Just ([rel|ghc-8.6.5|] :: Path Rel))
-                    )
-                  , ( Just $ [vers|8|]
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~ghc/8.6.5/ghc-8.6.5-x86_64-debian8-linux.tar.xz|]
-                      (Just ([rel|ghc-8.6.5|] :: Path Rel))
-                    )
-                  ]
-                )
-              ]
-            )
-          ]
-        )
-      ]
-    )
-  , ( Cabal
-    , M.fromList
-      [ ( [vver|3.0.0.0|]
-        , VersionInfo [Recommended, Latest] $ M.fromList
-          [ ( A_64
-            , M.fromList
-              [ ( Linux UnknownLinux
-                , M.fromList
-                  [ ( Nothing
-                    , DownloadInfo
-                      [uri|https://downloads.haskell.org/~cabal/cabal-install-3.0.0.0/cabal-install-3.0.0.0-x86_64-unknown-linux.tar.xz|]
-                      Nothing
-                    )
-                  ]
-                )
-              ]
-            )
-          ]
-        )
-      ]
-    )
-  ]
--- a/app/ghcup-gen/Main.hs
+++ b/app/ghcup-gen/Main.hs
@ -1,143 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-
-
-module Main where
-
-import           AvailableDownloads
-import           Data.Aeson                     ( eitherDecode )
-import           Data.Aeson.Encode.Pretty
-import qualified Data.ByteString.Lazy          as L
-import           Data.Semigroup                 ( (<>) )
-import           GHCup.Types.JSON               ( )
-import           Options.Applicative     hiding ( style )
-import           GHCup.Logger
-import           System.Console.Pretty
-import           System.Exit
-import           System.IO                      ( stdout )
-import           Validate
-
-
-
-data Options = Options
-  { optCommand :: Command
-  }
-
-data Command = GenJSON GenJSONOpts
-             | ValidateJSON ValidateJSONOpts
-
-data Output
-  = FileOutput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
-  | StdOutput
-
-fileOutput :: Parser Output
-fileOutput =
-  FileOutput
-    <$> (strOption
-          (long "file" <> short 'f' <> metavar "FILENAME" <> help
-            "Output to a file"
-          )
-        )
-
-stdOutput :: Parser Output
-stdOutput = flag'
-  StdOutput
-  (short 'o' <> long "stdout" <> help "Print to stdout (default)")
-
-outputP :: Parser Output
-outputP = fileOutput <|> stdOutput
-
-
-data GenJSONOpts = GenJSONOpts
-  { output :: Maybe Output
-  }
-
-genJSONOpts :: Parser GenJSONOpts
-genJSONOpts = GenJSONOpts <$> optional outputP
-
-
-data Input
-  = FileInput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
-  | StdInput
-
-fileInput :: Parser Input
-fileInput =
-  FileInput
-    <$> (strOption
-          (long "file" <> short 'f' <> metavar "FILENAME" <> help
-            "Input file to validate"
-          )
-        )
-
-stdInput :: Parser Input
-stdInput = flag'
-  StdInput
-  (short 'i' <> long "stdin" <> help "Validate from stdin (default)")
-
-inputP :: Parser Input
-inputP = fileInput <|> stdInput
-
-data ValidateJSONOpts = ValidateJSONOpts
-  { input :: Maybe Input
-  }
-
-validateJSONOpts :: Parser ValidateJSONOpts
-validateJSONOpts = ValidateJSONOpts <$> optional inputP
-
-opts :: Parser Options
-opts = Options <$> com
-
-com :: Parser Command
-com = subparser
-  (  (command
-       "gen"
-       (   GenJSON
-       <$> (info (genJSONOpts <**> helper)
-                 (progDesc "Generate the json downloads file")
-           )
-       )
-     )
-  <> (command
-       "check"
-       (   ValidateJSON
-       <$> (info (validateJSONOpts <**> helper)
-                 (progDesc "Generate the json downloads file")
-           )
-       )
-     )
-  )
-
-
-
-main :: IO ()
-main = do
-  customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
-    >>= \Options {..} -> case optCommand of
-          GenJSON gopts -> do
-            let
-              bs = encodePretty' (defConfig { confIndent = Spaces 2 })
-                                 availableDownloads
-            case gopts of
-              GenJSONOpts { output = Nothing }        -> L.hPutStr stdout bs
-              GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs
-              GenJSONOpts { output = Just (FileOutput file) } ->
-                L.writeFile file bs
-          ValidateJSON vopts -> case vopts of
-            ValidateJSONOpts { input = Nothing } ->
-              L.getContents >>= valAndExit
-            ValidateJSONOpts { input = Just StdInput } ->
-              L.getContents >>= valAndExit
-            ValidateJSONOpts { input = Just (FileInput file) } ->
-              L.readFile file >>= valAndExit
-  pure ()
-
- where
-  valAndExit contents = do
-    av <- case eitherDecode contents of
-      Right r -> pure r
-      Left  e -> die (color Red $ show e)
-    myLoggerTStdout (validate av) >>= exitWith
--- a/app/ghcup-gen/Validate.hs
+++ b/app/ghcup-gen/Validate.hs
@ -1,95 +0,0 @@
-{-# LANGUAGE TemplateHaskell  #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE QuasiQuotes      #-}
-
-module Validate where
-
-import           GHCup
-import           GHCup.Types
-
-import           Control.Monad
-import           Control.Exception.Safe
-import           Control.Monad.Reader.Class
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Class      ( lift )
-import           Control.Monad.Trans.Reader     ( runReaderT )
-import           Data.List
-import           Data.String.Interpolate
-import           Data.Versions
-import           Data.IORef
-import           System.Exit
-import           Control.Monad.Logger
-
-import qualified Data.Map.Strict               as M
-
-
-- TODO: improve logging
-
-
-data ValidationError = InternalError String
-  deriving Show
-
-instance Exception ValidationError
-
-
-- TODO: test that GHC is in semver
-validate :: (Monad m, MonadLogger m, MonadThrow m, MonadIO m)
-         => AvailableDownloads
-         -> m ExitCode
-validate av = do
-  ref <- liftIO $ newIORef 0
-  flip runReaderT ref $ do
-    -- unique tags
-    forM_ (M.toList av) $ \(t, _) -> checkUniqueTags t
-
-    -- required platforms
-    forM_ (M.toList av) $ \(t, versions) ->
-      forM_ (M.toList versions) $ \(v, vi) ->
-        forM_ (M.toList $ _viArch vi) $ \(arch, pspecs) -> do
-          checkHasRequiredPlatforms t v arch (M.keys pspecs)
-
-    -- exit
-    e <- liftIO $ readIORef ref
-    if e > 0 then pure $ ExitFailure e else pure ExitSuccess
- where
-  checkHasRequiredPlatforms t v arch pspecs = do
-    let v' = prettyVer v
-    when (not $ any (== Linux UnknownLinux) pspecs) $ do
-      lift $ $(logError)
-        [i|Linux UnknownLinux missing for for #{t} #{v'} #{arch}|]
-      addError
-    when (not $ any (== Darwin) pspecs) $ do
-      lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch}|]
-      addError
-    when (not $ any (== FreeBSD) pspecs) $ lift $ $(logWarn)
-      [i|FreeBSD missing for #{t} #{v'} #{arch}|]
-
-  checkUniqueTags tool = do
-    let allTags = join $ fmap snd $ availableToolVersions av tool
-    let nonUnique =
-          fmap fst
-            .   filter (\(_, b) -> not b)
-            <$> ( mapM
-                    (\case
-                      [] -> throwM $ InternalError "empty inner list"
-                      (t : ts) ->
-                        pure $ (t, ) $ if isUniqueTag t then ts == [] else True
-                    )
-                . group
-                . sort
-                $ allTags
-                )
-    case join nonUnique of
-      [] -> pure ()
-      xs -> do
-        lift $ $(logError) [i|Tags not unique: #{xs}|]
-        addError
-   where
-    isUniqueTag Latest      = True
-    isUniqueTag Recommended = True
-
-
-addError :: (MonadReader (IORef Int) m, MonadIO m, Monad m) => m ()
-addError = do
-  ref <- ask
-  liftIO $ modifyIORef ref (+ 1)
--- a/app/ghcup/Main.hs
+++ b/app/ghcup/Main.hs
@ -1,404 +0,0 @@
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-
-
-module Main where
-
-import           Control.Monad.Logger
-import           Control.Monad.Reader
-import           Data.Bifunctor
-import qualified Data.ByteString.UTF8          as UTF8
-import           Data.Char
-import           Data.List                      ( intercalate )
-import           Data.Semigroup                 ( (<>) )
-import           Data.String.QQ
-import qualified Data.Text                     as T
-import           Data.Versions
-import           GHCup
-import           GHCup.Logger
-import           GHCup.File
-import           GHCup.Prelude
-import           GHCup.Types
-import           Haskus.Utils.Variant.Excepts
-import           Options.Applicative     hiding ( style )
-import           System.Console.Pretty
-import           System.Exit
-import           URI.ByteString
-import           Text.Layout.Table
-import           Data.String.Interpolate
-
-
-
-
-
-data Options = Options
-  { optVerbose   :: Bool
-  , optCache     :: Bool
-  , optUrlSource :: Maybe URI
-  , optCommand   :: Command
-  }
-
-data Command
-  = InstallGHC InstallGHCOptions
-  | InstallCabal InstallCabalOptions
-  | SetGHC SetGHCOptions
-  | List ListOptions
-  | Rm RmOptions
-  | DInfo
-
-data ToolVersion = ToolVersion Version
-                 | ToolTag Tag
-
-
-data InstallGHCOptions = InstallGHCOptions
-  { ghcVer :: Maybe ToolVersion
-  }
-
-data InstallCabalOptions = InstallCabalOptions
-  { cabalVer :: Maybe ToolVersion
-  }
-
-data SetGHCOptions = SetGHCOptions
-  { ghcVer :: Maybe ToolVersion
-  }
-
-data ListOptions = ListOptions
-  { lTool     :: Maybe Tool
-  , lCriteria :: Maybe ListCriteria
-  }
-
-data RmOptions = RmOptions
-  { ghcVer :: Version
-  }
-
-
-opts :: Parser Options
-opts =
-  Options
-    <$> switch
-          (short 'v' <> long "verbose" <> help
-            "Whether to enable verbosity (default: False)"
-          )
-    <*> switch
-          (short 'c' <> long "cache" <> help
-            "Whether to cache downloads (default: False)"
-          )
-    <*> (optional
-          (option
-            (eitherReader parseUri)
-            (short 's' <> long "url-source" <> metavar "URL" <> help
-              "Alternative ghcup download info url (default: internal)"
-            )
-          )
-        )
-    <*> com
- where
-  parseUri s' =
-    bimap show id $ parseURI strictURIParserOptions (UTF8.fromString s')
-
-com :: Parser Command
-com = subparser
-  (  command
-      "install-ghc"
-      (   InstallGHC
-      <$> (info (installGHCOpts <**> helper)
-                (progDesc "Install a GHC version")
-          )
-      )
-  <> command
-       "install-cabal"
-       (   InstallCabal
-       <$> (info (installCabalOpts <**> helper)
-                 (progDesc "Install a cabal-install version")
-           )
-       )
-  <> command
-       "set-ghc"
-       (   SetGHC
-       <$> (info (setGHCOpts <**> helper)
-                 (progDesc "Set the currently active GHC version")
-           )
-       )
-  <> command
-       "list"
-       (   List
-       <$> (info (listOpts <**> helper)
-                 (progDesc "Show available GHCs and other tools")
-           )
-       )
-  <> command
-       "rm"
-       (   Rm
-       <$> (info (rmOpts <**> helper)
-                 (progDesc "Remove a GHC version installed by ghcup")
-           )
-       )
-  <> command
-       "debug-info"
-       ((\_ -> DInfo) <$> (info (helper) (progDesc "Show debug info")))
-  )
-
-installGHCOpts :: Parser InstallGHCOptions
-installGHCOpts = InstallGHCOptions <$> optional toolVersionParser
-
-
-installCabalOpts :: Parser InstallCabalOptions
-installCabalOpts = InstallCabalOptions <$> optional toolVersionParser
-
-setGHCOpts :: Parser SetGHCOptions
-setGHCOpts = SetGHCOptions <$> optional toolVersionParser
-
-listOpts :: Parser ListOptions
-listOpts =
-  ListOptions
-    <$> optional
-          (option
-            (eitherReader toolParser)
-            (short 't' <> long "tool" <> metavar "<ghc|cabal>" <> help
-              "Tool to list versions for. Default is all"
-            )
-          )
-    <*> (optional
-          (option
-            (eitherReader criteriaParser)
-            (  short 'c'
-            <> long "show-criteria"
-            <> metavar "<installed|set>"
-            <> help "Show only installed or set tool versions"
-            )
-          )
-        )
-
-rmOpts :: Parser RmOptions
-rmOpts =
-  RmOptions
-    <$> (option
-          (eitherReader
-            (bimap (const "Not a valid version") id . version . T.pack)
-          )
-          (short 'v' <> long "version" <> metavar "VERSION" <> help
-            "The GHC version to remove"
-          )
-        )
-
-
-
-versionParser :: Parser Version
-versionParser = option
-  (eitherReader (bimap (const "Not a valid version") id . version . T.pack))
-  (short 'v' <> long "version" <> metavar "VERSION")
-
-
-toolVersionParser :: Parser ToolVersion
-toolVersionParser = verP <|> toolP
- where
-  verP = ToolVersion <$> versionParser
-  toolP =
-    ToolTag
-      <$> (option
-            (eitherReader
-              (\s' -> case fmap toLower s' of
-                "recommended" -> Right Recommended
-                "latest"      -> Right Latest
-                other         -> Left ([i|Unknown tag #{other}|])
-              )
-            )
-            (short 't' <> long "tag" <> metavar "TAG")
-          )
-
-
-toolParser :: String -> Either String Tool
-toolParser s' | t == T.pack "ghc"   = Right GHC
-              | t == T.pack "cabal" = Right Cabal
-              | otherwise           = Left ("Unknown tool: " <> s')
-  where t = T.toLower (T.pack s')
-
-
-criteriaParser :: String -> Either String ListCriteria
-criteriaParser s' | t == T.pack "installed" = Right ListInstalled
-                  | t == T.pack "set"       = Right ListSet
-                  | otherwise               = Left ("Unknown criteria: " <> s')
-  where t = T.toLower (T.pack s')
-
-
-toSettings :: Options -> Settings
-toSettings Options {..} =
-  let cache     = optCache
-      urlSource = maybe GHCupURL OwnSource optUrlSource
-  in  Settings { .. }
-
-
-- TODO: something better than Show instance for errors
-
-main :: IO ()
-main = do
-  -- logger interpreter
-  let runLogger = myLoggerTStderr
-
-  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
-                    @'[ AlreadyInstalled
-                      , ArchiveError
-                      , DistroNotFound
-                      , FileDoesNotExistError
-                      , FileError
-                      , JSONError
-                      , NoCompatibleArch
-                      , NoDownload
-                      , NotInstalled
-                      , PlatformResultError
-                      , ProcessError
-                      , TagNotFound
-                      , URLException
-                      ]
-
-          let runSetGHC =
-                runLogger
-                  . flip runReaderT settings
-                  . runE
-                    @'[ FileDoesNotExistError
-                      , NotInstalled
-                      , TagNotFound
-                      , URLException
-                      , JSONError
-                      , TagNotFound
-                      ]
-
-          let runListGHC =
-                runLogger
-                  . flip runReaderT settings
-                  . runE @'[FileDoesNotExistError , URLException , JSONError]
-
-          let runRmGHC =
-                runLogger . flip runReaderT settings . runE @'[NotInstalled]
-
-          let runDebugInfo =
-                runLogger
-                  . flip runReaderT settings
-                  . runE
-                    @'[PlatformResultError , NoCompatibleArch , DistroNotFound]
-
-          case optCommand of
-            InstallGHC (InstallGHCOptions {..}) ->
-              void
-                $   (runInstTool $ do
-                      av <- liftE getDownloads
-                      v  <- liftE $ fromVersion av ghcVer GHC
-                      liftE $ installTool (ToolRequest GHC v) Nothing
-                    )
-                >>= \case
-                      VRight _ -> runLogger
-                        $ $(logInfo) ([s|GHC installation successful|])
-                      VLeft (V (AlreadyInstalled treq)) ->
-                        runLogger $ $(logWarn)
-                          (T.pack (show treq) <> [s| already installed|])
-                      VLeft e ->
-                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
-            InstallCabal (InstallCabalOptions {..}) ->
-              void
-                $   (runInstTool $ do
-                      av <- liftE getDownloads
-                      v  <- liftE $ fromVersion av cabalVer Cabal
-                      liftE $ installTool (ToolRequest Cabal v) Nothing
-                    )
-                >>= \case
-                      VRight _ -> runLogger
-                        $ $(logInfo) ([s|Cabal installation successful|])
-                      VLeft (V (AlreadyInstalled treq)) ->
-                        runLogger $ $(logWarn)
-                          (T.pack (show treq) <> [s| already installed|])
-                      VLeft e ->
-                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
-
-            SetGHC (SetGHCOptions {..}) ->
-              void
-                $   (runSetGHC $ do
-                      av <- liftE getDownloads
-                      v  <- liftE $ fromVersion av ghcVer GHC
-                      liftE $ setGHC v SetGHCOnly
-                    )
-                >>= \case
-                      VRight _ ->
-                        runLogger $ $(logInfo) ([s|GHC successfully set|])
-                      VLeft e ->
-                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
-
-            List (ListOptions {..}) ->
-              void
-                $   (runListGHC $ do
-                      liftE $ listVersions lTool lCriteria
-                    )
-                >>= \case
-                      VRight r -> liftIO $ printListResult r
-                      VLeft e ->
-                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
-
-            Rm (RmOptions {..}) ->
-              void
-                $   (runRmGHC $ do
-                      liftE $ rmGHCVer ghcVer
-                    )
-                >>= \case
-                      VRight _ -> pure ()
-                      VLeft e ->
-                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
-
-            DInfo -> do
-              void
-                $   (runDebugInfo $ do
-                      liftE $ getDebugInfo
-                    )
-                >>= \case
-                      VRight dinfo -> putStrLn $ show dinfo
-                      VLeft e ->
-                        runLogger ($(logError) [i|#{e}|]) >> exitFailure
-  pure ()
-
-
-fromVersion :: Monad m
-            => AvailableDownloads
-            -> Maybe ToolVersion
-            -> Tool
-            -> Excepts '[TagNotFound] m Version
-fromVersion av Nothing tool =
-  getRecommended av tool ?? TagNotFound Recommended tool
-fromVersion _ (Just (ToolVersion v)) _ = pure v
-fromVersion av (Just (ToolTag Latest)) tool =
-  getLatest av tool ?? TagNotFound Latest tool
-fromVersion av (Just (ToolTag Recommended)) tool =
-  getRecommended av tool ?? TagNotFound Recommended tool
-
-
-printListResult :: [ListResult] -> IO ()
-printListResult lr = do
-  let
-    formatted =
-      gridString
-          [ column expand left def def
-          , column expand left def def
-          , column expand left def def
-          , column expand left def def
-          ]
-        $ fmap
-            (\ListResult {..} ->
-              [ if
-                | lSet       -> (color Green "✔✔")
-                | lInstalled -> (color Green "✓")
-                | otherwise  -> (color Red "✗")
-              , fmap toLower . show $ lTool
-              , T.unpack . prettyVer $ lVer
-              , intercalate "," $ ((fmap . fmap) toLower . fmap show $ lTag)
-              ]
-            )
-            lr
-  putStrLn $ formatted
--- a/ghcup.cabal
+++ b/ghcup.cabal
@ -22,8 +22,6 @@ source-repository head

 common HsOpenSSL { build-depends: HsOpenSSL >= 0.11 }
 common aeson { build-depends: aeson >= 1.4 }
-common aeson-pretty { build-depends: aeson-pretty >= 0.8.8 }
-common attoparsec { build-depends: attoparsec >= 0.13 }
 common ascii-string { build-depends: ascii-string >= 1.0 }
 common async { build-depends: async >= 0.8 }
 common base { build-depends: base >= 4.12 && < 5 }
@ -32,7 +30,6 @@ common bzlib { build-depends: bzlib >= 0.5.0.5 }
 common containers { build-depends: containers >= 0.6 }
 common generics-sop { build-depends: generics-sop >= 0.5 }
 common haskus-utils-variant { build-depends: haskus-utils-variant >= 3.0 }
-common haskus-utils-types { build-depends: haskus-utils-types >= 1.5 }
 common hpath { build-depends: hpath >= 0.11 }
 common hpath-directory { build-depends: hpath-directory >= 0.13.2 }
 common hpath-filepath { build-depends: hpath-filepath >= 0.10.3 }
@ -49,14 +46,11 @@ common optics-vl { build-depends: optics-vl >= 0.2 }
 common optparse-applicative { build-depends: optparse-applicative >= 0.15.1.0 }
 common parsec { build-depends: parsec >= 3.1 }
 common pretty-terminal { build-depends: pretty-terminal >= 0.1.0.0 }
-common safe { build-depends: safe >= 0.3.18 }
 common safe-exceptions { build-depends: safe-exceptions >= 0.1 }
 common streamly { build-depends: streamly >= 0.7 }
 common streamly-bytestring { build-depends: streamly-bytestring >= 0.1.2 }
 common strict-base { build-depends: strict-base >= 0.4 }
 common string-qq { build-depends: string-qq >= 0.0.4 }
-common string-interpolate { build-depends: string-interpolate >= 0.2.0.0 }
-common table-layout { build-depends: table-layout >= 0.8 }
 common tar-bytestring { build-depends: tar-bytestring >= 0.6.2.0 }
 common template-haskell { build-depends: template-haskell >= 2.7 }
 common text { build-depends: text >= 1.2 }
@ -93,13 +87,11 @@ library
                     , aeson
                     , ascii-string
                     , async
-                     , attoparsec
                     , bytestring
                     , bzlib
                     , containers
                     , generics-sop
                     , haskus-utils-variant
-                     , haskus-utils-types
                     , hpath
                     , hpath-directory
                     , hpath-filepath
@ -114,14 +106,11 @@ library
                     , optics
                     , optics-vl
                     , parsec
-                     , pretty-terminal
-                     , safe
                     , safe-exceptions
                     , streamly
                     , streamly-bytestring
                     , strict-base
                     , string-qq
-                     , string-interpolate
                     , tar-bytestring
                     , template-haskell
                     , text
@ -138,7 +127,6 @@ library
  exposed-modules:     GHCup
                       GHCup.Bash
                       GHCup.File
-                       GHCup.Logger
                       GHCup.Prelude
                       GHCup.Types
                       GHCup.Types.JSON
@ -150,9 +138,7 @@ library
 executable ghcup
  import:                config
                       , base
-                       --
                       , bytestring
-                       , containers
                       , haskus-utils-variant
                       , monad-logger
                       , mtl
@ -162,47 +148,11 @@ executable ghcup
                       , hpath
                       , pretty-terminal
                       , string-qq
-                       , string-interpolate
-                       , table-layout
-                       , uri-bytestring
-                       , utf8-string
  main-is:             Main.hs
  -- other-modules:
  -- other-extensions:
  build-depends:       ghcup
-  hs-source-dirs:      app/ghcup
-  default-language:    Haskell2010
-
-executable ghcup-gen
-  import:                config
-                       , base
-                       --
-                       , aeson
-                       , aeson-pretty
-                       , bytestring
-                       , containers
-                       , safe-exceptions
-                       , haskus-utils-variant
-                       , monad-logger
-                       , mtl
-                       , optics
-                       , optparse-applicative
-                       , text
-                       , versions
-                       , hpath
-                       , pretty-terminal
-                       , string-qq
-                       , string-interpolate
-                       , table-layout
-                       , transformers
-                       , uri-bytestring
-                       , utf8-string
-  main-is:             Main.hs
-  other-modules:       AvailableDownloads
-                       Validate
-  -- other-extensions:
-  build-depends:       ghcup
-  hs-source-dirs:      app/ghcup-gen
+  hs-source-dirs:      app
  default-language:    Haskell2010

 test-suite ghcup-test
--- a/lib/GHCup.hs
+++ b/lib/GHCup.hs
--- a/lib/GHCup/File.hs
+++ b/lib/GHCup/File.hs
@ -19,6 +19,7 @@ import           Data.Foldable
 import           Control.Monad
 import           Control.Exception.Safe
 import           Data.Functor
+import           System.Posix.Files.ByteString
 import           System.Posix.Foreign           ( oExcl )
 import           System.Posix.Env.ByteString
 import           System.IO
@ -39,6 +40,12 @@ import qualified Streamly.FileSystem.Handle    as FH
 import qualified Streamly.Internal.Data.Unfold as SU
 import qualified Streamly.Prelude              as S
 import           System.Exit
+import qualified Streamly.Data.Fold            as FL
+import           Data.ByteString.Builder
+import           Foreign.C.Error
+import           GHCup.Prelude
+import           Control.Concurrent.Async
+import           Control.Concurrent
 import           System.Posix.FD               as FD
 import qualified Data.ByteString.UTF8          as UTF8
 import           Data.ByteString.Unsafe         ( unsafeUseAsCStringLen )
@ -54,12 +61,11 @@ data ProcessError = NonZeroExit Int ByteString [ByteString]
                  deriving Show


-data CapturedProcess = CapturedProcess
-  { _exitCode :: ExitCode
+data CapturedProcess = CapturedProcess {
+    _exitCode :: ExitCode
  , _stdOut   :: ByteString
  , _stdErr   :: ByteString
-  }
-  deriving (Eq, Show)
+} deriving (Eq, Show)

 makeLenses ''CapturedProcess

@ -95,7 +101,7 @@ findExecutable ex = do
  -- figure out if a file exists, then treat it as a negative result.
  asum $ fmap (handleIO (\_ -> pure Nothing)) $ fmap
    -- asum for short-circuiting behavior
-    (\s' -> (isExecutable (s' </> ex) >>= guard) $> (Just (s' </> ex)))
+    (\s -> (isExecutable (s </> ex) >>= guard) $> (Just (s </> ex)))
    sPaths


@ -105,9 +111,10 @@ executeOut :: Path b          -- ^ command as filename, e.g. 'ls'
           -> [ByteString]      -- ^ arguments to the command
           -> Maybe (Path Abs)  -- ^ chdir to this path
           -> IO CapturedProcess
-executeOut path args chdir = captureOutStreams $ do
-  maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
-  SPPB.executeFile (toFilePath path) True args Nothing
+executeOut path args chdir =
+  captureOutStreams $ do
+   maybe (pure ()) (changeWorkingDirectory . toFilePath) chdir
+   SPPB.executeFile (toFilePath path) True args Nothing


 -- | Capture the stdout and stderr of the given action, which
@ -143,9 +150,9 @@ captureOutStreams action =
          stdout' <- L.toStrict <$> readFd parentStdoutRead
          stderr' <- L.toStrict <$> readFd parentStderrRead
          pure $ CapturedProcess { _exitCode = es
-                                 , _stdOut   = stdout'
-                                 , _stdErr   = stderr'
-                                 }
+                                        , _stdOut   = stdout'
+                                        , _stdErr   = stderr'
+                                        }
        _ -> throwIO $ userError $ ("No such PID " ++ show pid)

 where
--- a/lib/GHCup/Logger.hs
+++ b/lib/GHCup/Logger.hs
@ -1,30 +0,0 @@
-module GHCup.Logger where
-
-
-import           System.Console.Pretty
-import           System.IO
-import           Control.Monad.Logger
-
-import qualified Data.ByteString as B
-
-
-myLoggerT :: (B.ByteString -> IO ()) -> LoggingT m a -> m a
-myLoggerT outter loggingt = runLoggingT loggingt mylogger
- where
-  mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
-  mylogger _ _ level str' = do
-    let l = case level of
-          LevelDebug   -> toLogStr (style Bold $ color Blue   "[ Debug ]")
-          LevelInfo    -> toLogStr (style Bold $ color Green  "[ Info  ]")
-          LevelWarn    -> toLogStr (style Bold $ color Yellow "[ Warn  ]")
-          LevelError   -> toLogStr (style Bold $ color Red    "[ Error ]")
-          LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
-    let out = fromLogStr (l <>  toLogStr " " <> str' <> toLogStr "\n")
-    outter out
-
-myLoggerTStdout :: LoggingT m a -> m a
-myLoggerTStdout = myLoggerT (B.hPut stdout)
-
-myLoggerTStderr :: LoggingT m a -> m a
-myLoggerTStderr = myLoggerT (B.hPut stderr)
-
--- a/lib/GHCup/Prelude.hs
+++ b/lib/GHCup/Prelude.hs
@ -15,25 +15,18 @@ module GHCup.Prelude where

 import           Control.Applicative
 import           Control.Monad
-import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class      ( lift )
 import           Control.Exception.Safe
-import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
 import qualified Data.Strict.Maybe             as S
 import           Data.Monoid                    ( (<>) )
 import           Data.String
-
-import qualified Data.Text.Lazy.Builder        as B
-import qualified Data.Text.Lazy.Builder.Int    as B
 import qualified Data.Text.Lazy.Encoding       as TLE
 import qualified Data.Text.Lazy                as TL
 import           Data.Text                      ( Text )
-import qualified Data.Text.Encoding            as E
 import qualified Data.Text                     as T
 import           Data.Versions
 import qualified Data.ByteString.Lazy          as L
-import           Haskus.Utils.Types.List
 import           Haskus.Utils.Variant.Excepts
 import           System.IO.Error
 import           Language.Haskell.TH
@ -101,14 +94,9 @@ lBS2sT :: L.ByteString -> Text
 lBS2sT = TL.toStrict . TLE.decodeUtf8


-
-handleIO' :: (MonadIO m, MonadCatch m)
-          => IOErrorType
-          -> (IOException -> m a)
-          -> m a
-          -> m a
-handleIO' err handler = handleIO
-  (\e -> if err == ioeGetErrorType e then handler e else liftIO $ ioError e)
+handleIO' :: IOErrorType -> (IOException -> IO ()) -> IO () -> IO ()
+handleIO' err handler =
+  handleIO (\e -> if err == ioeGetErrorType e then handler e else ioError e)


 (??) :: forall e es a m . (Monad m, e :< es) => Maybe a -> e -> Excepts es m a
@ -126,60 +114,20 @@ handleIO' err handler = handleIO
 lE :: forall e es a m . (Monad m, e :< es) => Either e a -> Excepts es m a
 lE = liftE . veitherToExcepts . fromEither

-lE' :: forall e' e es a m
-     . (Monad m, e :< es)
-    => (e' -> e)
-    -> Either e' a
-    -> Excepts es m a
-lE' f = liftE . veitherToExcepts . fromEither . bimap f id
-
 lEM :: forall e es a m . (Monad m, e :< es) => m (Either e a) -> Excepts es m a
 lEM em = lift em >>= lE

-lEM' :: forall e' e es a m
-      . (Monad m, e :< es)
-     => (e' -> e)
-     -> m (Either e' a)
-     -> Excepts es m a
-lEM' f em = lift em >>= lE . bimap f id
-
 fromEither :: Either a b -> VEither '[a] b
 fromEither = either (VLeft . V) VRight

-
-liftException :: ( MonadCatch m
-                 , MonadIO m
-                 , Monad m
-                 , e :< es'
-                 , LiftVariant es es'
-                 )
-              => IOErrorType
-              -> e
-              -> Excepts es m a
-              -> Excepts es' m a
-liftException errType ex =
-  handleIO
-      (\e ->
-        if errType == ioeGetErrorType e then throwE ex else liftIO $ ioError e
-      )
-    . liftE
-
-
-- TODO: does this work?
 hideExcept :: forall e es es' a m
            . (Monad m, e :< es, LiftVariant (Remove e es) es')
           => e
           -> a
           -> Excepts es m a
           -> Excepts es' m a
-hideExcept _ a action =
-  catchLiftLeft ((\_ -> pure a) :: (e -> Excepts es' m a)) action
-
-
-throwEither :: (Exception a, MonadThrow m) => Either a b -> m b
-throwEither a = case a of
-  Left  e -> throwM e
-  Right r -> pure r
+hideExcept h a action =
+  catchLiftLeft ((\(x@e) -> pure a) :: (e -> Excepts es' m a)) action



@ -204,8 +152,8 @@ qq quoteExp' = QuasiQuoter
    "illegal QuasiQuote (allowed as expression only, used as a declaration)"
  }

-vver :: QuasiQuoter
-vver = qq mkV
+ver :: QuasiQuoter
+ver = qq mkV
 where
  mkV :: Text -> Q Exp
  mkV = either (fail . show) TH.lift . version
@ -233,12 +181,3 @@ pver = qq mkV
 where
  mkV :: Text -> Q Exp
  mkV = either (fail . show) TH.lift . pvp
-
-
-verToBS :: Version -> ByteString
-verToBS = E.encodeUtf8 . prettyVer
-
-
-
-intToText :: Integral a => a -> T.Text
-intToText = TL.toStrict . B.toLazyText . B.decimal
--- a/lib/GHCup/Types.hs
+++ b/lib/GHCup/Types.hs
@ -9,27 +9,15 @@ import           Data.Versions
 import           URI.ByteString


-data DebugInfo = DebugInfo
-  { diBaseDir   :: Path Abs
-  , diBinDir    :: Path Abs
-  , diGHCDir    :: Path Abs
-  , diCacheDir  :: Path Abs
-  , diURLSource :: URLSource
-  , diArch      :: Architecture
-  , diPlatform  :: PlatformResult
-  }
-  deriving Show
-
-
 data SetGHC = SetGHCOnly  -- ^ unversioned 'ghc'
            | SetGHCMajor -- ^ ghc-x.y
-            | SetGHCMinor -- ^ ghc-x.y.z -- TODO: rename
+            | SetGHCMinor -- ^ ghc-x.y.z
            deriving Show


 data Tag = Latest
         | Recommended
-         deriving (Ord, Eq, Show)
+         deriving (Eq, Show)

 data VersionInfo = VersionInfo
  { _viTags :: [Tag]
@ -45,12 +33,11 @@ data DownloadInfo = DownloadInfo

 data Tool = GHC
          | Cabal
-          | GHCUp
  deriving (Eq, GHC.Generic, Ord, Show)

 data ToolRequest = ToolRequest
-  { _trTool        :: Tool
-  , _trVersion :: Version
+  { _tool        :: Tool
+  , _toolVersion :: Version
  }
  deriving (Eq, Show)

--- a/lib/GHCup/Types/JSON.hs
+++ b/lib/GHCup/Types/JSON.hs
@ -6,8 +6,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE QuasiQuotes           #-}
+{-# LANGUAGE FlexibleInstances          #-}

 module GHCup.Types.JSON where

@ -21,11 +20,7 @@ import           Data.Text.Encoding             ( decodeUtf8
                                                )
 import           Data.Aeson.Types
 import           Data.Text.Encoding            as E
-import           HPath
 import           URI.ByteString
-import           Data.Word8
-import qualified Data.ByteString               as BS
-import           Data.String.QQ



@ -38,9 +33,6 @@ deriveJSON defaultOptions ''SemVer
 deriveJSON defaultOptions ''Tool
 deriveJSON defaultOptions ''VSep
 deriveJSON defaultOptions ''VUnit
-deriveJSON defaultOptions ''VersionInfo
-deriveJSON defaultOptions ''Tag
-deriveJSON defaultOptions ''DownloadInfo


 instance ToJSON URI where
@ -135,17 +127,3 @@ instance ToJSONKey Tool where

 instance FromJSONKey Tool where
  fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
-
-instance ToJSON (Path Rel) where
-  toJSON p = case and . fmap isAscii . BS.unpack $ fp of
-    True  -> toJSON . E.decodeUtf8 $ fp
-    False -> String [s|/not/a/valid/path|]
-    where fp = toFilePath p
-
-instance FromJSON (Path Rel) where
-  parseJSON = withText "HPath Rel" $ \t -> do
-    let d = encodeUtf8 t
-    case parseRel d of
-      Right x -> pure x
-      Left  e -> fail $ "Failure in HPath Rel (FromJSON)" <> show e
-