Compare commits

..

24 Commits

Author SHA1 Message Date
6e1380ef2e Bump to 0.1.19.2, add changelog 2023-06-29 18:42:05 +08:00
3e83a7fd83 Merge branch 'nightlies' 2023-06-29 18:27:17 +08:00
34ac9cec4d Add nightlies documentation 2023-06-29 14:47:49 +08:00
513f7446b3 Fix 2023-06-29 14:30:07 +08:00
aed478153d Print alternative day if day not found 2023-05-14 22:06:38 +08:00
210816769a Add dlOutput to DownloadInfo 2023-05-14 22:06:38 +08:00
42bf21c86e Update stack 2023-05-14 19:43:50 +08:00
4b34cddcda Implement support for nightlies, wrt #824 2023-05-14 19:43:49 +08:00
1ba2361fea Fix ARMv7 build 2023-05-02 23:54:53 +08:00
278a3005d1 Merge remote-tracking branch 'origin/pr/818' 2023-05-01 16:02:32 +08:00
Luis Morillo
78d68e381a apply logging only on GHC uninstalation 2023-04-14 17:31:28 +02:00
17ffc459db Merge remote-tracking branch 'origin/pr/811' 2023-03-25 16:45:12 +08:00
afcb482866 Update GPG keys 2023-03-25 15:33:56 +08:00
c28de19faa Fix GC with XDG dirs, fixes #810 2023-03-18 22:04:37 +08:00
7ae952c82e Merge remote-tracking branch 'origin/pr/809' 2023-03-18 12:26:32 +08:00
Ryan Davis
98098035c9 Use correct environment variable for STACK_ROOT
The environment variable used to set the root Stack directory was
incorrectly defined as STACK_ROOOT (typo with an extra 'O'). 

This has been fixed and the correct STACK_ROOT variable is now used.

See: https://docs.haskellstack.org/en/stable/environment_variables/#stack_root
2023-03-16 13:38:25 +11:00
acdc0786ba Update tools table 2023-03-15 00:18:14 +08:00
7fa72a8892 Merge remote-tracking branch 'origin/pr/807' 2023-03-15 00:13:54 +08:00
fa22920e51 Merge branch 'docker-glibc' 2023-03-15 00:13:17 +08:00
f084fbce43 Fix f*ckup in docker image creation 2023-03-14 20:56:03 +08:00
Arjun Kathuria
1850c00e9d fix: project build error with new haskus-utils-variant version
* New haskus-utils-variant version 3.3 now includes the function
  "throwSomeE", which was now causing a compile error, since
  we have a function of the same name in our code.

* The function imported from the package and our own version clashed.

* Solution was to conditionally include our shim when haskus-utils-variant
  version < 3.3
2023-03-13 00:25:04 +05:30
c20deceaa8 Improve wording around FreeBSD support 2023-03-11 21:26:16 +08:00
89e4145baf Merge remote-tracking branch 'origin/pr/805' 2023-03-11 21:23:31 +08:00
Alexey Vyskubov
f5f7c26d8a Adds some information about FreeBSD installation. 2023-03-07 13:01:20 +02:00
44 changed files with 25967 additions and 22553 deletions

View File

@@ -1,5 +1,5 @@
freebsd_instance:
image_family: freebsd-13-1
image_family: freebsd-13-2
build_task:
name: build
@@ -16,7 +16,9 @@ build_task:
AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
install_script:
- sed -i.bak -e 's/quarterly/latest/' /etc/pkg/FreeBSD.conf
- pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
script:
- tzsetup Etc/GMT
- adjkerntz -a

View File

@@ -25,7 +25,7 @@ jobs:
include:
- os: ubuntu-latest
DISTRO: Ubuntu
- os: macOS-10.15
- os: macOS-11
DISTRO: na
- os: windows-latest
DISTRO: na

View File

@@ -53,7 +53,7 @@ jobs:
platforms: linux/amd64
docker-arm32:
runs-on: [self-hosted, Linux, ARM64, aarch32-linux]
runs-on: [self-hosted, Linux, ARM64]
steps:
- uses: docker://arm64v8/ubuntu:focal
name: Cleanup (aarch64 linux)
@@ -85,7 +85,7 @@ jobs:
with:
context: ./docker/arm32v7/focal
push: true
tags: hasufell/arm32v7-debian-haskell:10
tags: hasufell/arm32v7-ubuntu-haskell:focal
platforms: linux/arm
docker-aarch:
@@ -121,5 +121,5 @@ jobs:
with:
context: ./docker/arm64v8/focal
push: true
tags: hasufell/arm64v8-debian-haskell:10
tags: hasufell/arm64v8-ubuntu-haskell:focal
platforms: linux/arm64

View File

@@ -81,7 +81,7 @@ jobs:
name: Build ARM binary
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7"
AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -90,7 +90,7 @@ jobs:
fail-fast: true
matrix:
include:
- os: [self-hosted, Linux, ARM64, aarch32-linux]
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
ARCH: ARM
@@ -168,7 +168,7 @@ jobs:
ARTIFACT: "aarch64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: ARM64
- os: macOS-10.15
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: 64
@@ -325,12 +325,12 @@ jobs:
needs: "build-arm"
runs-on: ${{ matrix.os }}
env:
CABAL_VER: 3.8.1.0
CABAL_VER: 3.6.2.0
JSON_VERSION: "0.0.7"
strategy:
matrix:
include:
- os: [self-hosted, Linux, ARM64, aarch32-linux]
- os: [self-hosted, Linux, ARM64]
ARTIFACT: "armv7-linux-ghcup"
GHC_VER: 9.2.2
ARCH: ARM
@@ -403,7 +403,7 @@ jobs:
GHC_VER: 9.2.6
ARCH: ARM64
DISTRO: na
- os: macOS-10.15
- os: macOS-11
ARTIFACT: "x86_64-apple-darwin-ghcup"
GHC_VER: 9.2.6
ARCH: 64

View File

@@ -1,5 +1,10 @@
# Revision history for ghcup
## 0.1.19.3 -- 2023-6-29
* Implement support for nightlies, wrt [#824](https://github.com/haskell/ghcup-hs/issues/824)
* Fix GC with XDG dirs, fixes [#810](https://github.com/haskell/ghcup-hs/issues/810)
## 0.1.19.2 -- 2023-2-24
* Follow-up fix for JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#787](https://github.com/haskell/ghcup-hs/issues/787)

View File

@@ -11,6 +11,7 @@ module BrickMain where
import GHCup
import GHCup.Download
import GHCup.Errors
import GHCup.Types.Optics ( getDirs )
import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils
import GHCup.OptParse.Common (logGHCPostRm)
@@ -19,7 +20,6 @@ import GHCup.Prelude.File
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prompts
import GHCup.Types.Optics hiding ( getGHCupInfo )
import Brick
import Brick.Widgets.Border
@@ -53,7 +53,6 @@ import System.Exit
import System.IO.Unsafe
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import URI.ByteString
import Optics ( view )
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as B
@@ -74,8 +73,8 @@ data BrickData = BrickData
deriving Show
data BrickSettings = BrickSettings
{ showAllVersions :: Bool
, showAllTools :: Bool
{ showAllVersions :: Bool
, showAllTools :: Bool
}
deriving Show
@@ -203,9 +202,11 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
printTag Recommended = Just $ withAttr (attrName "recommended") $ str "recommended"
printTag Latest = Just $ withAttr (attrName "latest") $ str "latest"
printTag Prerelease = Just $ withAttr (attrName "prerelease") $ str "prerelease"
printTag Nightly = Just $ withAttr (attrName "nightly") $ str "nightly"
printTag (Base pvp'') = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
printTag Old = Nothing
printTag LatestPrerelease = Just $ withAttr (attrName "latest-prerelease") $ str "latest-prerelease"
printTag LatestNightly = Just $ withAttr (attrName "latest-nightly") $ str "latest-nightly"
printTag (UnknownTag t) = Just $ str t
printTool Cabal = str "cabal"
@@ -219,6 +220,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
)
++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [withAttr (attrName "day") $ str (show d)])
-- | Draws the list elements.
--
@@ -273,19 +277,22 @@ app attrs dimAttrs =
defaultAttributes :: Bool -> AttrMap
defaultAttributes no_color = attrMap
Vty.defAttr
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
, (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red)
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
[ (attrName "active" , Vty.defAttr `withBackColor` Vty.blue)
, (attrName "not-installed" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "set" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "installed" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "recommended" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "hls-powered" , Vty.defAttr `withForeColor` Vty.green)
, (attrName "latest" , Vty.defAttr `withForeColor` Vty.yellow)
, (attrName "latest-prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
, (attrName "latest-nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "prerelease" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "nightly" , Vty.defAttr `withForeColor` Vty.red)
, (attrName "compiled" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "stray" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "day" , Vty.defAttr `withForeColor` Vty.blue)
, (attrName "help" , Vty.defAttr `withStyle` Vty.italic)
, (attrName "hooray" , Vty.defAttr `withForeColor` Vty.brightWhite)
]
where
withForeColor | no_color = const
@@ -412,13 +419,17 @@ filterVisible :: Bool -> Bool -> ListResult -> Bool
filterVisible v t e | lInstalled e = True
| v
, not t
, Nightly `notElem` lTag e
, lTool e `notElem` hiddenTools = True
| not v
, t
, Old `notElem` lTag e = True
, Old `notElem` lTag e
, Nightly `notElem` lTag e = True
| v
, Nightly `notElem` lTag e
, t = True
| otherwise = (Old `notElem` lTag e) &&
| otherwise = (Old `notElem` lTag e) &&
(Nightly `notElem` lTag e) &&
(lTool e `notElem` hiddenTools)
@@ -478,7 +489,7 @@ install' _ (_, ListResult {..}) = do
)
>>= \case
VRight (vi, Dirs{..}, Just ce) -> do
forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
case lTool of
GHCup -> do
up <- liftIO $ fmap (either (const Nothing) Just)
@@ -490,7 +501,7 @@ install' _ (_, ListResult {..}) = do
_ -> pure ()
pure $ Right ()
VRight (vi, _, _) -> do
forM_ (view viPostInstall =<< vi) $ \msg -> logInfo msg
forM_ (_viPostInstall =<< vi) $ \msg -> logInfo msg
logInfo "Please restart 'ghcup' for the changes to take effect"
pure $ Right ()
VLeft (V (AlreadyInstalled _ _)) -> pure $ Right ()
@@ -564,8 +575,8 @@ del' _ (_, ListResult {..}) = do
)
>>= \case
VRight vi -> do
logGHCPostRm (mkTVer lVer)
forM_ (view viPostRemove =<< vi) $ \msg ->
when (lTool == GHC) $ logGHCPostRm (mkTVer lVer)
forM_ (_viPostRemove =<< vi) $ \msg ->
logInfo msg
pure $ Right ()
VLeft e -> pure $ Left (prettyHFError e)
@@ -577,7 +588,7 @@ changelog' :: (MonadReader AppState m, MonadIO m)
-> m (Either String ())
changelog' _ (_, ListResult {..}) = do
AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
case getChangeLog dls lTool (Left lVer) of
case getChangeLog dls lTool (ToolVersion lVer) of
Nothing -> pure $ Left $
"Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
Just uri -> do
@@ -657,5 +668,5 @@ getAppData mgi = runExceptT $ do
settings <- liftIO $ readIORef settings'
flip runReaderT settings $ do
lV <- listVersions Nothing Nothing
lV <- listVersions Nothing [] False True (Nothing, Nothing)
pure $ BrickData (reverse lV)

View File

@@ -244,7 +244,8 @@ com =
<> command
"list"
(info (List <$> listOpts <**> helper)
(progDesc "Show available GHCs and other tools")
(progDesc "Show available GHCs and other tools"
<> footerDoc (Just $ text listToolFooter))
)
<> command
"upgrade"

View File

@@ -35,7 +35,6 @@ import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
import GHCup.Types.Optics
import GHCup.Utils
import Data.Versions
import URI.ByteString (serializeURIRef')
import Data.Char (toLower)
@@ -81,7 +80,7 @@ changelogP =
<> completer toolCompleter
)
)
<*> optional (toolVersionTagArgument Nothing Nothing)
<*> optional (toolVersionTagArgument [] Nothing)
@@ -115,20 +114,15 @@ changelog :: ( Monad m
changelog ChangeLogOptions{..} runAppState runLogger = do
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
let tool = fromMaybe GHC clTool
ver' = maybe
(Right Latest)
(\case
GHCVersion tv -> Left (_tvVersion tv)
ToolVersion tv -> Left tv
ToolTag t -> Right t
)
ver' = fromMaybe
(ToolTag Latest)
clToolVer
muri = getChangeLog dls tool ver'
case muri of
Nothing -> do
runLogger
(logWarn $
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
"Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> T.pack (prettyShow ver')
)
pure ExitSuccess
Just uri -> do

View File

@@ -45,6 +45,8 @@ import Data.Functor
import Data.List ( nub, sort, sortBy, isPrefixOf, stripPrefix )
import Data.Maybe
import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions hiding ( str )
import Data.Void
import qualified Data.Vector as V
@@ -57,7 +59,6 @@ import System.Process ( readProcess )
import System.FilePath
import Text.HTML.TagSoup hiding ( Tag )
import URI.ByteString
import Optics ( view )
import qualified Data.ByteString.UTF8 as UTF8
import qualified Data.Map.Strict as M
@@ -73,26 +74,26 @@ import qualified Cabal.Config as CC
--[ Types ]--
-------------
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
-- a superset of ToolVersion
data SetToolVersion = SetGHCVersion GHCTargetVersion
| SetToolVersion Version
| SetToolTag Tag
| SetToolDay Day
| SetRecommended
| SetNext
prettyToolVer :: ToolVersion -> String
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolTag t) = show t
prettyToolVer (ToolDay day) = show day
toSetToolVer :: Maybe ToolVersion -> SetToolVersion
toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
toSetToolVer (Just (ToolTag t')) = SetToolTag t'
toSetToolVer (Just (ToolDay d')) = SetToolDay d'
toSetToolVer Nothing = SetRecommended
@@ -103,28 +104,28 @@ toSetToolVer Nothing = SetRecommended
--------------
toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument criteria tool =
argument (eitherReader (parser tool))
(metavar (mv tool)
<> completer (tagCompleter (fromMaybe GHC tool) [])
<> foldMap (completer . versionCompleter criteria) tool)
where
mv (Just GHC) = "GHC_VERSION|TAG"
mv (Just HLS) = "HLS_VERSION|TAG"
mv _ = "VERSION|TAG"
mv (Just GHC) = "GHC_VERSION|TAG|RELEASE_DATE"
mv (Just HLS) = "HLS_VERSION|TAG|RELEASE_DATE"
mv _ = "VERSION|TAG|RELEASE_DATE"
parser (Just GHC) = ghcVersionTagEither
parser Nothing = ghcVersionTagEither
parser _ = toolVersionTagEither
versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
versionParser' criteria tool = argument
(eitherReader (first show . version . T.pack))
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
(metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
@@ -238,22 +239,23 @@ isolateParser f = case isValid f && isAbsolute f of
-- this accepts cross prefix
ghcVersionTagEither :: String -> Either String ToolVersion
ghcVersionTagEither s' =
second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
-- this ignores cross prefix
toolVersionTagEither :: String -> Either String ToolVersion
toolVersionTagEither s' =
second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
second ToolDay (dayParser s') <|> second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
tagEither :: String -> Either String Tag
tagEither s' = case fmap toLower s' of
"recommended" -> Right Recommended
"latest" -> Right Latest
"latest-prerelease" -> Right LatestPrerelease
"latest-nightly" -> Right LatestNightly
('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
Right x -> Right (Base x)
Left _ -> Left $ "Invalid PVP version for base " <> ver'
other -> Left $ "Unknown tag " <> other
other -> Left $ "Unknown tag " <> other
ghcVersionEither :: String -> Either String GHCTargetVersion
@@ -262,7 +264,7 @@ ghcVersionEither =
toolVersionEither :: String -> Either String Version
toolVersionEither =
first (const "Not a valid version") . MP.parse version' "" . T.pack
first (const "Not a valid version") . MP.parse (version' <* MP.eof) "" . T.pack
toolParser :: String -> Either String Tool
@@ -273,12 +275,22 @@ toolParser s' | t == T.pack "ghc" = Right GHC
| otherwise = Left ("Unknown tool: " <> s')
where t = T.toLower (T.pack s')
dayParser :: String -> Either String Day
dayParser s = maybe (Left $ "Could not parse \"" <> s <> "\". Expected format is: YYYY-MM-DD") Right
$ parseTimeM True defaultTimeLocale "%Y-%-m-%-d" s
criteriaParser :: String -> Either String ListCriteria
criteriaParser s' | t == T.pack "installed" = Right ListInstalled
| t == T.pack "set" = Right ListSet
| t == T.pack "available" = Right ListAvailable
| otherwise = Left ("Unknown criteria: " <> s')
criteriaParser s' | t == T.pack "installed" = Right $ ListInstalled True
| t == T.pack "set" = Right $ ListSet True
| t == T.pack "available" = Right $ ListAvailable True
| t == T.pack "+installed" = Right $ ListInstalled True
| t == T.pack "+set" = Right $ ListSet True
| t == T.pack "+available" = Right $ ListAvailable True
| t == T.pack "-installed" = Right $ ListInstalled False
| t == T.pack "-set" = Right $ ListSet False
| t == T.pack "-available" = Right $ ListAvailable False
| otherwise = Left ("Unknown criteria: " <> s')
where t = T.toLower (T.pack s')
@@ -452,14 +464,14 @@ tagCompleter tool add = listIOCompleter $ do
case mGhcUpInfo of
VRight ghcupInfo -> do
let allTags = filter (/= Old)
$ (view viTags) =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
$ _viTags =<< M.elems (availableToolVersions (_ghcupDownloads ghcupInfo) tool)
pure $ nub $ (add ++) $ fmap tagToString allTags
VLeft _ -> pure (nub $ ["recommended", "latest", "latest-prerelease"] ++ add)
versionCompleter :: Maybe ListCriteria -> Tool -> Completer
versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter criteria tool = versionCompleter' criteria tool (const True)
versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
versionCompleter' criteria tool filter' = listIOCompleter $ do
dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig
@@ -488,7 +500,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
runEnv = flip runReaderT appState
installedVersions <- runEnv $ listVersions (Just tool) criteria
installedVersions <- runEnv $ listVersions (Just tool) criteria False False (Nothing, Nothing)
return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
@@ -656,6 +668,7 @@ fromVersion :: ( HasLog env
-> Tool
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
@@ -674,6 +687,7 @@ fromVersion' :: ( HasLog env
-> Tool
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m (GHCTargetVersion, Maybe VersionInfo)
@@ -708,9 +722,17 @@ fromVersion' (SetToolVersion v) tool = do
fromVersion' (SetToolTag Latest) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
fromVersion' (SetToolDay day) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> case getByReleaseDay dls tool day of
Left ad -> throwE $ DayNotFound day tool ad
Right v -> pure v
fromVersion' (SetToolTag LatestPrerelease) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestPrerelease dls tool ?? TagNotFound LatestPrerelease tool
fromVersion' (SetToolTag LatestNightly) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getLatestNightly dls tool ?? TagNotFound LatestNightly tool
fromVersion' (SetToolTag Recommended) tool = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
bimap mkTVer Just <$> getRecommended dls tool ?? TagNotFound Recommended tool
@@ -780,7 +802,7 @@ checkForUpdates :: ( MonadReader env m
=> m [(Tool, Version)]
checkForUpdates = do
GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
lInstalled <- listVersions Nothing (Just ListInstalled)
lInstalled <- listVersions Nothing [ListInstalled True] False False (Nothing, Nothing)
let latestInstalled tool = (fmap lVer . lastMay . filter (\lr -> lTool lr == tool)) lInstalled
ghcup <- forMM (getLatest dls GHCup) $ \(l, _) -> do

View File

@@ -16,11 +16,11 @@ import qualified GHCup.GHC as GHC
import qualified GHCup.HLS as HLS
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Utils
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import GHCup.OptParse.Common
import GHCup.Types.Optics
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -36,7 +36,6 @@ import Data.Versions ( Version, prettyVer, version, p
import qualified Data.Versions as V
import Data.Text ( Text )
import Haskus.Utils.Variant.Excepts
import Optics
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Prelude hiding ( appendFile )
@@ -171,7 +170,7 @@ ghcCompileOpts =
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The tool version to compile"
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
) <|>
(GHC.GitDist <$> (GitBranch <$> option
@@ -206,7 +205,7 @@ ghcCompileOpts =
<> metavar "BOOTSTRAP_GHC"
<> help
"The GHC version (or full path) to bootstrap with (must be installed)"
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
<*> optional
(option
@@ -259,7 +258,7 @@ ghcCompileOpts =
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
)
<*> optional
@@ -292,7 +291,7 @@ hlsCompileOpts =
)
(short 'v' <> long "version" <> metavar "VERSION" <> help
"The version to compile (pulled from hackage)"
<> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
<> (completer $ versionCompleter' [] HLS (either (const False) (const True) . V.pvp . V.prettyVer))
)
)
<|>
@@ -312,7 +311,7 @@ hlsCompileOpts =
)
(long "source-dist" <> metavar "VERSION" <> help
"The version to compile (pulled from packaged git sources)"
<> (completer $ versionCompleter Nothing HLS)
<> (completer $ versionCompleter [] HLS)
)
))
<|>
@@ -344,7 +343,7 @@ hlsCompileOpts =
)
(short 'o' <> long "overwrite-version" <> metavar "OVERWRITE_VERSION" <> help
"Allows to overwrite the finally installed VERSION with a different one, e.g. when you build 8.10.4 with your own patches, you might want to set this to '8.10.4-p1'"
<> (completer $ versionCompleter Nothing HLS)
<> (completer $ versionCompleter [] HLS)
)
)
<|>
@@ -404,7 +403,7 @@ hlsCompileOpts =
option (eitherReader ghcVersionTagEither)
( long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
<> completer (tagCompleter GHC [])
<> completer (versionCompleter Nothing GHC))
<> completer (versionCompleter [] GHC))
)
<*> many (argument str (metavar "CABAL_ARGS" <> help "Additional arguments to cabal install, prefix with '-- ' (longopts)"))
@@ -454,6 +453,7 @@ type HLSEffects = '[ AlreadyInstalled
, UnknownArchive
, TarDirDoesNotExist
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NotInstalled
@@ -512,7 +512,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
HLS.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer HLS dls
forM_ (view viPreCompile =<< vi) $ \msg -> do
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
"...waiting for 5 seconds, you can still abort..."
@@ -540,7 +540,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
VRight (vi, tv) -> do
runLogger $ logInfo
"HLS successfully compiled and installed"
forM_ (view viPostInstall =<< vi) $ \msg ->
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
liftIO $ putStr (T.unpack $ prettyVer tv)
pure ExitSuccess
@@ -564,7 +564,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
GHC.SourceDist targetVer -> do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let vi = getVersionInfo targetVer GHC dls
forM_ (view viPreCompile =<< vi) $ \msg -> do
forM_ (_viPreCompile =<< vi) $ \msg -> do
lift $ logInfo msg
lift $ logInfo
"...waiting for 5 seconds, you can still abort..."
@@ -594,7 +594,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
VRight (vi, tv) -> do
runLogger $ logInfo
"GHC successfully compiled and installed"
forM_ (view viPostInstall =<< vi) $ \msg ->
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
liftIO $ putStr (T.unpack $ tVerToText tv)
pure ExitSuccess

View File

@@ -23,7 +23,6 @@ import GHCup.Utils.Dirs
import GHCup.Prelude
import GHCup.Prelude.Logger
import GHCup.Prelude.String.QQ
import GHCup.Types.Optics
import Codec.Archive
#if !MIN_VERSION_base(4,13,0)
@@ -37,7 +36,6 @@ import Data.Maybe
import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Options.Applicative.Help.Pretty ( text )
import Optics
import Prelude hiding ( appendFile )
import System.Exit
import URI.ByteString hiding ( uriParser )
@@ -186,7 +184,7 @@ installOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool))
)
)
<*> (Just <$> toolVersionTagArgument Nothing tool)
<*> (Just <$> toolVersionTagArgument [] tool)
)
<|> pure (Nothing, Nothing)
)
@@ -243,6 +241,7 @@ type InstallEffects = '[ AlreadyInstalled
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
@@ -286,6 +285,7 @@ type InstallGHCEffects = '[ AlreadyInstalled
, NotInstalled
, ProcessError
, TagNotFound
, DayNotFound
, TarDirDoesNotExist
, UninstallFailed
, UnknownArchive
@@ -335,7 +335,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion instVer GHC
liftE $ runBothE' (installGHCBindist
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
(DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing Nothing)
(_tvVersion v)
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -347,7 +347,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case
VRight vi -> do
runLogger $ logInfo "GHC installation successful"
forM_ (view viPostInstall =<< vi) $ \msg ->
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
@@ -405,7 +405,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ runBothE' (installCabalBindist
(DownloadInfo uri Nothing "" Nothing)
(DownloadInfo uri Nothing "" Nothing Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -415,7 +415,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case
VRight vi -> do
runLogger $ logInfo "Cabal installation successful"
forM_ (view viPostInstall =<< vi) $ \msg ->
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -455,7 +455,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-- TODO: support legacy
liftE $ runBothE' (installHLSBindist
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
(DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -465,7 +465,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case
VRight vi -> do
runLogger $ logInfo "HLS installation successful"
forM_ (view viPostInstall =<< vi) $ \msg ->
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do
@@ -504,7 +504,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
runInstTool s'{ settings = settings { noVerify = True}} $ do
(_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
liftE $ runBothE' (installStackBindist
(DownloadInfo uri Nothing "" Nothing)
(DownloadInfo uri Nothing "" Nothing Nothing)
v
(maybe GHCupInternal IsolateDir isolateDir)
forceInstall
@@ -514,7 +514,7 @@ install installCommand settings getAppState' runLogger = case installCommand of
>>= \case
VRight vi -> do
runLogger $ logInfo "Stack installation successful"
forM_ (view viPostInstall =<< vi) $ \msg ->
forM_ (_viPostInstall =<< vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft e@(V (AlreadyInstalled _ _)) -> do

View File

@@ -2,6 +2,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
@@ -14,6 +15,7 @@ import GHCup
import GHCup.Prelude
import GHCup.Types
import GHCup.OptParse.Common
import GHCup.Prelude.String.QQ
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
@@ -24,6 +26,7 @@ import Data.Char
import Data.List ( intercalate, sort )
import Data.Functor
import Data.Maybe
import Data.Time.Calendar ( Day )
import Data.Versions hiding ( str )
import Data.Void
import Options.Applicative hiding ( style )
@@ -50,6 +53,10 @@ import qualified Text.Megaparsec.Char as MPC
data ListOptions = ListOptions
{ loTool :: Maybe Tool
, lCriteria :: Maybe ListCriteria
, lFrom :: Maybe Day
, lTo :: Maybe Day
, lHideOld :: Bool
, lShowNightly :: Bool
, lRawFormat :: Bool
}
@@ -60,7 +67,6 @@ data ListOptions = ListOptions
--[ Parsers ]--
---------------
listOpts :: Parser ListOptions
listOpts =
ListOptions
@@ -69,7 +75,7 @@ listOpts =
(eitherReader toolParser)
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help
"Tool to list versions for. Default is all"
<> completer (toolCompleter)
<> completer toolCompleter
)
)
<*> optional
@@ -78,15 +84,53 @@ listOpts =
( short 'c'
<> long "show-criteria"
<> metavar "<installed|set|available>"
<> help "Show only installed/set/available tool versions"
<> completer (listCompleter ["installed", "set", "available"])
<> help "Apply filtering criteria, prefix with + or -"
<> completer (listCompleter
[ "+installed", "+set", "+available", "-installed", "-set", "-available"])
)
)
<*> optional
(option
(eitherReader dayParser)
(short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date starting at YYYY-MM-DD or later"
<> completer toolCompleter
)
)
<*> optional
(option
(eitherReader dayParser)
(short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help
"List only tools with release date earlier than YYYY-MM-DD"
<> completer toolCompleter
)
)
<*> switch
(short 'o' <> long "hide-old" <> help "Hide 'old' GHC versions (installed ones are always shown)"
)
<*> switch
(short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"
)
<*> switch
(short 'r' <> long "raw-format" <> help "More machine-parsable format"
)
--------------
--[ Footer ]--
--------------
listToolFooter :: String
listToolFooter = [s|Discussion:
Lists tool versions with optional criteria.
Nightlies are by default hidden.
Examples:
# query nightlies in a specific range
ghcup list --show-nightly --since 2022-12-07 --until 2022-12-31
# show all installed GHC versions
ghcup list -t ghc -c installed|]
-----------------
@@ -105,9 +149,11 @@ printListResult no_color raw lr = do
printTag Recommended = color Green "recommended"
printTag Latest = color Yellow "latest"
printTag Prerelease = color Red "prerelease"
printTag Nightly = color Red "nightly"
printTag (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
printTag (UnknownTag t ) = t
printTag LatestPrerelease = color Red "latest-prerelease"
printTag LatestNightly = color Red "latest-nightly"
printTag Old = ""
let
@@ -136,6 +182,9 @@ printListResult no_color raw lr = do
)
++ (if fromSrc then [color Blue "compiled"] else mempty)
++ (if lStray then [color Yellow "stray"] else mempty)
++ (case lReleaseDay of
Nothing -> mempty
Just d -> [color Blue (show d)])
++ (if lNoBindist
then [color Red "no-bindist"]
else mempty
@@ -260,7 +309,7 @@ list :: ( Monad m
-> m ExitCode
list ListOptions{..} no_color runAppState =
runAppState (do
l <- listVersions loTool lCriteria
l <- listVersions loTool (maybeToList lCriteria) lHideOld lShowNightly (lFrom, lTo)
liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess
)

View File

@@ -76,8 +76,8 @@ nuke appState runLogger = do
lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ logInfo "Nuking in 3...2...1"
lInstalled <- lift $ listVersions Nothing (Just ListInstalled)
lInstalled <- lift $ listVersions Nothing [ListInstalled True] False True (Nothing, Nothing)
forM_ lInstalled (liftE . rmTool)

View File

@@ -83,7 +83,7 @@ prefetchP = subparser
<$> (PrefetchGHCOptions
<$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
<*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> optional (toolVersionTagArgument Nothing (Just GHC)) )
<*> optional (toolVersionTagArgument [] (Just GHC)) )
( progDesc "Download GHC assets for installation")
)
<>
@@ -92,7 +92,7 @@ prefetchP = subparser
(info
(PrefetchCabal
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
<*> ( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper ))
( progDesc "Download cabal assets for installation")
)
<>
@@ -101,7 +101,7 @@ prefetchP = subparser
(info
(PrefetchHLS
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
<*> ( optional (toolVersionTagArgument [] (Just HLS)) <**> helper ))
( progDesc "Download HLS assets for installation")
)
<>
@@ -110,7 +110,7 @@ prefetchP = subparser
(info
(PrefetchStack
<$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
<*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
<*> ( optional (toolVersionTagArgument [] (Just Stack)) <**> helper ))
( progDesc "Download stack assets for installation")
)
<>
@@ -148,6 +148,7 @@ Examples:
type PrefetchEffects = '[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, NoDownload

View File

@@ -3,6 +3,7 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
@@ -33,7 +34,6 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Optics
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
@@ -80,19 +80,19 @@ rmParser =
<> command
"cabal"
( RmCabal
<$> info (versionParser' (Just ListInstalled) (Just Cabal) <**> helper)
<$> info (versionParser' [ListInstalled True] (Just Cabal) <**> helper)
(progDesc "Remove Cabal version")
)
<> command
"hls"
( RmHLS
<$> info (versionParser' (Just ListInstalled) (Just HLS) <**> helper)
<$> info (versionParser' [ListInstalled True] (Just HLS) <**> helper)
(progDesc "Remove haskell-language-server version")
)
<> command
"stack"
( RmStack
<$> info (versionParser' (Just ListInstalled) (Just Stack) <**> helper)
<$> info (versionParser' [ListInstalled True] (Just Stack) <**> helper)
(progDesc "Remove stack version")
)
)
@@ -102,7 +102,7 @@ rmParser =
rmOpts :: Maybe Tool -> Parser RmOptions
rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
rmOpts tool = RmOptions <$> ghcVersionArgument [ListInstalled True] tool
@@ -227,5 +227,5 @@ rm rmCommand runAppState runLogger = case rmCommand of
pure $ ExitFailure 15
postRmLog vi =
forM_ (view viPostRemove =<< vi) $ \msg ->
forM_ (_viPostRemove =<< vi) $ \msg ->
runLogger $ logInfo msg

View File

@@ -92,7 +92,7 @@ runOpts =
(eitherReader ghcVersionTagEither)
(metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
<> completer (tagCompleter GHC [])
<> (completer $ versionCompleter Nothing GHC)
<> (completer $ versionCompleter [] GHC)
)
)
<*> optional
@@ -100,7 +100,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
<> completer (tagCompleter Cabal [])
<> (completer $ versionCompleter Nothing Cabal)
<> (completer $ versionCompleter [] Cabal)
)
)
<*> optional
@@ -108,7 +108,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
<> completer (tagCompleter HLS [])
<> (completer $ versionCompleter Nothing HLS)
<> (completer $ versionCompleter [] HLS)
)
)
<*> optional
@@ -116,7 +116,7 @@ runOpts =
(eitherReader toolVersionTagEither)
(metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
<> completer (tagCompleter Stack [])
<> (completer $ versionCompleter Nothing Stack)
<> (completer $ versionCompleter [] Stack)
)
)
<*> optional
@@ -132,7 +132,7 @@ runOpts =
<*> switch
(short 'q' <> long "quick" <> help "Avoid any expensive work (such as downloads, version/tag resolution etc.). Disables --install.")
<*> many (argument str (metavar "COMMAND" <> help "The command to run, with arguments (use longopts --). If omitted, just prints the created bin/ dir to stdout and exits."))
@@ -175,6 +175,7 @@ type RunEffects = '[ AlreadyInstalled
, NotInstalled
, BuildFailed
, TagNotFound
, DayNotFound
, DigestError
, ContentLengthError
, GPGError
@@ -282,6 +283,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
)
=> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] (ResourceT (ReaderT AppState m)) Toolchain
@@ -332,6 +334,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
-> FilePath
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
, UnknownArchive

View File

@@ -139,9 +139,9 @@ setParser =
setOpts :: Tool -> Parser SetOptions
setOpts tool = SetOptions <$>
(fromMaybe SetRecommended <$>
optional (setVersionArgument (Just ListInstalled) tool))
optional (setVersionArgument [ListInstalled True] tool))
setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
setVersionArgument :: [ListCriteria] -> Tool -> Parser SetToolVersion
setVersionArgument criteria tool =
argument (eitherReader setEither)
(metavar "VERSION|TAG|next"
@@ -184,6 +184,7 @@ setFooter = [s|Discussion:
type SetGHCEffects = '[ FileDoesNotExistError
, NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -198,6 +199,7 @@ runSetGHC runAppState =
type SetCabalEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -212,6 +214,7 @@ runSetCabal runAppState =
type SetHLSEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]
@@ -226,6 +229,7 @@ runSetHLS runAppState =
type SetStackEffects = '[ NotInstalled
, TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet]

View File

@@ -112,7 +112,7 @@ testOpts tool =
<> completer (toolDlCompleter (fromMaybe GHC tool))
)
)
<*> (Just <$> toolVersionTagArgument Nothing tool)
<*> (Just <$> toolVersionTagArgument [] tool)
)
<|> pure (Nothing, Nothing)
)
@@ -140,6 +140,7 @@ type TestGHCEffects = [ DigestError
, TestFailed
, NextVerNotFound
, TagNotFound
, DayNotFound
, NoToolVersionSet
]
@@ -173,7 +174,7 @@ test testCommand settings getAppState' runLogger = case testCommand of
Just uri -> do
runTestGHC s'{ settings = settings {noVerify = True}} $ do
(v, vi) <- liftE $ fromVersion testVer GHC
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs
liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing Nothing) (_tvVersion v) addMakeArgs
pure vi
)
>>= \case

View File

@@ -28,7 +28,6 @@ import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile )
import System.Exit
import Optics ( view )
import qualified Data.Text as T
import Control.Exception.Safe (MonadMask)
@@ -145,7 +144,7 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ logInfo $
"Successfully upgraded GHCup to version " <> pretty_v
forM_ (view viPostInstall vi) $ \msg ->
forM_ (_viPostInstall vi) $ \msg ->
runLogger $ logInfo msg
pure ExitSuccess
VLeft (V NoUpdate) -> do

View File

@@ -82,7 +82,7 @@ whereisP = subparser
command
"ghc"
(WhereisTool GHC <$> info
( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
( optional (toolVersionTagArgument [] (Just GHC)) <**> helper )
( progDesc "Get GHC location"
<> footerDoc (Just $ text whereisGHCFooter ))
)
@@ -90,7 +90,7 @@ whereisP = subparser
command
"cabal"
(WhereisTool Cabal <$> info
( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
( optional (toolVersionTagArgument [] (Just Cabal)) <**> helper )
( progDesc "Get cabal location"
<> footerDoc (Just $ text whereisCabalFooter ))
)
@@ -98,7 +98,7 @@ whereisP = subparser
command
"hls"
(WhereisTool HLS <$> info
( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
( optional (toolVersionTagArgument [] (Just HLS)) <**> helper )
( progDesc "Get HLS location"
<> footerDoc (Just $ text whereisHLSFooter ))
)
@@ -106,7 +106,7 @@ whereisP = subparser
command
"stack"
(WhereisTool Stack <$> info
( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
( optional (toolVersionTagArgument [] (Just Stack)) <**> helper )
( progDesc "Get stack location"
<> footerDoc (Just $ text whereisStackFooter ))
)
@@ -222,6 +222,7 @@ type WhereisEffects = '[ NotInstalled
, NoToolVersionSet
, NextVerNotFound
, TagNotFound
, DayNotFound
]

View File

@@ -240,7 +240,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
_
| Just False <- optVerbose -> pure ()
| otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, DayNotFound, NextVerNotFound, NoToolVersionSet] $ do
newTools <- lift checkForUpdates
forM_ newTools $ \newTool@(t, l) -> do
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
@@ -335,6 +335,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
-> (Tool, Version)
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool
@@ -370,6 +371,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
-> Version
-> Excepts
'[ TagNotFound
, DayNotFound
, NextVerNotFound
, NoToolVersionSet
] m Bool

View File

@@ -9,7 +9,7 @@ constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0
package libarchive
flags: +system-libarchive
flags: -system-libarchive
package aeson-pretty
flags: +lib-only

View File

@@ -203,6 +203,34 @@ url-source:
- "https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
```
### Nightlies
Nightlies are just a nother release channel. Currently, only GHC supports nightlies, which are binary releases
that are built every night from `master`.
To add the nightly channel, run:
```sh
ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
```
To list all nightlies from 2023, run:
```sh
ghcup list --show-nightly --tool=ghc --since=2023-01-01
```
Ways to install a nightly:
```sh
# by date
ghcup install ghc 2023-06-20
# by version
ghcup install ghc 9.7.20230619
# by tag
ghcup install ghc latest-nightly
```
## Stack integration
Stack manages GHC versions internally by default. In order to make it use ghcup installed
@@ -461,7 +489,7 @@ this is cryptographically secure.
First, obtain the gpg keys:
```sh
gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
```

View File

@@ -77,6 +77,8 @@ On Darwin M1 you might also need a working llvm installed (e.g. via brew) and ha
The following distro packages are required: `curl gcc gmp gmake ncurses perl5 libffi libiconv`
Notice that only FreeBSD 13.x is supported. If the installation fails, complaining about `libncursesw.8.so`, you will need to install FreeBSD 12 compat package first, for example, `pkg install misc/compat12x`.
### Windows
On Windows, msys2 should already have been set up during the installation, so most users should just proceed. If you are installing manually, make sure to have a working mingw64 toolchain and shell.
@@ -102,9 +104,13 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>9.4.3</td><td><span style="color:blue">latest</span>, base-4.17.0.0</td></tr>
<tr><td>9.6.1</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
<tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
@@ -143,7 +149,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Cabal Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>3.8.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.10.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>3.8.1.0</td><td></td></tr>
<tr><td>3.6.2.0</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>3.6.0.0</td><td></td></tr>
<tr><td>3.4.1.0</td><td></td></tr>
@@ -159,7 +166,9 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>1.8.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>1.9.1.0</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>1.9.0.0</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>1.8.0.0</td><td></td></tr>
<tr><td>1.7.0.0</td><td></td></tr>
<tr><td>1.6.1.0</td><td></td></tr>
<tr><td>1.6.0.0</td><td></td></tr>
@@ -177,7 +186,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table>
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
<tbody>
<tr><td>2.9.1</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.9.3</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>2.9.1</td><td></td></tr>
<tr><td>2.7.5</td><td></td></tr>
<tr><td>2.7.3</td><td></td></tr>
<tr><td>2.7.1</td><td></td></tr>
@@ -231,8 +241,9 @@ There are various issues with GHC itself.
### FreeBSD
Lacks some upstream bindists and may need compat libs, since most bindists are built on FreeBSD-12.
Lacks some upstream bindists and may need compat libs (such as `misc/compat12x`).
HLS bindists are experimental.
Only latest FreeBSD is generally supported.
### Linux ARMv7/AARCH64
@@ -245,7 +256,7 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
and place it into your `PATH` anywhere.
If you want to GPG verify the binaries, import the following keys first: `7784930957807690A66EBDBE3786C5262ECB4A3F` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
If you want to GPG verify the binaries, import the following keys first: `7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:

View File

@@ -1,6 +1,6 @@
cabal-version: 2.4
name: ghcup
version: 0.1.19.2
version: 0.1.19.3
license: LGPL-3.0-only
license-file: LICENSE
copyright: Julian Ospald 2020
@@ -137,7 +137,7 @@ library
, pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96
, resourcet ^>=1.2.2
, retry ^>=0.8.1.2
, retry ^>=0.8.1.2 || ^>=0.9
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, split ^>=0.2.3.4
@@ -146,7 +146,7 @@ library
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, time ^>=1.9.3
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, transformers ^>=0.5
, unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0
@@ -258,7 +258,6 @@ executable ghcup
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optics ^>=0.4
, optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
@@ -270,6 +269,7 @@ executable ghcup
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
@@ -336,6 +336,7 @@ test-suite ghcup-test
, QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0
, streamly ^>=0.8.2
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, text ^>=2.0
, uri-bytestring ^>=0.3.2.2
, versions >=4.0.1 && <5.1

View File

@@ -177,7 +177,7 @@ installCabalBin :: ( MonadMask m
, MonadUnliftIO m
, MonadFail m
)
=> VersionRev
=> Version
-> InstallDir
-> Bool -- force install
-> Excepts
@@ -198,7 +198,7 @@ installCabalBin :: ( MonadMask m
()
installCabalBin ver installDir forceInstall = do
dlinfo <- liftE $ getDownloadInfo Cabal ver
installCabalBindist dlinfo (vVersion ver) installDir forceInstall
installCabalBindist dlinfo ver installDir forceInstall
-----------------

View File

@@ -277,19 +277,19 @@ getDownloadInfo :: ( MonadReader env m
, HasGHCupInfo env
)
=> Tool
-> VersionRev
-> Version
-- ^ tool version
-> Excepts
'[NoDownload]
m
DownloadInfo
getDownloadInfo t (VersionRev v vr) = do
getDownloadInfo t v = do
(PlatformRequest a p mv) <- lift getPlatformReq
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let distro_preview f g =
let platformVersionSpec =
preview (ix t % ix v % viDownload % ix vr % viArch % ix a % ix (f p)) dls
preview (ix t % ix v % viArch % ix a % ix (f p)) dls
mv' = g mv
in fmap snd
. find
@@ -633,7 +633,9 @@ downloadCached dli mfn = do
True -> downloadCached' dli mfn Nothing
False -> do
tmp <- lift withGHCupTmpDir
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) (fromGHCupPath tmp) outputFileName False
where
outputFileName = mfn <|> _dlOutput dli
downloadCached' :: ( MonadReader env m
@@ -652,7 +654,7 @@ downloadCached' :: ( MonadReader env m
downloadCached' dli mfn mDestDir = do
Dirs { cacheDir } <- lift getDirs
let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) mfn
let fn = fromMaybe ((T.unpack . decUTF8Safe) $ urlBaseName $ view (dlUri % pathL') dli) outputFileName
let cachfile = destDir </> fn
fileExists <- liftIO $ doesFileExist cachfile
if
@@ -660,7 +662,9 @@ downloadCached' dli mfn mDestDir = do
forM_ (view dlCSize dli) $ \s -> liftE $ checkCSize s cachfile
liftE $ checkDigest (view dlHash dli) cachfile
pure cachfile
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir mfn False
| otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (_dlCSize dli) destDir outputFileName False
where
outputFileName = mfn <|> _dlOutput dli

View File

@@ -38,6 +38,7 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import Data.Data (Proxy(..))
import Data.Time (Day)
@@ -59,6 +60,7 @@ allHFError = unlines allErrors
, let proxy = Proxy :: Proxy CopyError in format proxy
, let proxy = Proxy :: Proxy MergeFileTreeError in format proxy
, let proxy = Proxy :: Proxy TagNotFound in format proxy
, let proxy = Proxy :: Proxy DayNotFound in format proxy
, let proxy = Proxy :: Proxy NextVerNotFound in format proxy
, let proxy = Proxy :: Proxy AlreadyInstalled in format proxy
, let proxy = Proxy :: Proxy DirNotEmpty in format proxy
@@ -311,6 +313,21 @@ instance HFErrorProject TagNotFound where
eBase _ = 90
eDesc _ = "Unable to find a tag of a tool"
-- | Unable to find a release day of a tool
data DayNotFound = DayNotFound Day Tool (Maybe Day)
deriving Show
instance Pretty DayNotFound where
pPrint (DayNotFound day tool Nothing) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool
pPrint (DayNotFound day tool (Just alternateDay)) =
text "Unable to find release date" <+> text (show day) <+> text "of tool" <+> pPrint tool <+>
text "but found an alternative date" <+> text (show alternateDay)
instance HFErrorProject DayNotFound where
eBase _ = 95
eDesc _ = "Unable to find a release date of a tool"
-- | Unable to find the next version of a tool (the one after the currently
-- set one).
data NextVerNotFound = NextVerNotFound Tool

View File

@@ -78,7 +78,6 @@ import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
import qualified Data.Map.Strict as M
data GHCVer v = SourceDist v
@@ -106,7 +105,7 @@ testGHCVer :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> VersionRev
=> Version
-> [T.Text]
-> Excepts
'[ DigestError
@@ -121,11 +120,11 @@ testGHCVer :: ( MonadFail m
]
m
()
testGHCVer (VersionRev ver vr) addMakeArgs = do
testGHCVer ver addMakeArgs = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <-
preview (ix GHC % ix ver % viDownload % to M.toAscList % maybe _last ix vr % to snd % viTestDL % _Just) dls
preview (ix GHC % ix ver % viTestDL % _Just) dls
?? NoDownload
liftE $ testGHCBindist dlInfo ver addMakeArgs
@@ -244,7 +243,7 @@ fetchGHCSrc :: ( MonadFail m
, MonadIO m
, MonadUnliftIO m
)
=> VersionRev
=> Version
-> Maybe FilePath
-> Excepts
'[ DigestError
@@ -255,10 +254,10 @@ fetchGHCSrc :: ( MonadFail m
]
m
FilePath
fetchGHCSrc (VersionRev v vr) mfp = do
fetchGHCSrc v mfp = do
GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
dlInfo <-
preview (ix GHC % ix v % viDownload % to M.toAscList % maybe _last ix vr % to snd % viSourceDL % _Just) dls
preview (ix GHC % ix v % viSourceDL % _Just) dls
?? NoDownload
liftE $ downloadCached' dlInfo Nothing mfp
@@ -805,7 +804,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
-- download source tarball
dlInfo <-
preview (ix GHC % ix (tver ^. tvVersion) % viDownload % _last % viSourceDL % _Just) dls
preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing

View File

@@ -368,7 +368,7 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
-- download source tarball
dlInfo <-
preview (ix HLS % ix tver % viDownload % _last % viSourceDL % _Just) dls
preview (ix HLS % ix tver % viSourceDL % _Just) dls
?? NoDownload
dl <- liftE $ downloadCached dlInfo Nothing

View File

@@ -36,6 +36,7 @@ import Data.Either
import Data.List
import Data.Maybe
import Data.Text ( Text )
import Data.Time.Calendar ( Day )
import Data.Versions hiding ( patch )
import Haskus.Utils.Variant.Excepts
import Optics
@@ -61,9 +62,9 @@ import qualified Data.Text as T
-- | Filter data type for 'listVersions'.
data ListCriteria = ListInstalled
| ListSet
| ListAvailable
data ListCriteria = ListInstalled Bool
| ListSet Bool
| ListAvailable Bool
deriving Show
-- | A list result describes a single tool version
@@ -79,6 +80,7 @@ data ListResult = ListResult
, lStray :: Bool -- ^ not in download info
, lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
, hlsPowered :: Bool
, lReleaseDay :: Maybe Day
}
deriving (Eq, Ord, Show)
@@ -93,19 +95,22 @@ availableToolVersions av tool = view
-- | List all versions from the download info, as well as stray
-- versions.
listVersions :: ( MonadCatch m
, HasLog env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
)
=> Maybe Tool
-> Maybe ListCriteria
-> m [ListResult]
listVersions lt' criteria = do
, HasLog env
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasPlatformReq env
, HasGHCupInfo env
)
=> Maybe Tool
-> [ListCriteria]
-> Bool
-> Bool
-> (Maybe Day, Maybe Day)
-> m [ListResult]
listVersions lt' criteria hideOld showNightly days = do
-- some annoying work to avoid too much repeated IO
cSet <- cabalSet
cabals <- getInstalledCabals
@@ -172,8 +177,9 @@ listVersions lt' criteria = do
, lCross = Nothing
, lTag = []
, lInstalled = True
, lStray = isNothing (Map.lookup _tvVersion avTools)
, lStray = isNothing (Map.lookup _tvVersion avTools)
, lNoBindist = False
, lReleaseDay = Nothing
, ..
}
Right tver@GHCTargetVersion{ .. } -> do
@@ -188,6 +194,7 @@ listVersions lt' criteria = do
, lInstalled = True
, lStray = True -- NOTE: cross currently cannot be installed via bindist
, lNoBindist = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -223,6 +230,7 @@ listVersions lt' criteria = do
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -257,6 +265,7 @@ listVersions lt' criteria = do
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -292,6 +301,7 @@ listVersions lt' criteria = do
, lNoBindist = False
, fromSrc = False -- actually, we don't know :>
, hlsPowered = False
, lReleaseDay = Nothing
, ..
}
Left e -> do
@@ -308,7 +318,7 @@ listVersions lt' criteria = do
isOld = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
in if | Map.member currentVer av -> Nothing
| otherwise -> Just $ ListResult { lVer = currentVer
, lTag = maybe (if isOld then [Old] else []) (view viTags) listVer
, lTag = maybe (if isOld then [Old] else []) _viTags listVer
, lCross = Nothing
, lTool = GHCup
, fromSrc = False
@@ -317,6 +327,7 @@ listVersions lt' criteria = do
, lInstalled = True
, lNoBindist = False
, hlsPowered = False
, lReleaseDay = Nothing
}
-- NOTE: this are not cross ones, because no bindists
@@ -337,8 +348,7 @@ listVersions lt' criteria = do
-> [Either FilePath Version]
-> (Version, VersionInfo)
-> m ListResult
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, vi) = do
let tags = view viTags vi
toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, VersionInfo{..}) = do
case t of
GHC -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
@@ -347,31 +357,33 @@ listVersions lt' criteria = do
lInstalled <- ghcInstalled tver
fromSrc <- ghcSrcInstalled tver
hlsPowered <- fmap (elem v) hlsGHCVersions
pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
pure ListResult { lVer = v, lCross = Nothing , lTag = _viTags, lTool = t, lStray = False, lReleaseDay = _viReleaseDay, .. }
Cabal -> do
lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
let lSet = cSet == Just v
let lInstalled = elem v $ rights cabals
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
GHCup -> do
let lSet = prettyPVP ghcUpVer == prettyVer v
let lInstalled = lSet
pure ListResult { lVer = v
, lTag = tags
, lTag = _viTags
, lCross = Nothing
, lTool = t
, fromSrc = False
, lStray = False
, lNoBindist = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
HLS -> do
@@ -380,11 +392,12 @@ listVersions lt' criteria = do
let lInstalled = elem v $ rights hlses
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
Stack -> do
@@ -393,19 +406,43 @@ listVersions lt' criteria = do
let lInstalled = elem v $ rights stacks
pure ListResult { lVer = v
, lCross = Nothing
, lTag = tags
, lTag = _viTags
, lTool = t
, fromSrc = False
, lStray = False
, hlsPowered = False
, lReleaseDay = _viReleaseDay
, ..
}
filter' :: [ListResult] -> [ListResult]
filter' lr = case criteria of
Nothing -> lr
Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
Just ListSet -> filter (\ListResult {..} -> lSet) lr
Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
filter' = filterNightly . filterOld . filter (\lr -> foldr (\a b -> fromCriteria a lr && b) True criteria) . filterDays
filterDays :: [ListResult] -> [ListResult]
filterDays lrs = case days of
(Nothing, Nothing) -> lrs
(Just from, Just to') -> filter (\ListResult{..} -> maybe False (\d -> d >= from && d <= to') lReleaseDay) lrs
(Nothing, Just to') -> filter (\ListResult{..} -> maybe False (<= to') lReleaseDay) lrs
(Just from, Nothing) -> filter (\ListResult{..} -> maybe False (>= from) lReleaseDay) lrs
fromCriteria :: ListCriteria -> ListResult -> Bool
fromCriteria lc ListResult{..} = case lc of
ListInstalled b -> f b lInstalled
ListSet b -> f b lSet
ListAvailable b -> f b $ not lNoBindist
where
f b
| b = id
| otherwise = not
filterOld :: [ListResult] -> [ListResult]
filterOld lr
| hideOld = filter (\ListResult {..} -> lInstalled || Old `notElem` lTag) lr
| otherwise = lr
filterNightly :: [ListResult] -> [ListResult]
filterNightly lr
| showNightly = lr
| otherwise = filter (\ListResult {..} -> lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)) lr

View File

@@ -77,8 +77,14 @@ runBothE' a1 a2 = do
(_ , VLeft e ) -> throwSomeE e
(VRight _, VRight _) -> pure ()
-- "throwSomeE" function has been upstreamed in haskus-utils-variant-3.3
-- So, only conditionally include this shim if
-- haskus-utils-variant version is < 3.3
#if MIN_VERSION_haskus_utils_variant(3,3,0)
#else
-- | Throw some exception
throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
{-# INLINABLE throwSomeE #-}
throwSomeE = Excepts . pure . VLeft . liftVariant
#endif

View File

@@ -28,8 +28,6 @@ import System.FilePath
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Text.Megaparsec as MP
import Data.Char (digitToInt)
import Data.Data (Proxy(..))
choice' :: (MonadFail f, MP.MonadParsec e s f) => [f a] -> f a
@@ -88,33 +86,7 @@ ghcTargetVerP =
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
<|> ((\ _ x -> x) Nothing <$> mempty)
)
<*> version'
where
verP' :: MP.Parsec Void Text Text
verP' = do
v <- version'
let startsWithDigists =
and
. take 3
. concatMap
(map
(\case
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. NE.toList
$ _vChunks v
if startsWithDigists && isNothing (_vEpoch v)
then pure $ prettyVer v
else fail "Oh"
ghcTargetVerRevP :: MP.Parsec Void Text GHCTargetVersionRev
ghcTargetVerRevP =
(\x y -> GHCTargetVersionRev x y)
<$> (MP.try (Just <$> parseUntil1 (MP.chunk "-" *> verP') <* MP.chunk "-")
<|> ((\ _ x -> x) Nothing <$> mempty)
)
<*> versionRevP
<*> (version' <* MP.eof)
where
verP' :: MP.Parsec Void Text Text
verP' = do
@@ -150,44 +122,3 @@ verP suffix = do
pathSep :: MP.Parsec Void Text Char
pathSep = MP.oneOf pathSeparators
versionRevP :: MP.Parsec Void Text VersionRev
versionRevP = MP.label "versionRev" $
MP.try (parseUntil (MP.try (MP.chunk "-r")) >>= versionWithRev) <|> ((`VersionRev` 0) <$> version')
where
versionWithRev ver = do
rest <- MP.getInput
MP.setInput ver
v <- version'
MP.setInput rest
_ <- MP.chunk "-r"
rev <- parseInt
pure $ VersionRev v rev
digit = MP.oneOf ['0'..'9'] MP.<?> "digit"
parseInt :: MP.Parsec Void Text Int
parseInt = MP.label "parseInt" $ do
i <- MP.tokensToChunk (Proxy :: Proxy Text) <$> some digit
pure $ numberValue 10 $ T.unpack i
numberValue :: Int -> String -> Int
numberValue base = foldl (\ x -> ((fromIntegral base * x) +) . fromIntegral . digitToInt) 0
userVersionRevP :: MP.Parsec Void Text UserVersionRev
userVersionRevP = MP.label "userVersionRev" $
((\(VersionRev v r) -> UserVersionRev v (Just r)) <$> MP.try versionRevP) <|> ((`UserVersionRev` Nothing) <$> version')
-- | Read a @VersionRev@ from a String.
--
-- - 3.3.2 -> VersionRev { vVersion = 3.3.3, vRev = 0 }
-- - 2.3.4-r3 -> VersionRev { vVersion = 2.3.4, vRev = 3 }
versionRev :: Text -> Either (MP.ParseErrorBundle Text Void) VersionRev
versionRev = MP.parse versionRevP ""
-- | Read a @UserVersionRev@ from a String.
--
-- - 3.3.2 -> UserVersionRev { vVersion = 3.3.3, vRev = Nothing }
-- - 2.3.4-r3 -> UserVersionRev { vVersion = 2.3.4, vRev = Just 3 }
userVersionRev :: Text -> Either (MP.ParseErrorBundle Text Void) UserVersionRev
userVersionRev = MP.parse userVersionRevP ""

View File

@@ -31,6 +31,7 @@ import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
import Control.DeepSeq ( NFData, rnf )
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Time.Calendar ( Day )
import Data.Text ( Text )
import Data.Versions
import GHC.IO.Exception ( ExitCode )
@@ -44,8 +45,6 @@ import Graphics.Vty ( Key(..) )
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified GHC.Generics as GHC
import qualified Data.Map.Strict as M
#if !defined(BRICK)
@@ -138,19 +137,7 @@ instance NFData GlobalTool
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viChangeLog :: Maybe URI
, _viDownload :: Map Int VersionDownload
-- informative messages
, _viPostInstall :: Maybe Text
, _viPostRemove :: Maybe Text
, _viPreCompile :: Maybe Text
}
deriving (Eq, GHC.Generic, Show)
instance NFData VersionInfo
data VersionInfoLegacy = VersionInfoLegacy
{ _viTags :: [Tag] -- ^ version specific tag
, _viReleaseDay :: Maybe Day
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
@@ -162,47 +149,7 @@ data VersionInfoLegacy = VersionInfoLegacy
}
deriving (Eq, GHC.Generic, Show)
data VersionDownload = VersionDownload
{ _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
}
deriving (Eq, GHC.Generic, Show)
instance NFData VersionDownload
fromVersionInfoLegacy :: VersionInfoLegacy -> VersionInfo
fromVersionInfoLegacy VersionInfoLegacy{..} =
VersionInfo {_viDownload = M.singleton 0 $ VersionDownload { _viSourceDL = _viSourceDL
, _viTestDL = _viTestDL
, _viArch = _viArch
}
, ..}
-- | A version with a revision, denoting bindist 'versions' that are purely distribution specific.
--
-- The revision starts at 0.
data VersionRev = VersionRev { vVersion :: Version, vRev :: Int }
deriving (Ord, Eq, GHC.Generic, Show)
showVersionRev :: VersionRev -> Text
showVersionRev (VersionRev v 0) = prettyVer v
showVersionRev (VersionRev v r) = prettyVer v <> "-r" <> T.pack (show r)
-- | Similar to @VersionRev@, except that revision is optional. The absence of a revision has
-- a particular meaning:
--
-- * for install/prefetch: we want the latest available revision
-- * for compile: it depends
-- * for rm/set/unset/whereis/changelog: we want the revision that is installed (there can be only one)
--
-- Translating @UserVersionRev@ to @VersionRev@ requires context of the GHCup metadata,
-- installed versions and the to be executed command.
data UserVersionRev = UserVersionRev { uvVersion :: Version, uvRev :: Maybe Int }
deriving (Ord, Eq, GHC.Generic, Show)
instance NFData VersionInfo
-- | A tag. These are currently attached to a version of a tool.
@@ -210,6 +157,8 @@ data Tag = Latest
| Recommended
| Prerelease
| LatestPrerelease
| Nightly
| LatestNightly
| Base PVP
| Old -- ^ old versions are hidden by default in TUI
| UnknownTag String -- ^ used for upwardscompat
@@ -221,18 +170,22 @@ tagToString :: Tag -> String
tagToString Recommended = "recommended"
tagToString Latest = "latest"
tagToString Prerelease = "prerelease"
tagToString Nightly = "nightly"
tagToString (Base pvp'') = "base-" ++ T.unpack (prettyPVP pvp'')
tagToString (UnknownTag t ) = t
tagToString LatestPrerelease = "latest-prerelease"
tagToString LatestNightly = "latest-nightly"
tagToString Old = ""
instance Pretty Tag where
pPrint Recommended = text "recommended"
pPrint Latest = text "latest"
pPrint Prerelease = text "prerelease"
pPrint Nightly = text "nightly"
pPrint (Base pvp'') = text ("base-" ++ T.unpack (prettyPVP pvp''))
pPrint (UnknownTag t ) = text t
pPrint LatestPrerelease = text "latest-prerelease"
pPrint LatestNightly = text "latest-prerelease"
pPrint Old = mempty
data Architecture = A_64
@@ -322,6 +275,7 @@ data DownloadInfo = DownloadInfo
, _dlSubdir :: Maybe TarDir
, _dlHash :: Text
, _dlCSize :: Maybe Integer
, _dlOutput :: Maybe FilePath
}
deriving (Eq, Ord, GHC.Generic, Show)
@@ -641,6 +595,12 @@ data GHCTargetVersion = GHCTargetVersion
}
deriving (Ord, Eq, Show)
data GitBranch = GitBranch
{ ref :: String
, repo :: Maybe String
}
deriving (Ord, Eq, Show)
mkTVer :: Version -> GHCTargetVersion
mkTVer = GHCTargetVersion Nothing
@@ -648,30 +608,10 @@ tVerToText :: GHCTargetVersion -> Text
tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
tVerToText (GHCTargetVersion Nothing v') = prettyVer v'
-- | A GHC identified by the target platform triple
-- and the version.
data GHCTargetVersionRev = GHCTargetVersionRev
{ _tvTargetRev :: Maybe Text
, _tvVersionRev :: VersionRev
}
deriving (Ord, Eq, Show)
mkTVerRev :: VersionRev -> GHCTargetVersionRev
mkTVerRev = GHCTargetVersionRev Nothing
tVerRevToText :: GHCTargetVersionRev -> Text
tVerRevToText (GHCTargetVersionRev (Just t) v') = t <> "-" <> showVersionRev v'
tVerRevToText (GHCTargetVersionRev Nothing v') = showVersionRev v'
-- | Assembles a path of the form: <target-triple>-<version>
instance Pretty GHCTargetVersion where
pPrint = text . T.unpack . tVerToText
data GitBranch = GitBranch
{ ref :: String
, repo :: Maybe String
}
deriving (Ord, Eq, Show)
-- | A comparator and a version.
data VersionCmp = VR_gt Versioning
@@ -763,3 +703,18 @@ type PromptQuestion = Text
data PromptResponse = PromptYes | PromptNo
deriving (Show, Eq)
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
| ToolDay Day
instance Pretty ToolVersion where
pPrint (GHCVersion v) = pPrint v
pPrint (ToolVersion v) = pPrint v
pPrint (ToolTag t) = pPrint t
pPrint (ToolDay d) = text (show d)

View File

@@ -64,9 +64,11 @@ instance ToJSON Tag where
toJSON Latest = String "Latest"
toJSON Recommended = String "Recommended"
toJSON Prerelease = String "Prerelease"
toJSON Nightly = String "Nightly"
toJSON Old = String "old"
toJSON (Base pvp'') = String ("base-" <> prettyPVP pvp'')
toJSON LatestPrerelease = String "LatestPrerelease"
toJSON LatestNightly = String "LatestNightly"
toJSON (UnknownTag x ) = String (T.pack x)
instance FromJSON Tag where
@@ -74,7 +76,9 @@ instance FromJSON Tag where
"Latest" -> pure Latest
"Recommended" -> pure Recommended
"Prerelease" -> pure Prerelease
"Nightly" -> pure Nightly
"LatestPrerelease" -> pure LatestPrerelease
"LatestNightly" -> pure LatestNightly
"old" -> pure Old
('b' : 'a' : 's' : 'e' : '-' : ver') -> case pvp (T.pack ver') of
Right x -> pure $ Base x
@@ -320,18 +324,11 @@ instance FromJSONKey (Maybe VersionRange) where
Right x -> pure $ Just x
Left e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfoLegacy
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionDownload
instance FromJSON VersionInfo where
parseJSON v = parseLegacy v <|> parseNew v
where
parseLegacy = fmap fromVersionInfoLegacy . parseJSON @VersionInfoLegacy
parseNew = genericParseJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel }
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key

View File

@@ -37,7 +37,6 @@ makeLenses ''PlatformResult
makeLenses ''DownloadInfo
makeLenses ''Tag
makeLenses ''VersionInfo
makeLenses ''VersionDownload
makeLenses ''GHCTargetVersion

View File

@@ -94,6 +94,7 @@ import qualified Streamly.Prelude as S
import Control.DeepSeq (force)
import GHC.IO (evaluate)
import System.Environment (getEnvironment, setEnv)
import Data.Time (Day(..), diffDays, addDays)
-- $setup
@@ -160,7 +161,7 @@ rmMinorGHCSymlinks :: ( MonadReader env m
rmMinorGHCSymlinks tv@GHCTargetVersion{..} = do
Dirs {..} <- lift getDirs
files <- liftE $ ghcToolFiles tv
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
let fullF = binDir </> f_xyz
@@ -181,7 +182,7 @@ rmPlainGHC :: ( MonadReader env m
-> Excepts '[NotInstalled] m ()
rmPlainGHC target = do
Dirs {..} <- lift getDirs
mtv <- lift $ ghcSet target
mtv <- lift $ ghcSet target
forM_ mtv $ \tv -> do
files <- liftE $ ghcToolFiles tv
forM_ files $ \f -> do
@@ -228,7 +229,7 @@ rmMinorHLSSymlinks :: ( MonadReader env m
, MonadFail m
, MonadMask m
)
=> VersionRev
=> Version
-> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks ver = do
Dirs {..} <- lift getDirs
@@ -281,7 +282,7 @@ rmPlainHLS = do
-----------------------------------
-- | Whether the given GHC version is installed.
-- | Whether the given GHC versin is installed.
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled ver = do
ghcdir <- ghcupGHCDir ver
@@ -299,7 +300,7 @@ ghcSrcInstalled ver = do
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Maybe Text -- ^ the target of the GHC version, if any
-- (e.g. armv7-unknown-linux-gnueabihf)
-> m (Maybe GHCTargetVersionRev)
-> m (Maybe GHCTargetVersion)
ghcSet mtarget = do
Dirs {..} <- getDirs
let ghc = maybe "ghc" (\t -> T.unpack t <> "-ghc") mtarget
@@ -311,7 +312,7 @@ ghcSet mtarget = do
link <- liftIO $ getLinkTarget ghcBin
Just <$> ghcLinkVersion link
where
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersionRev
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
ghcLinkVersion (T.pack . dropSuffix exeExt -> t) = throwEither $ MP.parse parser "ghcLinkVersion" t
where
parser =
@@ -321,7 +322,7 @@ ghcSet mtarget = do
r <- parseUntil1 pathSep
rest <- MP.getInput
MP.setInput r
x <- ghcTargetVerRevP
x <- ghcTargetVerP
MP.setInput rest
pure x
)
@@ -347,13 +348,13 @@ getInstalledCabals :: ( MonadReader env m
, MonadIO m
, MonadCatch m
)
=> m [Either FilePath VersionRev]
=> m [Either FilePath Version]
getInstalledCabals = do
Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts compExtended execBlank ([s|^cabal-.*$|] :: ByteString))
vs <- forM bins $ \f -> case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
vs <- forM bins $ \f -> case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "cabal-" f) of
Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f
@@ -361,14 +362,14 @@ getInstalledCabals = do
-- | Whether the given cabal version is installed.
cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
cabalInstalled ver = do
vers <- fmap rights getInstalledCabals
pure $ elem ver vers
-- Return the currently set cabal version, if any.
cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet = do
Dirs {..} <- getDirs
let cabalbin = binDir </> "cabal" <> exeExt
@@ -395,7 +396,7 @@ cabalSet = do
-- We try to be extra permissive with link destination parsing,
-- because of:
-- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/119
linkVersion :: MonadThrow m => FilePath -> m VersionRev
linkVersion :: MonadThrow m => FilePath -> m Version
linkVersion = throwEither . MP.parse parser "linkVersion" . T.pack . dropSuffix exeExt
parser
@@ -403,7 +404,7 @@ cabalSet = do
<|> MP.try (stripRelativePath *> cabalParse)
<|> cabalParse
-- parses the version of "cabal-3.2.0.0" -> "3.2.0.0"
cabalParse = MP.chunk "cabal-" *> versionRevP
cabalParse = MP.chunk "cabal-" *> version'
-- parses any path component ending with path separator,
-- e.g. "foo/"
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
@@ -420,7 +421,7 @@ cabalSet = do
-- @~\/.ghcup\/bin/haskell-language-server-wrapper-<\hlsver\>@,
-- as well as @~\/.ghcup\/hls\/<\hlsver\>@
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath VersionRev]
=> m [Either FilePath Version]
getInstalledHLSs = do
Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -431,7 +432,7 @@ getInstalledHLSs = do
)
legacy <- forM bins $ \f ->
case
versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "haskell-language-server-wrapper-" f)
of
Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f
@@ -448,7 +449,7 @@ getInstalledHLSs = do
-- | Get all installed stacks, by matching on
-- @~\/.ghcup\/bin/stack-<\stackver\>@.
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath VersionRev]
=> m [Either FilePath Version]
getInstalledStacks = do
Dirs {..} <- getDirs
bins <- liftIO $ handleIO (\_ -> pure []) $ findFiles
@@ -458,7 +459,7 @@ getInstalledStacks = do
([s|^stack-.*$|] :: ByteString)
)
forM bins $ \f ->
case versionRev . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
case version . T.pack <$> (stripSuffix exeExt =<< stripPrefix "stack-" f) of
Just (Right r) -> pure $ Right r
Just (Left _) -> pure $ Left f
Nothing -> pure $ Left f
@@ -509,13 +510,13 @@ stackSet = do
stripRelativePath = MP.many (MP.try stripPathComponet)
-- | Whether the given Stack version is installed.
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
stackInstalled ver = do
vers <- fmap rights getInstalledStacks
pure $ elem ver vers
-- | Whether the given HLS version is installed.
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => VersionRev -> m Bool
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
hlsInstalled ver = do
vers <- fmap rights getInstalledHLSs
pure $ elem ver vers
@@ -527,7 +528,7 @@ isLegacyHLS ver = do
-- Return the currently set hls version, if any.
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe VersionRev)
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet = do
Dirs {..} <- getDirs
let hlsBin = binDir </> "haskell-language-server-wrapper" <> exeExt
@@ -540,7 +541,7 @@ hlsSet = do
link <- liftIO $ getLinkTarget hlsBin
Just <$> linkVersion link
where
linkVersion :: MonadThrow m => FilePath -> m VersionRev
linkVersion :: MonadThrow m => FilePath -> m Version
linkVersion = throwEither . MP.parse parser "" . T.pack . dropSuffix exeExt
where
parser
@@ -548,7 +549,7 @@ hlsSet = do
<|> MP.try (stripRelativePath *> cabalParse)
<|> cabalParse
-- parses the version of "haskell-language-server-wrapper-1.1.0" -> "1.1.0"
cabalParse = MP.chunk "haskell-language-server-wrapper-" *> versionRevP
cabalParse = MP.chunk "haskell-language-server-wrapper-" *> version'
-- parses any path component ending with path separator,
-- e.g. "foo/"
stripPathComponet = parseUntil1 pathSep *> MP.some pathSep
@@ -567,7 +568,7 @@ hlsGHCVersions :: ( MonadReader env m
, MonadThrow m
, MonadCatch m
)
=> m [VersionRev]
=> m [Version]
hlsGHCVersions = do
h <- hlsSet
fromMaybe [] <$> forM h hlsGHCVersions'
@@ -579,12 +580,12 @@ hlsGHCVersions' :: ( MonadReader env m
, MonadThrow m
, MonadCatch m
)
=> VersionRev
-> m [VersionRev]
=> Version
-> m [Version]
hlsGHCVersions' v' = do
bins <- hlsServerBinaries v' Nothing
let vers = fmap
(versionRev
(version
. T.pack
. fromJust
. stripPrefix "haskell-language-server-"
@@ -597,10 +598,10 @@ hlsGHCVersions' v' = do
-- | Get all server binaries for an hls version from the ~/.ghcup/bin directory, if any.
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
=> VersionRev
=> Version
-> Maybe Version -- ^ optional GHC version
-> m [FilePath]
hlsServerBinaries (VersionRev ver rv) mghcVer = do
hlsServerBinaries ver mghcVer = do
Dirs {..} <- getDirs
liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
@@ -611,7 +612,6 @@ hlsServerBinaries (VersionRev ver rv) mghcVer = do
<> maybe [s|.*|] escapeVerRex mghcVer
<> [s|~|]
<> escapeVerRex ver
<> E.encodeUtf8 (T.pack ("-r" <> show rv))
<> E.encodeUtf8 (T.pack exeExt)
<> [s|$|] :: ByteString
)
@@ -658,20 +658,16 @@ hlsInternalServerLibs ver ghcVer = do
-- | Get the wrapper binary for an hls version, if any.
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> VersionRev
=> Version
-> m (Maybe FilePath)
hlsWrapperBinary (VersionRev ver rv) = do
hlsWrapperBinary ver = do
Dirs {..} <- getDirs
wrapper <- liftIO $ handleIO (\_ -> pure []) $ findFiles
binDir
(makeRegexOpts
compExtended
execBlank
([s|^haskell-language-server-wrapper-|]
<> escapeVerRex ver
<> E.encodeUtf8 (T.pack ("-r" <> show rv))
<> E.encodeUtf8 (T.pack exeExt)
<> [s|$|] :: ByteString
([s|^haskell-language-server-wrapper-|] <> escapeVerRex ver <> E.encodeUtf8 (T.pack exeExt) <> [s|$|] :: ByteString
)
)
case wrapper of
@@ -682,7 +678,7 @@ hlsWrapperBinary (VersionRev ver rv) = do
-- | Get all binaries for an hls version, if any.
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => VersionRev -> m [FilePath]
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
hlsAllBinaries ver = do
hls <- hlsServerBinaries ver Nothing
wrapper <- hlsWrapperBinary ver
@@ -786,9 +782,6 @@ getLatestToolFor tool pvpIn dls = do
let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
-- type ToolVersionSpec = Map Version ToolRevisionSpec
-- type ToolRevisionSpec = Map Int VersionInfo
@@ -897,12 +890,30 @@ getTagged tag =
to (Map.toDescList . Map.filter (\VersionInfo {..} -> tag `elem` _viTags))
% folding id
getByReleaseDay :: GHCupDownloads -> Tool -> Day -> Either (Maybe Day) (Version, VersionInfo)
getByReleaseDay av tool day = let mvv = fromMaybe mempty $ headOf (ix tool) av
mdv = Map.foldrWithKey (\k vi@VersionInfo{..} m ->
maybe m (\d -> let diff = diffDays d day
in Map.insert (abs diff) (diff, (k, vi)) m) _viReleaseDay)
Map.empty mvv
in case headMay (Map.toAscList mdv) of
Nothing -> Left Nothing
Just (absDiff, (diff, (k, vi)))
| absDiff == 0 -> Right (k, vi)
| otherwise -> Left (Just (addDays diff day))
getByReleaseDayFold :: Day -> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
getByReleaseDayFold day = to (Map.toDescList . Map.filter (\VersionInfo {..} -> Just day == _viReleaseDay)) % folding id
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest av tool = headOf (ix tool % getTagged Latest) av
getLatestPrerelease :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatestPrerelease av tool = headOf (ix tool % getTagged LatestPrerelease) av
getLatestNightly :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatestNightly av tool = headOf (ix tool % getTagged LatestNightly) av
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended av tool = headOf (ix tool % getTagged Recommended) av
@@ -935,7 +946,7 @@ ghcInternalBinDir ver = do
--
-- - @["hsc2hs","haddock","hpc","runhaskell","ghc","ghc-pkg","ghci","runghc","hp2ps"]@
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersionRev
=> GHCTargetVersion
-> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles ver = do
bindir <- ghcInternalBinDir ver
@@ -1089,11 +1100,15 @@ darwinNotarization _ _ = pure $ Right ()
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
getChangeLog dls tool (Left v') =
getChangeLog :: GHCupDownloads -> Tool -> ToolVersion -> Maybe URI
getChangeLog dls tool (GHCVersion (_tvVersion -> v')) =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (Right tag) =
getChangeLog dls tool (ToolVersion v') =
preview (ix tool % ix v' % viChangeLog % _Just) dls
getChangeLog dls tool (ToolTag tag) =
preview (ix tool % pre (getTagged tag) % to snd % viChangeLog % _Just) dls
getChangeLog dls tool (ToolDay day) =
preview (ix tool % pre (getByReleaseDayFold day) % to snd % viChangeLog % _Just) dls
-- | Execute a build action while potentially cleaning up:
@@ -1293,7 +1308,7 @@ warnAboutHlsCompatibility :: ( MonadReader env m
=> m ()
warnAboutHlsCompatibility = do
supportedGHC <- hlsGHCVersions
currentGHC <- fmap _tvVersionRev <$> ghcSet Nothing
currentGHC <- fmap _tvVersion <$> ghcSet Nothing
currentHLS <- hlsSet
case (currentGHC, currentHLS) of

View File

@@ -279,7 +279,7 @@ ghcupCacheDir
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup"))
pure (GHCupPath (bdir </> "ghcup" </> "cache"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "cache"))
@@ -308,19 +308,7 @@ ghcupLogsDir
-- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
-- then uses 'XDG_CACHE_HOME/ghcup/db as per xdg spec.
ghcupDbDir :: IO GHCupPath
ghcupDbDir
| isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
| otherwise = do
xdg <- useXDG
if xdg
then do
bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
Just r -> pure r
Nothing -> do
home <- liftIO getHomeDirectory
pure (home </> ".cache")
pure (GHCupPath (bdir </> "ghcup" </> "db"))
else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
ghcupDbDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "db"))
-- | '~/.ghcup/trash'.
@@ -417,9 +405,9 @@ parseGHCupGHCDir :: MonadThrow m => FilePath -> m GHCTargetVersion
parseGHCupGHCDir (T.pack -> fp) =
throwEither $ MP.parse ghcTargetVerP "" fp
parseGHCupHLSDir :: MonadThrow m => FilePath -> m VersionRev
parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
parseGHCupHLSDir (T.pack -> fp) =
throwEither $ versionRev fp
throwEither $ MP.parse version' "" fp
-- TODO: inlined from GHCup.Prelude
throwEither :: (Exception a, MonadThrow m) => Either a b -> m b

View File

@@ -851,8 +851,8 @@ case $ask_stack_answer in
;;
2)
(_eghcup --cache install stack) || die "Stack installation failed"
edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
edo mkdir -p "${STACK_ROOT:-$HOME/.stack}"/hooks
hook_exe="${STACK_ROOT:-$HOME/.stack}"/hooks/ghc-install.sh
hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"
if [ -e "${hook_exe}" ] ; then

View File

@@ -1,52 +1,36 @@
resolver: lts-18.28
resolver: lts-20.20
packages:
- .
extra-deps:
- Cabal-3.6.2.0@sha256:e2266e14758c1f799220fad7f0d4b0b4ec567d81b7ba3faea17ff76d4c31de95,12437
- IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
- ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
- base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
- brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
- brotli-0.0.0.0@sha256:2bf383a4cd308745740986be0b18381c5a0784393fe69b91456aacb2d603de46,2964
- brotli-streams-0.0.0.0@sha256:1af1e22f67b8bfd6ad0d05e61825e7a178d738f689ebbb21c1aab5f1bbcae176,2331
- Cabal-3.6.3.0
- Cabal-syntax-3.10.1.0
- aeson-2.1.2.1
- cabal-install-parsers-0.6.1
- chs-cabal-0.1.1.1
- chs-deps-0.1.0.0@sha256:0cdada6d2c682c41b20331b8c63c2ecfc7e806928585195fd544c9d41f3074fd,2496
- composition-prelude-3.0.0.2@sha256:1ffed216bd28d810fce0b5be83a661e2a892696d73b3f8de5c0f5edb9b5f0090,1216
- chs-deps-0.1.0.0
- generic-arbitrary-0.2.2@sha256:202ffbf2032672a51318f2e80d7e75b72f8950e690346b4314f38bc7e39215f7,1189
- generically-0.1.1
- haskus-utils-data-1.4@sha256:bfa94363b94b14779edd6834fbd59dbb847c3d7b8f48e3844f456ffdc077da4a,1466
- haskus-utils-types-1.5.1@sha256:991c472f4e751e2f0d7aab6ad4220ef151d6160876dcf0511bbf876bbd432020,1298
- haskus-utils-variant-3.2.1@sha256:791f4cf1e786eb578f4d37aef60986641f84c36e130164321f7d01542584066a,2200
- heaps-0.3.6.1@sha256:7928b759ca5180d35722c45948c0bde264229f3c99c1888188a3d9285f13d3d2,1340
- hpath-filepath-0.10.4@sha256:e9e44fb5fdbade7f30b5b5451257dbee15b6ef1aae4060034d73008bb3b5d878,1269
- hpath-posix-0.13.3@sha256:abe472cf16bccd3a8b8814865ed3551a728fde0f3a2baea2acc03023bec6c565,1615
- hspec-2.7.10@sha256:c9e82c90086acebac576552a06f3cabd249bba048edd1667c7fae0b1313d5bce,1712
- hspec-core-2.7.10@sha256:2aba6ea126442b29e8183ab27f1c811706b19b1d83b02f193a896f6fc1589d13,4621
- hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
- hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
- http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
- libarchive-3.0.3.0
- haskus-utils-variant-3.2.1
- libarchive-3.0.3.2
- libyaml-streamly-0.2.1
- lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
- optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568
- optics-core-0.4@sha256:59e04aebca536bd011ae50c781937f45af4c1456af1eb9fb578f9a69eee293cd,4995
- optics-extra-0.4@sha256:b9914f38aa7d5c92f231060d9168447f9f5a367c07df9bf47a003e3e786d5e05,3432
- optics-th-0.4@sha256:7c838b5b1d6998133bf8f0641c36197ed6cb468dc69515e1952f33f0bbe8e11d,2009
- os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
- primitive-0.7.1.0@sha256:29de6bfd0cf8ba023ceb806203dfbec0e51e3524e75ffe41056f70b4229c6f0f,2728
- regex-posix-clib-2.7
- lzma-static-5.2.5.5
- os-release-1.0.2.1
- parsec-3.1.15.0
- streamly-0.8.2@sha256:ec521b7c1c4db068501c35804af77f40b7d34232f5e29d9b99e722229040eb80,23500
- unicode-data-0.3.0@sha256:0545e079705a5381d0893f8fe8daaa08fc9174baeab269b9cf651817d8eadbc6,5123
- strict-base-0.4.0.0@sha256:2ff4e43cb95eedf2995558d7fc34d19362846413dd39e6aa6a5b3ea8228fef9f,1248
- xor-0.0.1.0@sha256:f8362b4a68562b9afbcd727ff64c1a303970df3a032e0033d2f4c094c3501df3,2243
- yaml-streamly-0.12.1
- strict-base-0.4.0.0
- text-2.0.2
- yaml-streamly-0.12.2
flags:
http-io-streams:
brotli: false
libarchive:
system-libarchive: false
system-libarchive: true
regex-posix:
_regex-posix-clib: true

View File

@@ -11,6 +11,7 @@ import GHCup.Types
import Data.ByteString ( ByteString )
import Data.Versions
import Data.List.NonEmpty
import Data.Time.Calendar ( Day(..) )
import Test.QuickCheck
import Test.QuickCheck.Arbitrary.ADT ( ToADTArbitrary )
import Test.QuickCheck.Arbitrary.Generic
@@ -76,6 +77,9 @@ instance Arbitrary Port where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary Day where
arbitrary = ModifiedJulianDay . fromIntegral <$> (chooseAny :: Gen Int)
instance Arbitrary (URIRef Absolute) where
arbitrary =
URI <$> arbitrary <*> pure Nothing <*> arbitrary <*> pure (Query []) <*> pure Nothing
@@ -147,10 +151,6 @@ instance Arbitrary Architecture where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionDownload where
arbitrary = genericArbitrary
shrink = genericShrink
instance Arbitrary VersionInfo where
arbitrary = genericArbitrary
shrink = genericShrink

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff