@@ -83,42 +83,8 @@ handles your haskell packages and can demand that [a specific version](https://c | |||
### Configuration | |||
A configuration file can be put in `~/.ghcup/config.yaml`. Here is the complete default | |||
configuration: | |||
```yaml | |||
# Cache downloads in ~/.ghcup/cache | |||
cache: False | |||
# Skip tarball checksum verification | |||
no-verify: False | |||
# enable verbosity | |||
verbose: False | |||
# When to keep build directories | |||
keep-dirs: Errors # Always | Never | Errors | |||
# Which downloader to use | |||
downloader: Curl # Curl | Wget | Internal | |||
# TUI key bindings, | |||
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key | |||
# for possible values. | |||
key-bindings: | |||
up: | |||
KUp: [] | |||
down: | |||
KDown: [] | |||
quit: | |||
KChar: 'q' | |||
install: | |||
KChar: 'i' | |||
uninstall: | |||
KChar: 'u' | |||
set: | |||
KChar: 's' | |||
changelog: | |||
KChar: 'c' | |||
show-all: | |||
KChar: 'a' | |||
``` | |||
A configuration file can be put in `~/.ghcup/config.yaml`. The default config file | |||
explaining all possible configurations can be found in this repo: [config.yaml](./config.yaml). | |||
Partial configuration is fine. Command line options always overwrite the config file settings. | |||
@@ -193,7 +193,7 @@ validateTarballs dls = do | |||
where | |||
downloadAll dli = do | |||
dirs <- liftIO getDirs | |||
let settings = AppState (Settings True False Never Curl False) dirs defaultKeyBindings | |||
let settings = AppState (Settings True False Never Curl False GHCupURL) dirs defaultKeyBindings | |||
let runLogger = myLoggerT LoggerConfig { lcPrintDebug = True | |||
, colorOutter = B.hPut stderr | |||
, rawOutter = (\_ -> pure ()) | |||
@@ -494,6 +494,7 @@ settings' = unsafePerformIO $ do | |||
, keepDirs = Never | |||
, downloader = Curl | |||
, verbose = False | |||
, urlSource = GHCupURL | |||
, .. | |||
}) | |||
dirs | |||
@@ -913,12 +913,13 @@ toSettings options = do | |||
where | |||
mergeConf :: Options -> Dirs -> UserSettings -> AppState | |||
mergeConf (Options {..}) dirs (UserSettings {..}) = | |||
let cache = fromMaybe (fromMaybe False uCache) optCache | |||
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify | |||
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose | |||
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs | |||
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader | |||
let cache = fromMaybe (fromMaybe False uCache) optCache | |||
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify | |||
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose | |||
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs | |||
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader | |||
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings | |||
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource | |||
in AppState (Settings {..}) dirs keyBindings | |||
#if defined(INTERNAL_DOWNLOADER) | |||
defaultDownloader = Internal | |||
@@ -1149,7 +1150,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|] | |||
. flip runReaderT appstate | |||
. runE @'[JSONError , DownloadFailed, FileDoesNotExistError] | |||
$ liftE | |||
$ getDownloadsF (maybe GHCupURL OwnSource optUrlSource) | |||
$ getDownloadsF (urlSource settings) | |||
) | |||
>>= \case | |||
VRight r -> pure r | |||
@@ -0,0 +1,61 @@ | |||
# Cache downloads in ~/.ghcup/cache | |||
cache: False | |||
# Skip tarball checksum verification | |||
no-verify: False | |||
# enable verbosity | |||
verbose: False | |||
# When to keep build directories | |||
keep-dirs: Errors # Always | Never | Errors | |||
# Which downloader to use | |||
downloader: Curl # Curl | Wget | Internal | |||
# TUI key bindings, | |||
# see https://hackage.haskell.org/package/vty-5.31/docs/Graphics-Vty-Input-Events.html#t:Key | |||
# for possible values. | |||
key-bindings: | |||
up: | |||
KUp: [] | |||
down: | |||
KDown: [] | |||
quit: | |||
KChar: 'q' | |||
install: | |||
KChar: 'i' | |||
uninstall: | |||
KChar: 'u' | |||
set: | |||
KChar: 's' | |||
changelog: | |||
KChar: 'c' | |||
show-all: | |||
KChar: 'a' | |||
# Where to get GHC/cabal/hls download info/versions from. For more detailed explanation | |||
# check the 'URLSource' type in the code. | |||
url-source: | |||
## Use the internal download uri, this is the default | |||
GHCupURL: [] | |||
## Example 1: Read download info from this location instead | |||
## Accepts file/http/https scheme | |||
# OwnSource: "file:///home/jule/git/ghcup-hs/ghcup-0.0.3.yaml" | |||
## Example 2: Add custom tarballs to the default downloads, overwriting duplicate versions | |||
# AddSource: | |||
# Left: | |||
# toolRequirements: {} # this is ignored | |||
# ghcupDownloads: | |||
# GHC: | |||
# 9.10.2: | |||
# viTags: [] | |||
# viArch: | |||
# A_64: | |||
# Linux_UnknownLinux: | |||
# unknown_versioning: | |||
# dlUri: https://downloads.haskell.org/~ghc/7.10.3/ghc-7.10.3-x86_64-deb8-linux.tar.bz2 | |||
# dlSubdir: ghc-7.10.3 | |||
# dlHash: 01cfbad8dff1e8b34a5fdca8caeaf843b56e36af919e29cd68870d2588563db5 | |||
## Example 3: Add a custom download file to the default downloads, overwriting duplicate versions | |||
# AddSource: | |||
# Right: "file:///home/jule/git/ghcup-hs/ghcup-custom.yaml" |
@@ -83,9 +83,9 @@ import qualified Crypto.Hash.SHA256 as SHA256 | |||
import qualified Data.ByteString as BS | |||
import qualified Data.ByteString.Base16 as B16 | |||
import qualified Data.ByteString.Lazy as L | |||
import qualified Data.Map.Strict as M | |||
#if defined(INTERNAL_DOWNLOADER) | |||
import qualified Data.CaseInsensitive as CI | |||
import qualified Data.Map.Strict as M | |||
import qualified Data.Text as T | |||
#endif | |||
import qualified Data.Text.Encoding as E | |||
@@ -104,8 +104,8 @@ import qualified System.Posix.RawFilePath.Directory | |||
------------------ | |||
-- | Downloads the download information! But only if we need to ;P | |||
getDownloadsF :: ( FromJSONKey Tool | |||
, FromJSONKey Version | |||
, FromJSON VersionInfo | |||
@@ -123,15 +123,22 @@ getDownloadsF :: ( FromJSONKey Tool | |||
GHCupInfo | |||
getDownloadsF urlSource = do | |||
case urlSource of | |||
GHCupURL -> | |||
liftE | |||
$ handleIO (\_ -> readFromCache) | |||
$ catchE @_ @'[JSONError , FileDoesNotExistError] | |||
(\(DownloadFailed _) -> readFromCache) | |||
$ getDownloads urlSource | |||
(OwnSource _) -> liftE $ getDownloads urlSource | |||
(OwnSpec _) -> liftE $ getDownloads urlSource | |||
GHCupURL -> liftE getBase | |||
(OwnSource url) -> do | |||
bs <- reThrowAll DownloadFailed $ downloadBS url | |||
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs) | |||
(OwnSpec av) -> pure av | |||
(AddSource (Left ext)) -> do | |||
base <- liftE getBase | |||
pure (mergeGhcupInfo base ext) | |||
(AddSource (Right uri)) -> do | |||
base <- liftE getBase | |||
bsExt <- reThrowAll DownloadFailed $ downloadBS uri | |||
ext <- lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bsExt) | |||
pure (mergeGhcupInfo base ext) | |||
where | |||
readFromCache :: (MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m) | |||
=> Excepts '[JSONError, FileDoesNotExistError] m GHCupInfo | |||
readFromCache = do | |||
AppState {dirs = Dirs {..}} <- lift ask | |||
lift $ $(logWarn) | |||
@@ -145,32 +152,25 @@ getDownloadsF urlSource = do | |||
$ readFile yaml_file | |||
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs) | |||
getBase :: (MonadFail m, MonadIO m, MonadCatch m, MonadLogger m, MonadReader AppState m) | |||
=> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo | |||
getBase = | |||
handleIO (\_ -> readFromCache) | |||
$ catchE @_ @'[JSONError, FileDoesNotExistError] | |||
(\(DownloadFailed _) -> readFromCache) | |||
$ ((reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed $ smartDl ghcupURL) | |||
>>= (liftE . lE' @_ @_ @'[JSONError] JSONDecodeError . bimap show id . Y.decodeEither' . L.toStrict)) | |||
mergeGhcupInfo :: GHCupInfo -- ^ base to merge with | |||
-> GHCupInfo -- ^ extension overwriting the base | |||
-> GHCupInfo | |||
mergeGhcupInfo (GHCupInfo tr base) (GHCupInfo _ ext) = | |||
let new = M.mapWithKey (\k a -> case M.lookup k ext of | |||
Just a' -> M.union a' a | |||
Nothing -> a | |||
) base | |||
in GHCupInfo tr new | |||
getDownloads :: ( FromJSONKey Tool | |||
, FromJSONKey Version | |||
, FromJSON VersionInfo | |||
, MonadIO m | |||
, MonadCatch m | |||
, MonadLogger m | |||
, MonadThrow m | |||
, MonadFail m | |||
, MonadReader AppState m | |||
) | |||
=> URLSource | |||
-> Excepts '[JSONError , DownloadFailed] m GHCupInfo | |||
getDownloads urlSource = do | |||
lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|] | |||
case urlSource of | |||
GHCupURL -> do | |||
bs <- reThrowAll DownloadFailed $ smartDl ghcupURL | |||
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs) | |||
(OwnSource url) -> do | |||
bs <- reThrowAll DownloadFailed $ downloadBS url | |||
lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs) | |||
(OwnSpec av) -> pure $ av | |||
where | |||
-- First check if the json file is in the ~/.ghcup/cache dir | |||
-- and check it's access time. If it has been accessed within the | |||
-- last 5 minutes, just reuse it. | |||
@@ -191,6 +191,7 @@ data TarDir = RealDir (Path Rel) | |||
data URLSource = GHCupURL | |||
| OwnSource URI | |||
| OwnSpec GHCupInfo | |||
| AddSource (Either GHCupInfo URI) -- ^ merge with GHCupURL | |||
deriving (GHC.Generic, Show) | |||
@@ -201,11 +202,12 @@ data UserSettings = UserSettings | |||
, uKeepDirs :: Maybe KeepDirs | |||
, uDownloader :: Maybe Downloader | |||
, uKeyBindings :: Maybe UserKeyBindings | |||
, uUrlSource :: Maybe URLSource | |||
} | |||
deriving (Show, GHC.Generic) | |||
defaultUserSettings :: UserSettings | |||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing | |||
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing | |||
data UserKeyBindings = UserKeyBindings | |||
{ kUp :: Maybe Vty.Key | |||
@@ -255,6 +257,7 @@ data Settings = Settings | |||
, keepDirs :: KeepDirs | |||
, downloader :: Downloader | |||
, verbose :: Bool | |||
, urlSource :: URLSource | |||
} | |||
deriving (Show, GHC.Generic) | |||
@@ -55,6 +55,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI | |||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements | |||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs | |||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader | |||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource | |||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings | |||
deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings | |||
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Vty.Key | |||