diff --git a/app/ghcup-gen/GHCupInfo.hs b/app/ghcup-gen/GHCupInfo.hs new file mode 100644 index 0000000..cf14546 --- /dev/null +++ b/app/ghcup-gen/GHCupInfo.hs @@ -0,0 +1,11 @@ +module GHCupInfo where + +import GHCupDownloads +import ToolRequirements +import GHCup.Types + + +ghcupInfo :: GHCupInfo +ghcupInfo = GHCupInfo { _toolRequirements = toolRequirements + , _ghcupDownloads = ghcupDownloads + } diff --git a/app/ghcup-gen/Main.hs b/app/ghcup-gen/Main.hs index 0e9b1c8..21cae22 100644 --- a/app/ghcup-gen/Main.hs +++ b/app/ghcup-gen/Main.hs @@ -9,9 +9,10 @@ module Main where +import GHCup.Types import GHCup.Types.JSON ( ) import GHCup.Utils.Logger -import GHCupDownloads +import GHCupInfo import Data.Aeson ( eitherDecode ) import Data.Aeson.Encode.Pretty @@ -135,7 +136,7 @@ main = do GenJSON gopts -> do let bs = encodePretty' (defConfig { confIndent = Spaces 2 }) - ghcupDownloads + ghcupInfo case gopts of GenJSONOpts { output = Nothing } -> L.hPutStr stdout bs GenJSONOpts { output = Just StdOutput } -> L.hPutStr stdout bs @@ -159,7 +160,7 @@ main = do where valAndExit f contents = do - av <- case eitherDecode contents of + (GHCupInfo _ av) <- case eitherDecode contents of Right r -> pure r Left e -> die (color Red $ show e) myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av) diff --git a/app/ghcup-gen/ToolRequirements.hs b/app/ghcup-gen/ToolRequirements.hs new file mode 100644 index 0000000..1a3c9af --- /dev/null +++ b/app/ghcup-gen/ToolRequirements.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module ToolRequirements where + +import GHCup.Types +import GHCup.Utils.String.QQ + +import qualified Data.Map as M + + + +-- | Currently 'GHC' is used for both GHC and cabal to simplify +-- this, until we need actual separation. +toolRequirements :: ToolRequirements +toolRequirements = M.fromList + [ ( GHC + , M.fromList + [ ( Nothing + , M.fromList + [ ( Linux UnknownLinux + , M.fromList + [ ( Nothing + , Requirements + [] + [s|You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.|] + ) + ] + ) + , ( Linux Alpine + , M.fromList + [ ( Nothing + , Requirements + [ "curl" + , "gcc" + , "g++" + , "gmp-dev" + , "ncurses-dev" + , "libffi-dev" + , "make" + , "xz" + , "tar" + , "perl" + ] + "" + ) + ] + ) + , ( Linux Ubuntu + , M.fromList + [ ( Nothing + , Requirements + [ "build-essential" + , "curl" + , "libgmp-dev" + , "libffi-dev" + , "libncurses-dev" + , "libtinfo5" + ] + "" + ) + ] + ) + , ( Darwin + , M.fromList + [ ( Nothing + , Requirements + [] + "On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again." + ) + ] + ) + , ( FreeBSD + , M.fromList + [ ( Nothing + , Requirements + [ "curl" + , "gcc" + , "gmp" + , "gmake" + , "ncurses" + , "perl5" + , "libffi" + , "libiconv" + ] + "" + ) + ] + ) + ] + ) + ] + ) + ] diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 397e3c3..fe89463 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -13,6 +13,8 @@ module Main where import GHCup import GHCup.Download import GHCup.Errors +import GHCup.Platform +import GHCup.Requirements import GHCup.Types import GHCup.Utils import GHCup.Utils.Logger @@ -79,6 +81,7 @@ data Command | Compile CompileCommand | Upgrade UpgradeOpts | NumericVersion + | ToolRequirements data ToolVersion = ToolVersion Version | ToolTag Tag @@ -218,6 +221,11 @@ com = ( (\_ -> NumericVersion) <$> (info (helper) (progDesc "Show the numeric version")) ) + <> command + "tool-requirements" + ( (\_ -> ToolRequirements) + <$> (info (helper) (progDesc "Show the requirements for ghc/cabal")) + ) <> commandGroup "Other commands:" <> hidden ) @@ -615,7 +623,7 @@ main = do , DownloadFailed ] - dls <- + (GHCupInfo treq dls) <- ( runLogger . flip runReaderT settings . runE @'[JSONError , DownloadFailed] @@ -779,6 +787,21 @@ Check the logs at ~/.ghcup/logs and the build directory #{tmpdir} for more clues runLogger ($(logError) [i|#{e}|]) >> exitFailure NumericVersion -> T.hPutStr stdout (prettyPVP ghcUpVer) + ToolRequirements -> (runLogger $ runE + @'[ NoCompatiblePlatform + , DistroNotFound + , NoToolRequirements + ] $ do + platform <- liftE $ getPlatform + req <- (getCommonRequirements platform $ treq) + ?? NoToolRequirements + liftIO $ T.hPutStr stdout (prettyRequirements req)) + >>= \case + VRight r -> pure r + VLeft e -> + runLogger + ($(logError) [i|Error getting tool requirements: #{e}|]) + >> exitFailure pure () diff --git a/ghcup.cabal b/ghcup.cabal index 1499eae..50de78c 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -283,6 +283,7 @@ library GHCup.Download.Utils GHCup.Errors GHCup.Platform + GHCup.Requirements GHCup.Types GHCup.Types.JSON GHCup.Types.Optics @@ -368,8 +369,11 @@ executable ghcup-gen -- main-is: Main.hs - other-modules: GHCupDownloads - Validate + other-modules: + GHCupDownloads + GHCupInfo + ToolRequirements + Validate -- other-extensions: build-depends: ghcup diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 9c2358a..ce433cc 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -94,7 +94,7 @@ getDownloads :: ( FromJSONKey Tool , MonadFail m ) => URLSource - -> Excepts '[JSONError , DownloadFailed] m GHCupDownloads + -> Excepts '[JSONError , DownloadFailed] m GHCupInfo getDownloads urlSource = do lift $ $(logDebug) [i|Receiving download info from: #{urlSource}|] case urlSource of diff --git a/lib/GHCup/Errors.hs b/lib/GHCup/Errors.hs index d0d590e..16819a3 100644 --- a/lib/GHCup/Errors.hs +++ b/lib/GHCup/Errors.hs @@ -92,6 +92,9 @@ data TooManyRedirs = TooManyRedirs data PatchFailed = PatchFailed deriving Show +-- | The tool requirements could not be found. +data NoToolRequirements = NoToolRequirements + deriving Show ------------------------- diff --git a/lib/GHCup/Requirements.hs b/lib/GHCup/Requirements.hs new file mode 100644 index 0000000..d550609 --- /dev/null +++ b/lib/GHCup/Requirements.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE OverloadedStrings #-} + +module GHCup.Requirements where + +import GHCup.Types +import GHCup.Types.JSON ( ) +import GHCup.Types.Optics + +import Control.Applicative +import Data.Maybe +import Optics +import Prelude hiding ( abs + , readFile + , writeFile + ) + +import qualified Data.Text as T + + +-- | Get the requirements. Right now this combines GHC and cabal +-- and doesn't do fine-grained distinction. However, the 'ToolRequirements' +-- type allows it. +getCommonRequirements :: PlatformResult + -> ToolRequirements + -> Maybe Requirements +getCommonRequirements pr tr = + preview (ix GHC % ix Nothing % ix (_platform pr) % ix (_distroVersion pr)) tr + <|> preview (ix GHC % ix Nothing % ix (_platform pr) % ix Nothing) tr + <|> preview + ( ix GHC + % ix Nothing + % ix (set _Linux UnknownLinux $ _platform pr) + % ix Nothing + ) + tr + + +prettyRequirements :: Requirements -> T.Text +prettyRequirements Requirements {..} = + let d = if not . null $ _distroPKGs + then + "\n Install the following distro packages: " + <> T.intercalate " " _distroPKGs + else "" + n = if not . T.null $ _notes then "\n Note: " <> _notes else "" + in "System requirements " <> d <> n diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index e9ced3f..4499077 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -12,6 +12,39 @@ import qualified GHC.Generics as GHC + -------------------- + --[ GHCInfo Tree ]-- + -------------------- + + +data GHCupInfo = GHCupInfo + { _toolRequirements :: ToolRequirements + , _ghcupDownloads :: GHCupDownloads + } + deriving (Show, GHC.Generic) + + + + ------------------------- + --[ Requirements Tree ]-- + ------------------------- + + +type ToolRequirements = Map Tool ToolReqVersionSpec +type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec +type PlatformReqSpec = Map Platform PlatformReqVersionSpec +type PlatformReqVersionSpec = Map (Maybe Versioning) Requirements + + +data Requirements = Requirements + { _distroPKGs :: [Text] + , _notes :: Text + } + deriving (Show, GHC.Generic) + + + + --------------------- --[ Download Tree ]-- @@ -99,7 +132,7 @@ data DownloadInfo = DownloadInfo -- | Where to fetch GHCupDownloads from. data URLSource = GHCupURL | OwnSource URI - | OwnSpec GHCupDownloads + | OwnSpec GHCupInfo deriving Show diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs index c242316..aa17289 100644 --- a/lib/GHCup/Types/JSON.hs +++ b/lib/GHCup/Types/JSON.hs @@ -39,6 +39,8 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tag deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements instance ToJSON URI where @@ -69,11 +71,11 @@ instance FromJSONKey Versioning where instance ToJSONKey (Maybe Versioning) where toJSONKey = toJSONKeyText $ \case Just x -> prettyV x - Nothing -> T.pack "unknown_version" + Nothing -> T.pack "unknown_versioning" instance FromJSONKey (Maybe Versioning) where fromJSONKey = FromJSONKeyTextParser $ \t -> - if t == T.pack "unknown_version" then pure Nothing else pure $ just t + if t == T.pack "unknown_versioning" then pure Nothing else pure $ just t where just t = case versioning t of Right x -> pure x @@ -112,6 +114,19 @@ instance ToJSONKey Architecture where instance FromJSONKey Architecture where fromJSONKey = genericFromJSONKey defaultJSONKeyOptions +instance ToJSONKey (Maybe Version) where + toJSONKey = toJSONKeyText $ \case + Just x -> prettyVer x + Nothing -> T.pack "unknown_version" + +instance FromJSONKey (Maybe Version) where + fromJSONKey = FromJSONKeyTextParser $ \t -> + if t == T.pack "unknown_version" then pure Nothing else pure $ just t + where + just t = case version t of + Right x -> pure x + Left e -> fail $ "Failure in (Maybe Version) (FromJSONKey)" <> show e + instance ToJSON Version where toJSON = toJSON . prettyVer diff --git a/lib/GHCup/Types/Optics.hs b/lib/GHCup/Types/Optics.hs index 5d02918..4dcd22f 100644 --- a/lib/GHCup/Types/Optics.hs +++ b/lib/GHCup/Types/Optics.hs @@ -19,6 +19,7 @@ makeLenses ''DownloadInfo makeLenses ''Tag makeLenses ''VersionInfo +makeLenses ''GHCupInfo uriSchemeL' :: Lens' (URIRef Absolute) Scheme uriSchemeL' = lensVL uriSchemeL