ghcup-hs/lib/GHCup/Types.hs

802 lines
23 KiB
Haskell
Raw Permalink Normal View History

{-# OPTIONS_GHC -Wno-orphans #-}
2020-04-25 10:06:41 +00:00
{-# LANGUAGE CPP #-}
2021-07-15 11:32:48 +00:00
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
2020-04-25 10:06:41 +00:00
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
2021-07-15 11:32:48 +00:00
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DuplicateRecordFields #-}
2020-01-11 20:15:05 +00:00
2020-07-21 23:08:58 +00:00
{-|
Module : GHCup.Types
Description : GHCup types
Copyright : (c) Julian Ospald, 2020
2020-07-30 18:04:02 +00:00
License : LGPL-3.0
2020-07-21 23:08:58 +00:00
Maintainer : hasufell@hasufell.de
Stability : experimental
2021-05-14 21:09:45 +00:00
Portability : portable
2020-07-21 23:08:58 +00:00
-}
2021-05-14 21:09:45 +00:00
module GHCup.Types
( module GHCup.Types
#if defined(BRICK)
, Key(..)
, Modifier(..)
2021-05-14 21:09:45 +00:00
#endif
2024-01-02 16:32:23 +00:00
, ArchiveResult(..)
2021-05-14 21:09:45 +00:00
)
where
2020-01-11 20:15:05 +00:00
import GHCup.Types.Stack ( SetupInfo )
import GHCup.Utils.Tar.Types ( ArchiveResult(..) )
2022-05-21 20:54:18 +00:00
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
2021-07-15 11:32:48 +00:00
import Control.DeepSeq ( NFData, rnf )
2020-01-11 20:15:05 +00:00
import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Time.Calendar ( Day )
2020-01-11 20:15:05 +00:00
import Data.Text ( Text )
import Data.Versions
import GHC.IO.Exception ( ExitCode )
import Optics ( makeLenses )
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
2020-01-11 20:15:05 +00:00
import URI.ByteString
2021-05-14 21:09:45 +00:00
#if defined(BRICK)
import Graphics.Vty ( Key(..), Modifier(..) )
2021-05-14 21:09:45 +00:00
#endif
2020-01-11 20:15:05 +00:00
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
2020-01-11 20:15:05 +00:00
import qualified GHC.Generics as GHC
import qualified Data.List.NonEmpty as NE
2020-01-11 20:15:05 +00:00
2021-05-14 21:09:45 +00:00
#if !defined(BRICK)
data Key = KEsc | KChar Char | KBS | KEnter
| KLeft | KRight | KUp | KDown
| KUpLeft | KUpRight | KDownLeft | KDownRight | KCenter
| KFun Int | KBackTab | KPrtScr | KPause | KIns
| KHome | KPageUp | KDel | KEnd | KPageDown | KBegin | KMenu
deriving (Eq,Show,Read,Ord,GHC.Generic)
data Modifier = MShift | MCtrl | MMeta | MAlt
deriving (Eq,Show,Read,Ord,GHC.Generic)
2021-05-14 21:09:45 +00:00
#endif
data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
deriving (Eq,Show,Read,Ord,GHC.Generic)
2020-01-11 20:15:05 +00:00
2020-04-10 15:36:27 +00:00
--------------------
--[ GHCInfo Tree ]--
--------------------
data GHCupInfo = GHCupInfo
{ _toolRequirements :: ToolRequirements
, _ghcupDownloads :: GHCupDownloads
, _metadataUpdate :: Maybe URI
2020-04-10 15:36:27 +00:00
}
deriving (Show, GHC.Generic, Eq)
2020-04-10 15:36:27 +00:00
2021-07-15 11:32:48 +00:00
instance NFData GHCupInfo
2020-04-10 15:36:27 +00:00
-------------------------
--[ Requirements Tree ]--
-------------------------
type ToolRequirements = Map Tool ToolReqVersionSpec
type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec
type PlatformReqSpec = Map Platform PlatformReqVersionSpec
type PlatformReqVersionSpec = Map (Maybe VersionRange) Requirements
2020-04-10 15:36:27 +00:00
data Requirements = Requirements
{ _distroPKGs :: [Text]
, _notes :: Text
}
deriving (Show, GHC.Generic, Eq)
2020-04-10 15:36:27 +00:00
2021-07-15 11:32:48 +00:00
instance NFData Requirements
2020-04-10 15:36:27 +00:00
2020-01-11 20:15:05 +00:00
---------------------
--[ Download Tree ]--
---------------------
-- | Description of all binary and source downloads. This is a tree
-- of nested maps.
type GHCupDownloads = Map Tool ToolVersionSpec
2023-07-07 08:41:58 +00:00
type ToolVersionSpec = Map GHCTargetVersion VersionInfo
2020-01-11 20:15:05 +00:00
type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo
2020-01-11 20:15:05 +00:00
-- | An installable tool.
data Tool = GHC
| Cabal
| GHCup
| HLS
2021-05-14 22:31:36 +00:00
| Stack
2021-01-02 06:58:08 +00:00
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
2020-01-11 20:15:05 +00:00
2021-08-25 16:54:58 +00:00
instance Pretty Tool where
pPrint GHC = text "ghc"
pPrint Cabal = text "cabal"
pPrint GHCup = text "ghcup"
pPrint HLS = text "hls"
pPrint Stack = text "stack"
2021-07-15 11:32:48 +00:00
instance NFData Tool
2020-01-11 20:15:05 +00:00
-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
{ _viTags :: [Tag] -- ^ version specific tag
, _viReleaseDay :: Maybe Day
, _viChangeLog :: Maybe URI
, _viSourceDL :: Maybe DownloadInfo -- ^ source tarball
, _viTestDL :: Maybe DownloadInfo -- ^ test tarball
, _viArch :: ArchitectureSpec -- ^ descend for binary downloads per arch
-- informative messages
, _viPostInstall :: Maybe Text
, _viPostRemove :: Maybe Text
, _viPreCompile :: Maybe Text
2020-01-11 20:15:05 +00:00
}
2020-09-13 18:46:34 +00:00
deriving (Eq, GHC.Generic, Show)
2020-01-11 20:15:05 +00:00
2021-07-15 11:32:48 +00:00
instance NFData VersionInfo
2020-01-11 20:15:05 +00:00
-- | A tag. These are currently attached to a version of a tool.
data Tag = Latest -- ^ the latest version of a tool (unique per tool)
| Recommended -- ^ the recommended version of a tool (unique per tool)
2023-10-01 06:33:37 +00:00
| Prerelease -- ^ denotes a prerelease version
-- (a version should either be 'Prerelease' or
-- 'LatestPrerelease', but not both)
| LatestPrerelease -- ^ the latest prerelease (unique per tool)
2023-10-01 06:33:37 +00:00
| Nightly -- ^ denotes a nightly version
-- (a version should either be 'Nightly' or
-- 'LatestNightly', but not both)
| LatestNightly -- ^ the latest nightly (unique per tool)
2023-10-01 06:33:37 +00:00
| Base PVP -- ^ the base version shipped with GHC
2021-08-29 12:50:49 +00:00
| Old -- ^ old versions are hidden by default in TUI
2020-04-22 00:33:35 +00:00
| UnknownTag String -- ^ used for upwardscompat
2020-09-13 18:46:34 +00:00
deriving (Ord, Eq, GHC.Generic, Show) -- FIXME: manual JSON instance
2020-01-11 20:15:05 +00:00
2021-07-15 11:32:48 +00:00
instance NFData Tag
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
2020-01-11 20:15:05 +00:00
data Architecture = A_64
| A_32
2020-06-27 17:00:13 +00:00
| A_PowerPC
| A_PowerPC64
| A_Sparc
| A_Sparc64
| A_ARM
| A_ARM64
2020-01-11 20:15:05 +00:00
deriving (Eq, GHC.Generic, Ord, Show)
2021-07-15 11:32:48 +00:00
instance NFData Architecture
archToString :: Architecture -> String
archToString A_64 = "x86_64"
archToString A_32 = "i386"
archToString A_PowerPC = "powerpc"
archToString A_PowerPC64 = "powerpc64"
archToString A_Sparc = "sparc"
archToString A_Sparc64 = "sparc64"
archToString A_ARM = "arm"
archToString A_ARM64 = "aarch64"
instance Pretty Architecture where
pPrint = text . archToString
2020-01-11 20:15:05 +00:00
data Platform = Linux LinuxDistro
-- ^ must exit
| Darwin
-- ^ must exit
| FreeBSD
2021-05-14 21:09:45 +00:00
| Windows
-- ^ must exit
2020-01-11 20:15:05 +00:00
deriving (Eq, GHC.Generic, Ord, Show)
2021-07-15 11:32:48 +00:00
instance NFData Platform
platformToString :: Platform -> String
platformToString (Linux distro) = "linux-" ++ distroToString distro
platformToString Darwin = "darwin"
platformToString FreeBSD = "freebsd"
2021-05-14 21:09:45 +00:00
platformToString Windows = "windows"
instance Pretty Platform where
pPrint = text . platformToString
2020-01-11 20:15:05 +00:00
data LinuxDistro = Debian
| Ubuntu
| Mint
| Fedora
| CentOS
| RedHat
| Alpine
| AmazonLinux
2023-10-21 16:04:04 +00:00
| Rocky
| Void
2020-01-11 20:15:05 +00:00
-- rolling
| Gentoo
| Exherbo
-- not known
| UnknownLinux
-- ^ must exit
2023-10-21 16:04:04 +00:00
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
allDistros :: [LinuxDistro]
allDistros = enumFromTo minBound maxBound
2020-01-11 20:15:05 +00:00
2021-07-15 11:32:48 +00:00
instance NFData LinuxDistro
distroToString :: LinuxDistro -> String
distroToString Debian = "debian"
distroToString Ubuntu = "ubuntu"
2021-08-29 12:50:49 +00:00
distroToString Mint = "mint"
distroToString Fedora = "fedora"
distroToString CentOS = "centos"
distroToString RedHat = "redhat"
distroToString Alpine = "alpine"
distroToString AmazonLinux = "amazon"
2023-10-21 16:04:04 +00:00
distroToString Rocky = "rocky"
distroToString Void = "void"
distroToString Gentoo = "gentoo"
distroToString Exherbo = "exherbo"
distroToString UnknownLinux = "unknown"
instance Pretty LinuxDistro where
pPrint = text . distroToString
2020-01-11 20:15:05 +00:00
-- | An encapsulation of a download. This can be used
-- to download, extract and install a tool.
data DownloadInfo = DownloadInfo
{ _dlUri :: URI
2020-08-06 11:28:20 +00:00
, _dlSubdir :: Maybe TarDir
2020-01-11 20:15:05 +00:00
, _dlHash :: Text
, _dlCSize :: Maybe Integer
2023-05-14 11:33:04 +00:00
, _dlOutput :: Maybe FilePath
2020-01-11 20:15:05 +00:00
}
deriving (Eq, Ord, GHC.Generic, Show)
2020-01-11 20:15:05 +00:00
2021-07-15 11:32:48 +00:00
instance NFData DownloadInfo
2020-01-11 20:15:05 +00:00
--------------
--[ Others ]--
--------------
2022-12-03 16:15:13 +00:00
data DownloadMirror = DownloadMirror {
authority :: Authority
, pathPrefix :: Maybe Text
} deriving (Eq, Ord, GHC.Generic, Show)
instance NFData DownloadMirror
newtype DownloadMirrors = DM (Map Text DownloadMirror)
deriving (Eq, Ord, GHC.Generic, Show)
instance NFData DownloadMirrors
instance NFData UserInfo
instance NFData Host
instance NFData Port
instance NFData Authority
2020-01-11 20:15:05 +00:00
2020-08-06 11:28:20 +00:00
-- | How to descend into a tar archive.
2021-05-14 21:09:45 +00:00
data TarDir = RealDir FilePath
2020-08-06 11:28:20 +00:00
| RegexDir String -- ^ will be compiled to regex, the first match will "win"
deriving (Eq, Ord, GHC.Generic, Show)
2020-08-06 11:28:20 +00:00
2021-07-15 11:32:48 +00:00
instance NFData TarDir
instance Pretty TarDir where
2021-05-14 21:09:45 +00:00
pPrint (RealDir path) = text path
pPrint (RegexDir regex) = text regex
2020-08-06 11:28:20 +00:00
2020-01-11 20:15:05 +00:00
-- | Where to fetch GHCupDownloads from.
data URLSource = GHCupURL
| StackSetupURL
| OwnSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ complete source list
| OwnSpec (Either GHCupInfo SetupInfo)
| AddSource [Either (Either GHCupInfo SetupInfo) URI] -- ^ merge with GHCupURL
| SimpleList [NewURLSource]
deriving (Eq, GHC.Generic, Show)
data NewURLSource = NewGHCupURL
| NewStackSetupURL
| NewGHCupInfo GHCupInfo
| NewSetupInfo SetupInfo
| NewURI URI
deriving (Eq, GHC.Generic, Show)
instance NFData NewURLSource
fromURLSource :: URLSource -> [NewURLSource]
fromURLSource GHCupURL = [NewGHCupURL]
fromURLSource StackSetupURL = [NewStackSetupURL]
fromURLSource (OwnSource arr) = convert' <$> arr
fromURLSource (AddSource arr) = NewGHCupURL:(convert' <$> arr)
fromURLSource (SimpleList arr) = arr
fromURLSource (OwnSpec (Left gi)) = [NewGHCupInfo gi]
fromURLSource (OwnSpec (Right si)) = [NewSetupInfo si]
convert' :: Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
convert' (Left (Left gi)) = NewGHCupInfo gi
convert' (Left (Right si)) = NewSetupInfo si
convert' (Right uri) = NewURI uri
2021-07-15 11:32:48 +00:00
instance NFData URLSource
instance NFData (URIRef Absolute) where
rnf (URI !_ !_ !_ !_ !_) = ()
data MetaMode = Strict
| Lax
deriving (Show, Read, Eq, GHC.Generic)
instance NFData MetaMode
2020-01-11 20:15:05 +00:00
data UserSettings = UserSettings
{ uCache :: Maybe Bool
, uMetaCache :: Maybe Integer
, uMetaMode :: Maybe MetaMode
, uNoVerify :: Maybe Bool
, uVerbose :: Maybe Bool
, uKeepDirs :: Maybe KeepDirs
, uDownloader :: Maybe Downloader
, uKeyBindings :: Maybe UserKeyBindings
2020-10-25 13:17:17 +00:00
, uUrlSource :: Maybe URLSource
2021-07-18 21:29:09 +00:00
, uNoNetwork :: Maybe Bool
2021-09-18 17:45:32 +00:00
, uGPGSetting :: Maybe GPGSetting
2022-12-03 16:15:13 +00:00
, uPlatformOverride :: Maybe PlatformRequest
, uMirrors :: Maybe DownloadMirrors
}
deriving (Show, GHC.Generic, Eq)
defaultUserSettings :: UserSettings
defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
2021-08-11 14:19:31 +00:00
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{..} Nothing =
UserSettings {
uCache = Just cache
, uMetaCache = Just metaCache
, uMetaMode = Just metaMode
2021-08-11 14:19:31 +00:00
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Nothing
, uUrlSource = Just urlSource
2021-09-18 17:45:32 +00:00
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
2022-12-03 16:15:13 +00:00
, uMirrors = Just mirrors
2021-08-11 14:19:31 +00:00
}
fromSettings Settings{..} (Just KeyBindings{..}) =
let ukb = UserKeyBindings
{ kUp = Just bUp
, kDown = Just bDown
, kQuit = Just bQuit
, kInstall = Just bInstall
, kUninstall = Just bUninstall
, kSet = Just bSet
, kChangelog = Just bChangelog
2021-08-11 14:19:31 +00:00
, kShowAll = Just bShowAllVersions
}
in UserSettings {
uCache = Just cache
, uMetaCache = Just metaCache
, uMetaMode = Just metaMode
2021-08-11 14:19:31 +00:00
, uNoVerify = Just noVerify
, uVerbose = Just verbose
, uKeepDirs = Just keepDirs
, uDownloader = Just downloader
, uNoNetwork = Just noNetwork
, uKeyBindings = Just ukb
, uUrlSource = Just urlSource
2021-09-18 17:45:32 +00:00
, uGPGSetting = Just gpgSetting
, uPlatformOverride = platformOverride
2022-12-03 16:15:13 +00:00
, uMirrors = Just mirrors
2021-08-11 14:19:31 +00:00
}
data UserKeyBindings = UserKeyBindings
{ kUp :: Maybe KeyCombination
, kDown :: Maybe KeyCombination
, kQuit :: Maybe KeyCombination
, kInstall :: Maybe KeyCombination
, kUninstall :: Maybe KeyCombination
, kSet :: Maybe KeyCombination
, kChangelog :: Maybe KeyCombination
, kShowAll :: Maybe KeyCombination
}
deriving (Show, GHC.Generic, Eq)
data KeyBindings = KeyBindings
{ bUp :: KeyCombination
, bDown :: KeyCombination
, bQuit :: KeyCombination
, bInstall :: KeyCombination
, bUninstall :: KeyCombination
, bSet :: KeyCombination
, bChangelog :: KeyCombination
, bShowAllVersions :: KeyCombination
}
deriving (Show, GHC.Generic)
2021-07-15 11:32:48 +00:00
instance NFData KeyBindings
2023-11-05 10:00:23 +00:00
#if !defined(BRICK)
2023-01-12 16:26:15 +00:00
instance NFData Key
instance NFData Modifier
2023-01-12 16:26:15 +00:00
#endif
instance NFData KeyCombination
2021-07-15 11:32:48 +00:00
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
{ bUp = KeyCombination { key = KUp , mods = [] }
, bDown = KeyCombination { key = KDown , mods = [] }
, bQuit = KeyCombination { key = KChar 'q', mods = [] }
, bInstall = KeyCombination { key = KChar 'i', mods = [] }
, bUninstall = KeyCombination { key = KChar 'u', mods = [] }
, bSet = KeyCombination { key = KChar 's', mods = [] }
, bChangelog = KeyCombination { key = KChar 'c', mods = [] }
, bShowAllVersions = KeyCombination { key = KChar 'a', mods = [] }
}
2020-10-23 23:06:53 +00:00
data AppState = AppState
{ settings :: Settings
, dirs :: Dirs
, keyBindings :: KeyBindings
, ghcupInfo :: GHCupInfo
, pfreq :: PlatformRequest
2021-08-30 20:41:58 +00:00
, loggerConfig :: LoggerConfig
} deriving (Show, GHC.Generic)
2021-07-18 21:29:09 +00:00
instance NFData AppState
fromAppState :: AppState -> LeanAppState
fromAppState AppState {..} = LeanAppState {..}
data LeanAppState = LeanAppState
{ settings :: Settings
, dirs :: Dirs
, keyBindings :: KeyBindings
2021-08-30 20:41:58 +00:00
, loggerConfig :: LoggerConfig
2021-07-15 11:32:48 +00:00
} deriving (Show, GHC.Generic)
2021-07-18 21:29:09 +00:00
instance NFData LeanAppState
2020-10-23 23:06:53 +00:00
2020-01-11 20:15:05 +00:00
data Settings = Settings
{ cache :: Bool
, metaCache :: Integer
, metaMode :: MetaMode
, noVerify :: Bool
, keepDirs :: KeepDirs
, downloader :: Downloader
, verbose :: Bool
, urlSource :: URLSource
, noNetwork :: Bool
, gpgSetting :: GPGSetting
, noColor :: Bool -- this also exists in LoggerConfig
, platformOverride :: Maybe PlatformRequest
2022-12-03 16:15:13 +00:00
, mirrors :: DownloadMirrors
2020-01-11 20:15:05 +00:00
}
deriving (Show, GHC.Generic)
2020-01-11 20:15:05 +00:00
defaultMetaCache :: Integer
defaultMetaCache = 300 -- 5 minutes
defaultSettings :: Settings
defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
2021-07-15 11:32:48 +00:00
instance NFData Settings
2020-07-31 18:10:40 +00:00
data Dirs = Dirs
2022-05-20 21:19:33 +00:00
{ baseDir :: GHCupPath
, binDir :: FilePath
, cacheDir :: GHCupPath
, logsDir :: GHCupPath
, confDir :: GHCupPath
, dbDir :: GHCupPath
, recycleDir :: GHCupPath -- mainly used on windows
2022-05-20 21:19:33 +00:00
, tmpDir :: GHCupPath
, msys2Dir :: FilePath
2020-07-31 18:10:40 +00:00
}
2021-07-15 11:32:48 +00:00
deriving (Show, GHC.Generic)
instance NFData Dirs
2020-01-11 20:15:05 +00:00
data MSYS2Env = MSYS
| UCRT64
| CLANG64
| CLANGARM64
| CLANG32
| MINGW64
| MINGW32
deriving (Eq, Show, Ord, GHC.Generic, Read)
instance NFData MSYS2Env
2020-04-22 16:12:40 +00:00
data KeepDirs = Always
| Errors
| Never
2021-07-15 11:32:48 +00:00
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData KeepDirs
2020-04-22 16:12:40 +00:00
2020-04-29 17:12:58 +00:00
data Downloader = Curl
| Wget
#if defined(INTERNAL_DOWNLOADER)
| Internal
#endif
2021-07-15 11:32:48 +00:00
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData Downloader
2020-04-22 16:12:40 +00:00
2021-09-18 17:45:32 +00:00
data GPGSetting = GPGStrict
| GPGLax
| GPGNone
deriving (Eq, Show, Ord, GHC.Generic)
instance NFData GPGSetting
2020-01-11 20:15:05 +00:00
data DebugInfo = DebugInfo
2021-05-14 21:09:45 +00:00
{ diBaseDir :: FilePath
, diBinDir :: FilePath
, diGHCDir :: FilePath
, diCacheDir :: FilePath
2020-03-17 17:39:01 +00:00
, diArch :: Architecture
, diPlatform :: PlatformResult
2020-01-11 20:15:05 +00:00
}
deriving Show
data SetGHC = SetGHCOnly -- ^ unversioned 'ghc'
| SetGHC_XY -- ^ ghc-x.y
| SetGHC_XYZ -- ^ ghc-x.y.z
deriving (Eq, Show)
2022-02-05 00:53:04 +00:00
data SetHLS = SetHLSOnly -- ^ unversioned 'hls'
| SetHLS_XYZ -- ^ haskell-language-server-a.b.c~x.y.z, where a.b.c is GHC version and x.y.z is HLS version
deriving (Eq, Show)
2020-01-11 20:15:05 +00:00
data PlatformResult = PlatformResult
{ _platform :: Platform
, _distroVersion :: Maybe Versioning
}
2021-07-15 11:32:48 +00:00
deriving (Eq, Show, GHC.Generic)
instance NFData PlatformResult
2020-01-11 20:15:05 +00:00
platResToString :: PlatformResult -> String
platResToString PlatformResult { _platform = plat, _distroVersion = Just v' }
= show plat <> ", " <> T.unpack (prettyV v')
platResToString PlatformResult { _platform = plat, _distroVersion = Nothing }
= show plat
instance Pretty PlatformResult where
pPrint = text . platResToString
2020-01-11 20:15:05 +00:00
data PlatformRequest = PlatformRequest
{ _rArch :: Architecture
, _rPlatform :: Platform
, _rVersion :: Maybe Versioning
}
2021-07-15 11:32:48 +00:00
deriving (Eq, Show, GHC.Generic)
instance NFData PlatformRequest
2020-04-25 10:06:41 +00:00
pfReqToString :: PlatformRequest -> String
pfReqToString (PlatformRequest arch plat ver) =
archToString arch ++ "-" ++ platformToString plat ++ pver
where
pver = case ver of
2021-03-11 16:03:51 +00:00
Just v' -> "-" ++ T.unpack (prettyV v')
Nothing -> ""
2020-04-25 10:06:41 +00:00
instance Pretty PlatformRequest where
pPrint = text . pfReqToString
2020-04-25 10:06:41 +00:00
-- | A GHC identified by the target platform triple
-- and the version.
data GHCTargetVersion = GHCTargetVersion
{ _tvTarget :: Maybe Text
, _tvVersion :: Version
}
2023-07-07 08:41:58 +00:00
deriving (Ord, Eq, Show, GHC.Generic)
instance NFData GHCTargetVersion
2020-04-25 10:06:41 +00:00
2021-04-28 16:45:48 +00:00
data GitBranch = GitBranch
{ ref :: String
, repo :: Maybe String
}
deriving (Ord, Eq, Show)
2020-04-25 10:06:41 +00:00
mkTVer :: Version -> GHCTargetVersion
mkTVer = GHCTargetVersion Nothing
tVerToText :: GHCTargetVersion -> Text
tVerToText (GHCTargetVersion (Just t) v') = t <> "-" <> prettyVer v'
tVerToText (GHCTargetVersion Nothing v') = prettyVer v'
2020-04-25 10:06:41 +00:00
-- | Assembles a path of the form: <target-triple>-<version>
instance Pretty GHCTargetVersion where
pPrint = text . T.unpack . tVerToText
2020-04-25 10:06:41 +00:00
-- | A comparator and a version.
data VersionCmp = VR_gt Versioning
| VR_gteq Versioning
| VR_lt Versioning
| VR_lteq Versioning
| VR_eq Versioning
deriving (Eq, GHC.Generic, Ord, Show)
2021-07-15 11:32:48 +00:00
instance NFData VersionCmp
-- | A version range. Supports && and ||, but not arbitrary
-- combinations. This is a little simplified.
data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
| OrRange (NonEmpty VersionCmp) VersionRange
deriving (Eq, GHC.Generic, Ord, Show)
2021-07-15 11:32:48 +00:00
instance NFData VersionRange
instance Pretty VersionCmp where
pPrint (VR_gt v) = text "> " <> pPrint v
pPrint (VR_gteq v) = text ">= " <> pPrint v
pPrint (VR_lt v) = text "< " <> pPrint v
pPrint (VR_lteq v) = text "<= " <> pPrint v
pPrint (VR_eq v) = text "= " <> pPrint v
instance Pretty VersionRange where
pPrint (SimpleRange xs) = foldl1 (\x y -> x <> text " && " <> y) $ NE.map pPrint xs
pPrint (OrRange xs vr) = foldMap pPrint xs <> " || " <> pPrint vr
instance Pretty Versioning where
pPrint = text . T.unpack . prettyV
instance Pretty Version where
pPrint = text . T.unpack . prettyVer
2021-05-14 21:09:45 +00:00
2021-08-30 20:41:58 +00:00
instance Show (a -> b) where
show _ = "<function>"
2021-05-14 21:09:45 +00:00
2021-08-30 20:41:58 +00:00
instance Show (IO ()) where
show _ = "<io>"
2021-05-14 21:09:45 +00:00
2021-08-30 20:41:58 +00:00
data LogLevel = Warn
| Info
| Debug
| Error
deriving (Eq, Ord, Show)
2021-05-14 21:09:45 +00:00
2021-08-30 20:41:58 +00:00
data LoggerConfig = LoggerConfig
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
, consoleOutter :: T.Text -> IO () -- ^ how to write the console output
, fileOutter :: T.Text -> IO () -- ^ how to write the file output
, fancyColors :: Bool
2021-08-30 20:41:58 +00:00
}
deriving Show
instance NFData LoggerConfig where
rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)
data ProcessError = NonZeroExit Int FilePath [String]
| PTerminated FilePath [String]
| PStopped FilePath [String]
| NoSuchPid FilePath [String]
deriving Show
data CapturedProcess = CapturedProcess
{ _exitCode :: ExitCode
, _stdOut :: BL.ByteString
, _stdErr :: BL.ByteString
}
deriving (Eq, Show)
makeLenses ''CapturedProcess
data InstallDir = IsolateDir FilePath
| GHCupInternal
deriving (Eq, Show)
data InstallDirResolved = IsolateDirResolved FilePath
| GHCupDir GHCupPath
| GHCupBinDir FilePath
deriving (Eq, Show)
fromInstallDir :: InstallDirResolved -> FilePath
fromInstallDir (IsolateDirResolved fp) = fp
fromInstallDir (GHCupDir fp) = fromGHCupPath fp
fromInstallDir (GHCupBinDir fp) = fp
isSafeDir :: InstallDirResolved -> Bool
isSafeDir (IsolateDirResolved _) = False
isSafeDir (GHCupDir _) = True
isSafeDir (GHCupBinDir _) = False
type PromptQuestion = Text
data PromptResponse = PromptYes | PromptNo
deriving (Show, Eq)
data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version
| ToolTag Tag
| ToolDay Day
2023-07-22 09:14:49 +00:00
deriving (Eq, Show)
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)
data BuildSystem = Hadrian
| Make
deriving (Show, Eq)
data VersionPattern = CabalVer
| GitHashShort
| GitHashLong
| GitDescribe
| GitBranchName
| S String
deriving (Eq, Show)