Yo

README.md

@@ -1,28 +1,25 @@
 # ghcup
 
-A rewrite of ghcup in haskell. This can be used as a library
+A rewrite of ghcup in haskell.
-and may be redistributed as a binary in the future.
 
 ## Motivation
 
-ghcup has increasingly become difficult to maintain. A few reasons:
+Maintenance problems:
 
-* few maintainers
-* increasing LOC
 * platform incompatibilities regularly causing breaking bugs:
 	* [Mktemp not working properly on macOS](https://gitlab.haskell.org/haskell/ghcup/issues/130)
 	* [ln: illegal option -- T on macOS Catalina](https://gitlab.haskell.org/haskell/ghcup/issues/123)
 	* [Wrong tar flag on darwin](https://gitlab.haskell.org/haskell/ghcup/issues/119))
 * refactoring being difficult due to POSIX sh
 
-More benefits of a rewrite:
+Benefits of a rewrite:
 
 * Features such as installing [release candidates](https://gitlab.haskell.org/haskell/ghcup/issues/94) or [HEAD builds](https://gitlab.haskell.org/haskell/ghcup/issues/65) can be more conveniently implemented in a rewrite
 * Refactoring will be easier
 * Better tool support (such as linting the downloads file)
 * saner downloads file format (such as JSON)
 
-However, the downside will be:
+Downsides:
 
 * building static binaries for all platforms (and possibly causing SSL/DNS problems)
 * still bootstrapping those binaries via a POSIX sh script
@@ -31,4 +28,4 @@ However, the downside will be:
 
 * Correct low-level code
 * Good exception handling
-* Easier user interface (possibly interactive and non-interactive ones)
+* Cleaner user interface

TODO.md

@@ -4,8 +4,6 @@
 
 * print-system-reqs
 
-* set proper ghcup URL
-
 ## Cleanups
 
 * avoid alternative for IO
@@ -31,16 +29,13 @@
 
 ## Questions
 
-* how to figure out tools (currently not done, but when setting ghc symlinks, removes all previous tools before symlinking requested version to avoid stale tools that only exist for one version)
 * handling of SIGTERM and SIGUSR
 * installing musl on demand?
 * redo/rethink how tool tags works
+  * tarball tags as well as version tags?
 * mirror support
 * check for new version on start
-* tarball tags as well as version tags?
+  * how to propagate updates? Automatically? Might solve the versioning problem
-* installing multiple versions in parallel?
+  * maybe add deprecation notice into JSON
-* how to version and extend the format of the downloads file? Compatibility?
-* how to propagate updates? Automatically? Might solve the versioning problem
 * interactive handling when distro doesn't exist and we know the tarball is incompatible?
 * ghcup-with wrapper to execute a command with a given ghc in PATH?
-* maybe add deprecation notice into JSON

app/ghcup/Main.hs

@@ -390,8 +390,6 @@ upgradeOptsP =
 
 
 
--- TODO: something better than Show instance for errors
-
 main :: IO ()
 main = do
 

cabal.project.freeze

@@ -35,6 +35,8 @@ constraints: any.Cabal ==2.4.0.1,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.6.0,
              any.blaze-builder ==0.4.1.0,
+             any.brotli ==0.0.0.0,
+             any.brotli-streams ==0.0.0.0,
              any.bytestring ==0.10.8.2,
              any.bytestring-builder ==0.10.8.2.0,
              bytestring-builder +bytestring_has_builder,
@@ -59,7 +61,7 @@ constraints: any.Cabal ==2.4.0.1,
              any.data-default-instances-base ==0.1.0.1,
              any.deepseq ==1.4.4.0,
              any.deferred-folds ==0.9.10.1,
-             any.directory ==1.3.3.0,
+             any.directory ==1.3.3.0 || ==1.3.6.0,
              any.distributive ==0.6.1,
              distributive +semigroups +tagged,
              any.dlist ==0.8.0.7,
@@ -96,7 +98,8 @@ constraints: any.Cabal ==2.4.0.1,
              any.hpath-posix ==0.13.1,
              any.hsc2hs ==0.68.6,
              hsc2hs -in-ghc-tree,
-             any.http-io-streams ==0.1.0.0,
+             any.http-io-streams ==0.1.2.0,
+             http-io-streams +brotli,
              any.indexed-profunctors ==0.1,
              any.integer-gmp ==1.0.2.0,
              any.integer-logarithms ==1.0.3,
@@ -121,7 +124,7 @@ constraints: any.Cabal ==2.4.0.1,
              any.mono-traversable ==1.0.15.1,
              any.mtl ==2.2.2,
              any.mwc-random ==0.14.0.0,
-             any.network ==3.0.1.1,
+             any.network ==3.1.1.1,
              any.network-uri ==2.6.3.0,
              any.old-locale ==1.0.0.7,
              any.old-time ==1.1.0.3,
@@ -142,7 +145,7 @@ constraints: any.Cabal ==2.4.0.1,
              any.primitive ==0.7.0.1,
              any.primitive-extras ==0.8,
              any.primitive-unlifted ==0.1.3.0,
-             any.process ==1.6.5.0,
+             any.process ==1.6.5.0 || ==1.6.8.0,
              any.profunctors ==5.5.2,
              any.random ==1.1,
              any.recursion-schemes ==5.1.3,
@@ -192,7 +195,7 @@ constraints: any.Cabal ==2.4.0.1,
              any.th-reify-many ==0.1.9,
              any.these ==1.0.1,
              these +aeson +assoc +quickcheck +semigroupoids,
-             any.time ==1.8.0.2,
+             any.time ==1.8.0.2 || ==1.9.3,
              any.time-compat ==1.9.2.2,
              time-compat -old-locale,
              any.transformers ==0.5.6.2,

ghcup.cabal

@@ -30,6 +30,7 @@ common base { build-depends: base >= 4.12 && < 5 }
 common binary { build-depends: binary >= 0.8.6.0 }
 common bytestring { build-depends: bytestring >= 0.10 }
 common bzlib { build-depends: bzlib >= 0.5.0.5 }
+common case-insensitive { build-depends: case-insensitive >= 1.2.1.0 }
 common containers { build-depends: containers >= 0.6 }
 common generics-sop { build-depends: generics-sop >= 0.5 }
 common haskus-utils-types { build-depends: haskus-utils-types >= 1.5 }
@@ -40,7 +41,7 @@ common hpath-directory { build-depends: hpath-directory >= 0.13.2 }
 common hpath-filepath { build-depends: hpath-filepath >= 0.10.3 }
 common hpath-io { build-depends: hpath-io >= 0.13.1 }
 common hpath-posix { build-depends: hpath-posix >= 0.11.1 }
-common http-io-streams { build-depends: http-io-streams >= 0.1 }
+common http-io-streams { build-depends: http-io-streams >= 0.1.2.0 }
 common io-streams { build-depends: io-streams >= 1.5 }
 common language-bash { build-depends: language-bash >= 0.9 }
 common lzma { build-depends: lzma >= 0.0.0.3 }
@@ -61,10 +62,11 @@ common strict-base { build-depends: strict-base >= 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.3.0 }
-common terminal-progress-bar { build-depends: terminal-progress-bar >= 0.4.1 }
 common template-haskell { build-depends: template-haskell >= 2.7 }
+common terminal-progress-bar { build-depends: terminal-progress-bar >= 0.4.1 }
 common text { build-depends: text >= 1.2 }
 common text-icu { build-depends: text-icu >= 0.7 }
+common time { build-depends: time >= 1.9.3 }
 common transformers { build-depends: transformers >= 0.5 }
 common unix { build-depends: unix >= 2.7 }
 common unix-bytestring { build-depends: unix-bytestring >= 0.3 }
@@ -101,6 +103,7 @@ library
                      , binary
                      , bytestring
                      , bzlib
+                     , case-insensitive
                      , containers
                      , generics-sop
                      , haskus-utils-types
@@ -134,6 +137,7 @@ library
                      , terminal-progress-bar
                      , text
                      , text-icu
+                     , time
                      , transformers
                      , unix
                      , unix-bytestring

lib/GHCup.hs

@@ -8,7 +8,6 @@
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeApplications      #-}
 
--- TODO: handle SIGTERM, SIGUSR
 module GHCup where
 
 
@@ -216,8 +215,8 @@ installCabalBin bDls ver mpfReq = do
 -- on `SetGHC`:
 --
 --   * SetGHCOnly: ~/.ghcup/bin/ghc -> ~/.ghcup/ghc/<ver>/bin/ghc
---   * SetGHCMajor: ~/.ghcup/bin/ghc-X.Y -> ~/.ghcup/ghc/<ver>/bin/ghc
+--   * SetGHC_XY: ~/.ghcup/bin/ghc-X.Y -> ~/.ghcup/ghc/<ver>/bin/ghc
---   * SetGHCMinor: ~/.ghcup/bin/ghc-<ver> -> ~/.ghcup/ghc/<ver>/bin/ghc
+--   * SetGHC_XYZ: ~/.ghcup/bin/ghc-<ver> -> ~/.ghcup/ghc/<ver>/bin/ghc
 --
 -- Additionally creates a ~/.ghcup/share -> ~/.ghcup/ghc/<ver>/share symlink
 -- for `SetGHCOnly` constructor.
@@ -236,22 +235,22 @@ setGHC ver sghc = do
   -- first delete the old symlinks (this fixes compatibility issues
   -- with old ghcup)
   case sghc of
-    SetGHCOnly  -> liftE $ rmPlain ver
+    SetGHCOnly -> liftE $ rmPlain ver
-    SetGHCMajor -> lift $ rmMajorSymlinks ver
+    SetGHC_XY  -> lift $ rmMajorSymlinks ver
-    SetGHCMinor -> lift $ rmMinorSymlinks ver
+    SetGHC_XYZ -> lift $ rmMinorSymlinks ver
 
   -- for ghc tools (ghc, ghci, haddock, ...)
   verfiles <- ghcToolFiles ver
   forM_ verfiles $ \file -> do
     liftIO $ hideError doesNotExistErrorType $ deleteFile (bindir </> file)
     targetFile <- case sghc of
-      SetGHCOnly  -> pure file
+      SetGHCOnly -> pure file
-      SetGHCMajor -> do
+      SetGHC_XY  -> do
         major' <-
           (\(mj, mi) -> E.encodeUtf8 $ intToText mj <> [s|.|] <> intToText mi)
             <$> getGHCMajor ver
         parseRel (toFilePath file <> B.singleton _hyphen <> major')
-      SetGHCMinor -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS)
+      SetGHC_XYZ -> parseRel (toFilePath file <> B.singleton _hyphen <> verBS)
 
     -- create symlink
     let fullF = bindir </> targetFile
@@ -383,7 +382,7 @@ rmGHCVer ver = do
       lift $ rmMajorSymlinks ver
       -- then fix them (e.g. with an earlier version)
       (mj, mi) <- getGHCMajor ver
-      getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHCMajor)
+      getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
 
 
       when isSetGHC $ do
@@ -679,9 +678,9 @@ postGHCInstall :: (MonadLogger m, MonadThrow m, MonadFail m, MonadIO m)
                => Version
                -> Excepts '[NotInstalled] m ()
 postGHCInstall ver = do
-  liftE $ setGHC ver SetGHCMinor
+  liftE $ setGHC ver SetGHC_XYZ
 
   -- Create ghc-x.y symlinks. This may not be the current
   -- version, create it regardless.
   (mj, mi) <- liftIO $ getGHCMajor ver
-  getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHCMajor)
+  getGHCForMajor mj mi >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)

lib/GHCup/Download.hs

@@ -23,6 +23,7 @@ import           GHCup.Utils.String.QQ
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
+import           Control.Monad.Fail             ( MonadFail )
 import           Control.Monad.Logger
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Class      ( lift )
@@ -31,10 +32,14 @@ import           Control.Monad.Trans.Resource
 import           Data.Aeson
 import           Data.ByteString                ( ByteString )
 import           Data.ByteString.Builder
+import           Data.CaseInsensitive           ( CI )
 import           Data.IORef
 import           Data.Maybe
 import           Data.String.Interpolate
 import           Data.Text.Read
+import           Data.Time.Clock
+import           Data.Time.Clock.POSIX
+import           Data.Time.Format
 import           Data.Versions
 import           GHC.IO.Exception
 import           HPath
@@ -61,6 +66,9 @@ import           URI.ByteString.QQ
 import qualified Data.Binary.Builder           as B
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as L
+import qualified Data.CaseInsensitive          as CI
+import qualified Data.Map.Strict               as M
+import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified System.IO.Streams             as Streams
 import qualified System.Posix.RawFilePath.Directory
@@ -69,8 +77,7 @@ import qualified System.Posix.RawFilePath.Directory
 
 
 ghcupURL :: URI
-ghcupURL =
+ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.1.json|]
-  [uri|https://gist.githubusercontent.com/hasufell/5411271eb4ae52e16ad2200f80eb2813/raw/eb47b3c9d85edf3a4df2b869f8a8eda87fa94bb4/gistfile1.txt|]
 
 
 
@@ -79,7 +86,7 @@ ghcupURL =
     ------------------
 
 
--- | Downloads the download information!
+-- | Downloads the download information! But only if we need to ;P
 getDownloads :: ( FromJSONKey Tool
                 , FromJSONKey Version
                 , FromJSON VersionInfo
@@ -87,6 +94,8 @@ getDownloads :: ( FromJSONKey Tool
                 , MonadCatch m
                 , MonadReader Settings m
                 , MonadLogger m
+                , MonadThrow m
+                , MonadFail m
                 )
              => Excepts '[JSONError , DownloadFailed] m GHCupDownloads
 getDownloads = do
@@ -94,13 +103,85 @@ getDownloads = do
   lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|]
   case urlSource of
     GHCupURL -> do
-      bs <- reThrowAll DownloadFailed $ downloadBS ghcupURL
+      bs <- reThrowAll DownloadFailed $ dl ghcupURL
       lE' JSONDecodeError $ eitherDecode' bs
     (OwnSource url) -> do
-      bs <- reThrowAll DownloadFailed $ downloadBS url
+      bs <- reThrowAll DownloadFailed $ dl url
       lE' JSONDecodeError $ eitherDecode' bs
     (OwnSpec av) -> pure $ av
 
+ where
+  -- First send a HEAD request and check for modification time.
+  -- Only download the file if the modification time is newer
+  -- than the local file. Always save the local file with the
+  -- mod time of the remote file.
+  dl :: forall m1
+      . (MonadCatch m1, MonadIO m1, MonadFail m1, MonadLogger m1)
+     => URI
+     -> Excepts
+          '[ FileDoesNotExistError
+           , HTTPStatusError
+           , URIParseError
+           , UnsupportedScheme
+           , NoLocationHeader
+           , TooManyRedirs
+           ]
+          m1
+          L.ByteString
+  dl uri' = do
+    let path = view pathL' uri'
+    json_file <- (liftIO $ ghcupCacheDir)
+      >>= \cacheDir -> (cacheDir </>) <$> urlBaseName path
+    headers <-
+      handleIO (\_ -> pure mempty)
+      $ liftE
+      $ ( catchAllE
+            (\_ ->
+              pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString)
+            )
+        $ getHead uri'
+        )
+    let mModT = parseModifiedHeader headers
+    e <- liftIO $ doesFileExist json_file
+    if e
+      then do
+        case mModT of
+          Just modTime -> do
+            fileMod <- liftIO $ getModificationTime json_file
+            if modTime > fileMod
+              then do
+                bs <- liftE $ downloadBS uri'
+                liftIO $ writeFileWithModTime modTime json_file bs
+                pure bs
+              else liftIO $ readFile json_file
+          Nothing -> do
+            lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
+            liftIO $ deleteFile json_file
+            liftE $ downloadBS uri'
+      else do
+        case mModT of
+          Just modTime -> do
+            bs <- liftE $ downloadBS uri'
+            liftIO $ writeFileWithModTime modTime json_file bs
+            pure bs
+          Nothing -> do
+            lift $ $(logWarn) [i|Unable to get/parse Last-Modified header|]
+            liftE $ downloadBS uri'
+
+  parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
+  parseModifiedHeader headers =
+    (M.lookup (CI.mk [s|Last-Modified|]) headers) >>= \h -> parseTimeM
+      True
+      defaultTimeLocale
+      "%a, %d %b %Y %H:%M:%S %Z"
+      (T.unpack . E.decodeUtf8 $ h)
+
+  writeFileWithModTime :: UTCTime -> Path Abs -> L.ByteString -> IO ()
+  writeFileWithModTime utctime path content = do
+    let mod_time = utcTimeToPOSIXSeconds utctime
+    writeFileL path (Just newFilePerms) content
+    setModificationTimeHiRes path mod_time
+
 
 
 getDownloadInfo :: ( MonadLogger m
@@ -206,7 +287,6 @@ download dli dest mfn
       $ reThrowAll DownloadFailed
       $ downloadInternal True https host fullPath port stepper
 
-    -- TODO: verify md5 during download
     liftE $ checkDigest dli destFile
     pure destFile
 
@@ -282,13 +362,8 @@ downloadBS uri'
   scheme = view (uriSchemeL' % schemeBSL') uri'
   path   = view pathL' uri'
   dl https = do
-    host <-
+    (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
-      preview (authorityL' % _Just % authorityHostL' % hostBSL') uri'
+    liftE $ downloadBS' https host' fullPath' port'
-        ?? UnsupportedScheme
-    let port = preview
-          (authorityL' % _Just % authorityPortL' % _Just % portNumberL')
-          uri'
-    liftE $ downloadBS' https host path port
 
 
 -- | Load the result of this download into memory at once.
@@ -333,20 +408,12 @@ downloadInternal = go (5 :: Int)
 
  where
   go redirs progressBar https host path port consumer = do
-    r <- liftIO $ bracket acquire release' action
+    r <- liftIO $ withConnection' https host port action
     veitherToExcepts r >>= \case
       Just r' ->
         if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
       Nothing -> pure ()
    where
-    acquire = case https of
-      True -> do
-        ctx <- baselineContextSSL
-        openConnectionSSL ctx host (fromIntegral $ fromMaybe 443 port)
-      False -> openConnection host (fromIntegral $ fromMaybe 80 port)
-
-    release' = closeConnection
-
     action c = do
       let q = buildRequest1 $ http GET path
 
@@ -392,6 +459,95 @@ downloadInternal = go (5 :: Int)
 
 
 
+getHead :: (MonadCatch m, MonadIO m)
+        => URI
+        -> Excepts
+             '[ HTTPStatusError
+              , URIParseError
+              , UnsupportedScheme
+              , NoLocationHeader
+              , TooManyRedirs
+              ]
+             m
+             (M.Map (CI ByteString) ByteString)
+getHead uri' | scheme == [s|https|] = head' True
+             | scheme == [s|http|] = head' False
+             | otherwise           = throwE UnsupportedScheme
+
+ where
+  scheme = view (uriSchemeL' % schemeBSL') uri'
+  head' https = do
+    (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
+    liftE $ headInternal https host' fullPath' port'
+
+
+
+headInternal :: MonadIO m
+             => Bool        -- ^ https?
+             -> ByteString  -- ^ host
+             -> ByteString  -- ^ path with query
+             -> Maybe Int   -- ^ optional port
+             -> Excepts
+                  '[ HTTPStatusError
+                   , URIParseError
+                   , UnsupportedScheme
+                   , TooManyRedirs
+                   , NoLocationHeader
+                   ]
+                  m
+                  (M.Map (CI ByteString) ByteString)
+headInternal = go (5 :: Int)
+
+ where
+  go redirs https host path port = do
+    r <- liftIO $ withConnection' https host port action
+    veitherToExcepts r >>= \case
+      Left r' ->
+        if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
+      Right hs -> pure hs
+   where
+
+    action c = do
+      let q = buildRequest1 $ http HEAD path
+
+      sendRequest c q emptyBody
+
+      unsafeReceiveResponse
+        c
+        (\r _ -> runE $ do
+          let scode = getStatusCode r
+          if
+            | scode >= 200 && scode < 300 -> do
+              let headers = getHeaderMap r
+              pure $ Right $ headers
+            | scode >= 300 && scode < 400 -> case getHeader r [s|Location|] of
+              Just r' -> pure $ Left $ r'
+              Nothing -> throwE NoLocationHeader
+            | otherwise -> throwE $ HTTPStatusError scode
+        )
+
+    followRedirectURL bs = case parseURI strictURIParserOptions bs of
+      Right uri' -> do
+        (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
+        go (redirs - 1) https' host' fullPath' port'
+      Left e -> throwE e
+
+
+withConnection' :: Bool
+                -> ByteString
+                -> Maybe Int
+                -> (Connection -> IO a)
+                -> IO a
+withConnection' https host port action = bracket acquire closeConnection action
+
+ where
+  acquire = case https of
+    True -> do
+      ctx <- baselineContextSSL
+      openConnectionSSL ctx host (fromIntegral $ fromMaybe 443 port)
+    False -> openConnection host (fromIntegral $ fromMaybe 80 port)
+
+
 -- | Extracts from a URI type: (https?, host, path+query, port)
 uriToQuadruple :: Monad m
                => URI

lib/GHCup/Types.hs

@@ -12,6 +12,97 @@ import qualified GHC.Generics                  as GHC
 
 
 
+
+    ---------------------
+    --[ Download Tree ]--
+    ---------------------
+
+
+-- | Description of all binary and source downloads. This is a tree
+-- of nested maps.
+type GHCupDownloads = Map Tool ToolVersionSpec
+type ToolVersionSpec = Map Version VersionInfo
+type ArchitectureSpec = Map Architecture PlatformSpec
+type PlatformSpec = Map Platform PlatformVersionSpec
+type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
+
+
+-- | An installable tool.
+data Tool = GHC
+          | Cabal
+          | GHCup
+  deriving (Eq, GHC.Generic, Ord, Show)
+
+
+-- | All necessary information of a tool version, including
+-- source download and per-architecture downloads.
+data VersionInfo = VersionInfo
+  { _viTags     :: [Tag]              -- ^ version specific tag
+  , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
+  , _viArch     :: ArchitectureSpec   -- ^ descend for binary downloads per arch
+  }
+  deriving (Eq, Show)
+
+
+-- | A tag. These are currently attached to a version of a tool.
+data Tag = Latest
+         | Recommended
+         deriving (Ord, Eq, Show)
+
+
+data Architecture = A_64
+                  | A_32
+  deriving (Eq, GHC.Generic, Ord, Show)
+
+
+data Platform = Linux LinuxDistro
+              -- ^ must exit
+              | Darwin
+              -- ^ must exit
+              | FreeBSD
+  deriving (Eq, GHC.Generic, Ord, Show)
+
+data LinuxDistro = Debian
+                 | Ubuntu
+                 | Mint
+                 | Fedora
+                 | CentOS
+                 | RedHat
+                 | Alpine
+                 | AmazonLinux
+                 -- rolling
+                 | Gentoo
+                 | Exherbo
+                 -- not known
+                 | UnknownLinux
+                 -- ^ must exit
+  deriving (Eq, GHC.Generic, Ord, Show)
+
+
+-- | An encapsulation of a download. This can be used
+-- to download, extract and install a tool.
+data DownloadInfo = DownloadInfo
+  { _dlUri    :: URI
+  , _dlSubdir :: Maybe (Path Rel)
+  , _dlHash   :: Text
+  }
+  deriving (Eq, Show)
+
+
+
+
+    --------------
+    --[ Others ]--
+    --------------
+
+
+-- | Where to fetch GHCupDownloads from.
+data URLSource = GHCupURL
+               | OwnSource URI
+               | OwnSpec GHCupDownloads
+               deriving Show
+
+
 data Settings = Settings
   { cache     :: Bool
   , urlSource :: URLSource
@@ -33,61 +124,11 @@ data DebugInfo = DebugInfo
 
 
 data SetGHC = SetGHCOnly  -- ^ unversioned 'ghc'
-            | SetGHCMajor -- ^ ghc-x.y
+            | SetGHC_XY   -- ^ ghc-x.y
-            | SetGHCMinor -- ^ ghc-x.y.z -- TODO: rename
+            | SetGHC_XYZ  -- ^ ghc-x.y.z
             deriving (Eq, Show)
 
 
-data Tag = Latest
-         | Recommended
-         deriving (Ord, Eq, Show)
-
-data VersionInfo = VersionInfo
-  { _viTags     :: [Tag]              -- ^ version specific tag
-  , _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
-  , _viArch     :: ArchitectureSpec   -- ^ descend for binary downloads per arch
-  }
-  deriving (Eq, Show)
-
-data DownloadInfo = DownloadInfo
-  { _dlUri    :: URI
-  , _dlSubdir :: Maybe (Path Rel)
-  , _dlHash   :: Text
-  }
-  deriving (Eq, Show)
-
-data Tool = GHC
-          | Cabal
-          | GHCup
-  deriving (Eq, GHC.Generic, Ord, Show)
-
-data Architecture = A_64
-                  | A_32
-  deriving (Eq, GHC.Generic, Ord, Show)
-
-data LinuxDistro = Debian
-                 | Ubuntu
-                 | Mint
-                 | Fedora
-                 | CentOS
-                 | RedHat
-                 | Alpine
-                 | AmazonLinux
-                 -- rolling
-                 | Gentoo
-                 | Exherbo
-                 -- not known
-                 | UnknownLinux
-                 -- ^ must exit
-  deriving (Eq, GHC.Generic, Ord, Show)
-
-data Platform = Linux LinuxDistro
-              -- ^ must exit
-              | Darwin
-              -- ^ must exit
-              | FreeBSD
-  deriving (Eq, GHC.Generic, Ord, Show)
-
 data PlatformResult = PlatformResult
   { _platform      :: Platform
   , _distroVersion :: Maybe Versioning
@@ -101,13 +142,3 @@ data PlatformRequest = PlatformRequest
   }
   deriving (Eq, Show)
 
-type PlatformVersionSpec = Map (Maybe Versioning) DownloadInfo
-type PlatformSpec = Map Platform PlatformVersionSpec
-type ArchitectureSpec = Map Architecture PlatformSpec
-type ToolVersionSpec = Map Version VersionInfo
-type GHCupDownloads = Map Tool ToolVersionSpec
-
-data URLSource = GHCupURL
-               | OwnSource URI
-               | OwnSpec GHCupDownloads
-               deriving Show

lib/GHCup/Utils/File.hs

@@ -219,9 +219,9 @@ toProcessError exe args mps = case mps of
 -- | Convert the String to a ByteString with the current
 -- system encoding.
 unsafePathToString :: Path b -> IO FilePath
-unsafePathToString (Path p) = do
+unsafePathToString p = do
   enc <- getLocaleEncoding
-  unsafeUseAsCStringLen p (peekCStringLen enc)
+  unsafeUseAsCStringLen (toFilePath p) (peekCStringLen enc)
 
 
 -- | Search for a file in the search paths.