{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE DuplicateRecordFields #-}

{-|
Module      : GHCup.Types
Description : GHCup types
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
module GHCup.Types
  ( module GHCup.Types
#if defined(BRICK)
  , Key(..)
  , Modifier(..)
#endif
  )
  where

import           GHCup.Types.Stack              ( SetupInfo )
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 )
import           Optics                         ( makeLenses )
import           Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
import           URI.ByteString
#if defined(BRICK)
import           Graphics.Vty                   ( Key(..), Modifier(..) )
#endif

import qualified Data.ByteString.Lazy          as BL
import qualified Data.Text                     as T
import qualified GHC.Generics                  as GHC
import qualified Data.List.NonEmpty            as NE

#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)
#endif

data KeyCombination = KeyCombination { KeyCombination -> Key
key :: Key, KeyCombination -> [Modifier]
mods :: [Modifier] }
    deriving (KeyCombination -> KeyCombination -> Bool
(KeyCombination -> KeyCombination -> Bool)
-> (KeyCombination -> KeyCombination -> Bool) -> Eq KeyCombination
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyCombination -> KeyCombination -> Bool
== :: KeyCombination -> KeyCombination -> Bool
$c/= :: KeyCombination -> KeyCombination -> Bool
/= :: KeyCombination -> KeyCombination -> Bool
Eq,Int -> KeyCombination -> ShowS
[KeyCombination] -> ShowS
KeyCombination -> String
(Int -> KeyCombination -> ShowS)
-> (KeyCombination -> String)
-> ([KeyCombination] -> ShowS)
-> Show KeyCombination
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyCombination -> ShowS
showsPrec :: Int -> KeyCombination -> ShowS
$cshow :: KeyCombination -> String
show :: KeyCombination -> String
$cshowList :: [KeyCombination] -> ShowS
showList :: [KeyCombination] -> ShowS
Show,ReadPrec [KeyCombination]
ReadPrec KeyCombination
Int -> ReadS KeyCombination
ReadS [KeyCombination]
(Int -> ReadS KeyCombination)
-> ReadS [KeyCombination]
-> ReadPrec KeyCombination
-> ReadPrec [KeyCombination]
-> Read KeyCombination
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS KeyCombination
readsPrec :: Int -> ReadS KeyCombination
$creadList :: ReadS [KeyCombination]
readList :: ReadS [KeyCombination]
$creadPrec :: ReadPrec KeyCombination
readPrec :: ReadPrec KeyCombination
$creadListPrec :: ReadPrec [KeyCombination]
readListPrec :: ReadPrec [KeyCombination]
Read,Eq KeyCombination
Eq KeyCombination
-> (KeyCombination -> KeyCombination -> Ordering)
-> (KeyCombination -> KeyCombination -> Bool)
-> (KeyCombination -> KeyCombination -> Bool)
-> (KeyCombination -> KeyCombination -> Bool)
-> (KeyCombination -> KeyCombination -> Bool)
-> (KeyCombination -> KeyCombination -> KeyCombination)
-> (KeyCombination -> KeyCombination -> KeyCombination)
-> Ord KeyCombination
KeyCombination -> KeyCombination -> Bool
KeyCombination -> KeyCombination -> Ordering
KeyCombination -> KeyCombination -> KeyCombination
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeyCombination -> KeyCombination -> Ordering
compare :: KeyCombination -> KeyCombination -> Ordering
$c< :: KeyCombination -> KeyCombination -> Bool
< :: KeyCombination -> KeyCombination -> Bool
$c<= :: KeyCombination -> KeyCombination -> Bool
<= :: KeyCombination -> KeyCombination -> Bool
$c> :: KeyCombination -> KeyCombination -> Bool
> :: KeyCombination -> KeyCombination -> Bool
$c>= :: KeyCombination -> KeyCombination -> Bool
>= :: KeyCombination -> KeyCombination -> Bool
$cmax :: KeyCombination -> KeyCombination -> KeyCombination
max :: KeyCombination -> KeyCombination -> KeyCombination
$cmin :: KeyCombination -> KeyCombination -> KeyCombination
min :: KeyCombination -> KeyCombination -> KeyCombination
Ord,(forall x. KeyCombination -> Rep KeyCombination x)
-> (forall x. Rep KeyCombination x -> KeyCombination)
-> Generic KeyCombination
forall x. Rep KeyCombination x -> KeyCombination
forall x. KeyCombination -> Rep KeyCombination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyCombination -> Rep KeyCombination x
from :: forall x. KeyCombination -> Rep KeyCombination x
$cto :: forall x. Rep KeyCombination x -> KeyCombination
to :: forall x. Rep KeyCombination x -> KeyCombination
GHC.Generic)



    --------------------
    --[ GHCInfo Tree ]--
    --------------------


data GHCupInfo = GHCupInfo
  { GHCupInfo -> ToolRequirements
_toolRequirements :: ToolRequirements
  , GHCupInfo -> GHCupDownloads
_ghcupDownloads   :: GHCupDownloads
  , GHCupInfo -> Map GlobalTool DownloadInfo
_globalTools      :: Map GlobalTool DownloadInfo
  }
  deriving (Int -> GHCupInfo -> ShowS
[GHCupInfo] -> ShowS
GHCupInfo -> String
(Int -> GHCupInfo -> ShowS)
-> (GHCupInfo -> String)
-> ([GHCupInfo] -> ShowS)
-> Show GHCupInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GHCupInfo -> ShowS
showsPrec :: Int -> GHCupInfo -> ShowS
$cshow :: GHCupInfo -> String
show :: GHCupInfo -> String
$cshowList :: [GHCupInfo] -> ShowS
showList :: [GHCupInfo] -> ShowS
Show, (forall x. GHCupInfo -> Rep GHCupInfo x)
-> (forall x. Rep GHCupInfo x -> GHCupInfo) -> Generic GHCupInfo
forall x. Rep GHCupInfo x -> GHCupInfo
forall x. GHCupInfo -> Rep GHCupInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GHCupInfo -> Rep GHCupInfo x
from :: forall x. GHCupInfo -> Rep GHCupInfo x
$cto :: forall x. Rep GHCupInfo x -> GHCupInfo
to :: forall x. Rep GHCupInfo x -> GHCupInfo
GHC.Generic, GHCupInfo -> GHCupInfo -> Bool
(GHCupInfo -> GHCupInfo -> Bool)
-> (GHCupInfo -> GHCupInfo -> Bool) -> Eq GHCupInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GHCupInfo -> GHCupInfo -> Bool
== :: GHCupInfo -> GHCupInfo -> Bool
$c/= :: GHCupInfo -> GHCupInfo -> Bool
/= :: GHCupInfo -> GHCupInfo -> Bool
Eq)

instance NFData GHCupInfo



    -------------------------
    --[ Requirements Tree ]--
    -------------------------


type ToolRequirements = Map Tool ToolReqVersionSpec
type ToolReqVersionSpec = Map (Maybe Version) PlatformReqSpec
type PlatformReqSpec = Map Platform PlatformReqVersionSpec
type PlatformReqVersionSpec = Map (Maybe VersionRange) Requirements


data Requirements = Requirements
  { Requirements -> [Text]
_distroPKGs :: [Text]
  , Requirements -> Text
_notes      :: Text
  }
  deriving (Int -> Requirements -> ShowS
[Requirements] -> ShowS
Requirements -> String
(Int -> Requirements -> ShowS)
-> (Requirements -> String)
-> ([Requirements] -> ShowS)
-> Show Requirements
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Requirements -> ShowS
showsPrec :: Int -> Requirements -> ShowS
$cshow :: Requirements -> String
show :: Requirements -> String
$cshowList :: [Requirements] -> ShowS
showList :: [Requirements] -> ShowS
Show, (forall x. Requirements -> Rep Requirements x)
-> (forall x. Rep Requirements x -> Requirements)
-> Generic Requirements
forall x. Rep Requirements x -> Requirements
forall x. Requirements -> Rep Requirements x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Requirements -> Rep Requirements x
from :: forall x. Requirements -> Rep Requirements x
$cto :: forall x. Rep Requirements x -> Requirements
to :: forall x. Rep Requirements x -> Requirements
GHC.Generic, Requirements -> Requirements -> Bool
(Requirements -> Requirements -> Bool)
-> (Requirements -> Requirements -> Bool) -> Eq Requirements
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Requirements -> Requirements -> Bool
== :: Requirements -> Requirements -> Bool
$c/= :: Requirements -> Requirements -> Bool
/= :: Requirements -> Requirements -> Bool
Eq)

instance NFData Requirements





    ---------------------
    --[ Download Tree ]--
    ---------------------


-- | Description of all binary and source downloads. This is a tree
-- of nested maps.
type GHCupDownloads = Map Tool ToolVersionSpec
type ToolVersionSpec = Map GHCTargetVersion VersionInfo
type ArchitectureSpec = Map Architecture PlatformSpec
type PlatformSpec = Map Platform PlatformVersionSpec
type PlatformVersionSpec = Map (Maybe VersionRange) DownloadInfo


-- | An installable tool.
data Tool = GHC
          | Cabal
          | GHCup
          | HLS
          | Stack
  deriving (Tool -> Tool -> Bool
(Tool -> Tool -> Bool) -> (Tool -> Tool -> Bool) -> Eq Tool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tool -> Tool -> Bool
== :: Tool -> Tool -> Bool
$c/= :: Tool -> Tool -> Bool
/= :: Tool -> Tool -> Bool
Eq, (forall x. Tool -> Rep Tool x)
-> (forall x. Rep Tool x -> Tool) -> Generic Tool
forall x. Rep Tool x -> Tool
forall x. Tool -> Rep Tool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tool -> Rep Tool x
from :: forall x. Tool -> Rep Tool x
$cto :: forall x. Rep Tool x -> Tool
to :: forall x. Rep Tool x -> Tool
GHC.Generic, Eq Tool
Eq Tool
-> (Tool -> Tool -> Ordering)
-> (Tool -> Tool -> Bool)
-> (Tool -> Tool -> Bool)
-> (Tool -> Tool -> Bool)
-> (Tool -> Tool -> Bool)
-> (Tool -> Tool -> Tool)
-> (Tool -> Tool -> Tool)
-> Ord Tool
Tool -> Tool -> Bool
Tool -> Tool -> Ordering
Tool -> Tool -> Tool
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tool -> Tool -> Ordering
compare :: Tool -> Tool -> Ordering
$c< :: Tool -> Tool -> Bool
< :: Tool -> Tool -> Bool
$c<= :: Tool -> Tool -> Bool
<= :: Tool -> Tool -> Bool
$c> :: Tool -> Tool -> Bool
> :: Tool -> Tool -> Bool
$c>= :: Tool -> Tool -> Bool
>= :: Tool -> Tool -> Bool
$cmax :: Tool -> Tool -> Tool
max :: Tool -> Tool -> Tool
$cmin :: Tool -> Tool -> Tool
min :: Tool -> Tool -> Tool
Ord, Int -> Tool -> ShowS
[Tool] -> ShowS
Tool -> String
(Int -> Tool -> ShowS)
-> (Tool -> String) -> ([Tool] -> ShowS) -> Show Tool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tool -> ShowS
showsPrec :: Int -> Tool -> ShowS
$cshow :: Tool -> String
show :: Tool -> String
$cshowList :: [Tool] -> ShowS
showList :: [Tool] -> ShowS
Show, Int -> Tool
Tool -> Int
Tool -> [Tool]
Tool -> Tool
Tool -> Tool -> [Tool]
Tool -> Tool -> Tool -> [Tool]
(Tool -> Tool)
-> (Tool -> Tool)
-> (Int -> Tool)
-> (Tool -> Int)
-> (Tool -> [Tool])
-> (Tool -> Tool -> [Tool])
-> (Tool -> Tool -> [Tool])
-> (Tool -> Tool -> Tool -> [Tool])
-> Enum Tool
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Tool -> Tool
succ :: Tool -> Tool
$cpred :: Tool -> Tool
pred :: Tool -> Tool
$ctoEnum :: Int -> Tool
toEnum :: Int -> Tool
$cfromEnum :: Tool -> Int
fromEnum :: Tool -> Int
$cenumFrom :: Tool -> [Tool]
enumFrom :: Tool -> [Tool]
$cenumFromThen :: Tool -> Tool -> [Tool]
enumFromThen :: Tool -> Tool -> [Tool]
$cenumFromTo :: Tool -> Tool -> [Tool]
enumFromTo :: Tool -> Tool -> [Tool]
$cenumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
enumFromThenTo :: Tool -> Tool -> Tool -> [Tool]
Enum, Tool
Tool -> Tool -> Bounded Tool
forall a. a -> a -> Bounded a
$cminBound :: Tool
minBound :: Tool
$cmaxBound :: Tool
maxBound :: Tool
Bounded)

instance Pretty Tool where
  pPrint :: Tool -> Doc
pPrint Tool
GHC = String -> Doc
text String
"ghc"
  pPrint Tool
Cabal = String -> Doc
text String
"cabal"
  pPrint Tool
GHCup = String -> Doc
text String
"ghcup"
  pPrint Tool
HLS = String -> Doc
text String
"hls"
  pPrint Tool
Stack = String -> Doc
text String
"stack"

instance NFData Tool

data GlobalTool = ShimGen
  deriving (GlobalTool -> GlobalTool -> Bool
(GlobalTool -> GlobalTool -> Bool)
-> (GlobalTool -> GlobalTool -> Bool) -> Eq GlobalTool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalTool -> GlobalTool -> Bool
== :: GlobalTool -> GlobalTool -> Bool
$c/= :: GlobalTool -> GlobalTool -> Bool
/= :: GlobalTool -> GlobalTool -> Bool
Eq, (forall x. GlobalTool -> Rep GlobalTool x)
-> (forall x. Rep GlobalTool x -> GlobalTool) -> Generic GlobalTool
forall x. Rep GlobalTool x -> GlobalTool
forall x. GlobalTool -> Rep GlobalTool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GlobalTool -> Rep GlobalTool x
from :: forall x. GlobalTool -> Rep GlobalTool x
$cto :: forall x. Rep GlobalTool x -> GlobalTool
to :: forall x. Rep GlobalTool x -> GlobalTool
GHC.Generic, Eq GlobalTool
Eq GlobalTool
-> (GlobalTool -> GlobalTool -> Ordering)
-> (GlobalTool -> GlobalTool -> Bool)
-> (GlobalTool -> GlobalTool -> Bool)
-> (GlobalTool -> GlobalTool -> Bool)
-> (GlobalTool -> GlobalTool -> Bool)
-> (GlobalTool -> GlobalTool -> GlobalTool)
-> (GlobalTool -> GlobalTool -> GlobalTool)
-> Ord GlobalTool
GlobalTool -> GlobalTool -> Bool
GlobalTool -> GlobalTool -> Ordering
GlobalTool -> GlobalTool -> GlobalTool
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GlobalTool -> GlobalTool -> Ordering
compare :: GlobalTool -> GlobalTool -> Ordering
$c< :: GlobalTool -> GlobalTool -> Bool
< :: GlobalTool -> GlobalTool -> Bool
$c<= :: GlobalTool -> GlobalTool -> Bool
<= :: GlobalTool -> GlobalTool -> Bool
$c> :: GlobalTool -> GlobalTool -> Bool
> :: GlobalTool -> GlobalTool -> Bool
$c>= :: GlobalTool -> GlobalTool -> Bool
>= :: GlobalTool -> GlobalTool -> Bool
$cmax :: GlobalTool -> GlobalTool -> GlobalTool
max :: GlobalTool -> GlobalTool -> GlobalTool
$cmin :: GlobalTool -> GlobalTool -> GlobalTool
min :: GlobalTool -> GlobalTool -> GlobalTool
Ord, Int -> GlobalTool -> ShowS
[GlobalTool] -> ShowS
GlobalTool -> String
(Int -> GlobalTool -> ShowS)
-> (GlobalTool -> String)
-> ([GlobalTool] -> ShowS)
-> Show GlobalTool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlobalTool -> ShowS
showsPrec :: Int -> GlobalTool -> ShowS
$cshow :: GlobalTool -> String
show :: GlobalTool -> String
$cshowList :: [GlobalTool] -> ShowS
showList :: [GlobalTool] -> ShowS
Show, Int -> GlobalTool
GlobalTool -> Int
GlobalTool -> [GlobalTool]
GlobalTool -> GlobalTool
GlobalTool -> GlobalTool -> [GlobalTool]
GlobalTool -> GlobalTool -> GlobalTool -> [GlobalTool]
(GlobalTool -> GlobalTool)
-> (GlobalTool -> GlobalTool)
-> (Int -> GlobalTool)
-> (GlobalTool -> Int)
-> (GlobalTool -> [GlobalTool])
-> (GlobalTool -> GlobalTool -> [GlobalTool])
-> (GlobalTool -> GlobalTool -> [GlobalTool])
-> (GlobalTool -> GlobalTool -> GlobalTool -> [GlobalTool])
-> Enum GlobalTool
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GlobalTool -> GlobalTool
succ :: GlobalTool -> GlobalTool
$cpred :: GlobalTool -> GlobalTool
pred :: GlobalTool -> GlobalTool
$ctoEnum :: Int -> GlobalTool
toEnum :: Int -> GlobalTool
$cfromEnum :: GlobalTool -> Int
fromEnum :: GlobalTool -> Int
$cenumFrom :: GlobalTool -> [GlobalTool]
enumFrom :: GlobalTool -> [GlobalTool]
$cenumFromThen :: GlobalTool -> GlobalTool -> [GlobalTool]
enumFromThen :: GlobalTool -> GlobalTool -> [GlobalTool]
$cenumFromTo :: GlobalTool -> GlobalTool -> [GlobalTool]
enumFromTo :: GlobalTool -> GlobalTool -> [GlobalTool]
$cenumFromThenTo :: GlobalTool -> GlobalTool -> GlobalTool -> [GlobalTool]
enumFromThenTo :: GlobalTool -> GlobalTool -> GlobalTool -> [GlobalTool]
Enum, GlobalTool
GlobalTool -> GlobalTool -> Bounded GlobalTool
forall a. a -> a -> Bounded a
$cminBound :: GlobalTool
minBound :: GlobalTool
$cmaxBound :: GlobalTool
maxBound :: GlobalTool
Bounded)

instance NFData GlobalTool

instance Pretty GlobalTool where
  pPrint :: GlobalTool -> Doc
pPrint GlobalTool
ShimGen = String -> Doc
text String
"shimgen"


-- | All necessary information of a tool version, including
-- source download and per-architecture downloads.
data VersionInfo = VersionInfo
  { VersionInfo -> [Tag]
_viTags        :: [Tag]              -- ^ version specific tag
  , VersionInfo -> Maybe Day
_viReleaseDay  :: Maybe Day
  , VersionInfo -> Maybe URI
_viChangeLog   :: Maybe URI
  , VersionInfo -> Maybe DownloadInfo
_viSourceDL    :: Maybe DownloadInfo -- ^ source tarball
  , VersionInfo -> Maybe DownloadInfo
_viTestDL      :: Maybe DownloadInfo -- ^ test tarball
  , VersionInfo -> ArchitectureSpec
_viArch        :: ArchitectureSpec   -- ^ descend for binary downloads per arch
  -- informative messages
  , VersionInfo -> Maybe Text
_viPostInstall :: Maybe Text
  , VersionInfo -> Maybe Text
_viPostRemove  :: Maybe Text
  , VersionInfo -> Maybe Text
_viPreCompile  :: Maybe Text
  }
  deriving (VersionInfo -> VersionInfo -> Bool
(VersionInfo -> VersionInfo -> Bool)
-> (VersionInfo -> VersionInfo -> Bool) -> Eq VersionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionInfo -> VersionInfo -> Bool
== :: VersionInfo -> VersionInfo -> Bool
$c/= :: VersionInfo -> VersionInfo -> Bool
/= :: VersionInfo -> VersionInfo -> Bool
Eq, (forall x. VersionInfo -> Rep VersionInfo x)
-> (forall x. Rep VersionInfo x -> VersionInfo)
-> Generic VersionInfo
forall x. Rep VersionInfo x -> VersionInfo
forall x. VersionInfo -> Rep VersionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VersionInfo -> Rep VersionInfo x
from :: forall x. VersionInfo -> Rep VersionInfo x
$cto :: forall x. Rep VersionInfo x -> VersionInfo
to :: forall x. Rep VersionInfo x -> VersionInfo
GHC.Generic, Int -> VersionInfo -> ShowS
[VersionInfo] -> ShowS
VersionInfo -> String
(Int -> VersionInfo -> ShowS)
-> (VersionInfo -> String)
-> ([VersionInfo] -> ShowS)
-> Show VersionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionInfo -> ShowS
showsPrec :: Int -> VersionInfo -> ShowS
$cshow :: VersionInfo -> String
show :: VersionInfo -> String
$cshowList :: [VersionInfo] -> ShowS
showList :: [VersionInfo] -> ShowS
Show)

instance NFData VersionInfo


-- | 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)
         | Prerelease         -- ^ denotes a prerelease version
                              --   (a version should either be 'Prerelease' or
                              --   'LatestPrerelease', but not both)
         | LatestPrerelease   -- ^ the latest prerelease (unique per tool)
         | Nightly            -- ^ denotes a nightly version
                              --   (a version should either be 'Nightly' or
                              --   'LatestNightly', but not both)
         | LatestNightly      -- ^ the latest nightly (unique per tool)
         | Base PVP           -- ^ the base version shipped with GHC
         | Old                -- ^ old versions are hidden by default in TUI
         | UnknownTag String  -- ^ used for upwardscompat
         deriving (Eq Tag
Eq Tag
-> (Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tag -> Tag -> Ordering
compare :: Tag -> Tag -> Ordering
$c< :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
>= :: Tag -> Tag -> Bool
$cmax :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
min :: Tag -> Tag -> Tag
Ord, Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
/= :: Tag -> Tag -> Bool
Eq, (forall x. Tag -> Rep Tag x)
-> (forall x. Rep Tag x -> Tag) -> Generic Tag
forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tag -> Rep Tag x
from :: forall x. Tag -> Rep Tag x
$cto :: forall x. Rep Tag x -> Tag
to :: forall x. Rep Tag x -> Tag
GHC.Generic, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tag -> ShowS
showsPrec :: Int -> Tag -> ShowS
$cshow :: Tag -> String
show :: Tag -> String
$cshowList :: [Tag] -> ShowS
showList :: [Tag] -> ShowS
Show) -- FIXME: manual JSON instance

instance NFData Tag

tagToString :: Tag -> String
tagToString :: Tag -> String
tagToString Tag
Recommended        = String
"recommended"
tagToString Tag
Latest             = String
"latest"
tagToString Tag
Prerelease         = String
"prerelease"
tagToString Tag
Nightly            = String
"nightly"
tagToString (Base       PVP
pvp'') = String
"base-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (PVP -> Text
prettyPVP PVP
pvp'')
tagToString (UnknownTag String
t    ) = String
t
tagToString Tag
LatestPrerelease   = String
"latest-prerelease"
tagToString Tag
LatestNightly      = String
"latest-nightly"
tagToString Tag
Old                = String
""

instance Pretty Tag where
  pPrint :: Tag -> Doc
pPrint Tag
Recommended        = String -> Doc
text String
"recommended"
  pPrint Tag
Latest             = String -> Doc
text String
"latest"
  pPrint Tag
Prerelease         = String -> Doc
text String
"prerelease"
  pPrint Tag
Nightly            = String -> Doc
text String
"nightly"
  pPrint (Base       PVP
pvp'') = String -> Doc
text (String
"base-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (PVP -> Text
prettyPVP PVP
pvp''))
  pPrint (UnknownTag String
t    ) = String -> Doc
text String
t
  pPrint Tag
LatestPrerelease   = String -> Doc
text String
"latest-prerelease"
  pPrint Tag
LatestNightly      = String -> Doc
text String
"latest-prerelease"
  pPrint Tag
Old                = Doc
forall a. Monoid a => a
mempty

data Architecture = A_64
                  | A_32
                  | A_PowerPC
                  | A_PowerPC64
                  | A_Sparc
                  | A_Sparc64
                  | A_ARM
                  | A_ARM64
  deriving (Architecture -> Architecture -> Bool
(Architecture -> Architecture -> Bool)
-> (Architecture -> Architecture -> Bool) -> Eq Architecture
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Architecture -> Architecture -> Bool
== :: Architecture -> Architecture -> Bool
$c/= :: Architecture -> Architecture -> Bool
/= :: Architecture -> Architecture -> Bool
Eq, (forall x. Architecture -> Rep Architecture x)
-> (forall x. Rep Architecture x -> Architecture)
-> Generic Architecture
forall x. Rep Architecture x -> Architecture
forall x. Architecture -> Rep Architecture x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Architecture -> Rep Architecture x
from :: forall x. Architecture -> Rep Architecture x
$cto :: forall x. Rep Architecture x -> Architecture
to :: forall x. Rep Architecture x -> Architecture
GHC.Generic, Eq Architecture
Eq Architecture
-> (Architecture -> Architecture -> Ordering)
-> (Architecture -> Architecture -> Bool)
-> (Architecture -> Architecture -> Bool)
-> (Architecture -> Architecture -> Bool)
-> (Architecture -> Architecture -> Bool)
-> (Architecture -> Architecture -> Architecture)
-> (Architecture -> Architecture -> Architecture)
-> Ord Architecture
Architecture -> Architecture -> Bool
Architecture -> Architecture -> Ordering
Architecture -> Architecture -> Architecture
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Architecture -> Architecture -> Ordering
compare :: Architecture -> Architecture -> Ordering
$c< :: Architecture -> Architecture -> Bool
< :: Architecture -> Architecture -> Bool
$c<= :: Architecture -> Architecture -> Bool
<= :: Architecture -> Architecture -> Bool
$c> :: Architecture -> Architecture -> Bool
> :: Architecture -> Architecture -> Bool
$c>= :: Architecture -> Architecture -> Bool
>= :: Architecture -> Architecture -> Bool
$cmax :: Architecture -> Architecture -> Architecture
max :: Architecture -> Architecture -> Architecture
$cmin :: Architecture -> Architecture -> Architecture
min :: Architecture -> Architecture -> Architecture
Ord, Int -> Architecture -> ShowS
[Architecture] -> ShowS
Architecture -> String
(Int -> Architecture -> ShowS)
-> (Architecture -> String)
-> ([Architecture] -> ShowS)
-> Show Architecture
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Architecture -> ShowS
showsPrec :: Int -> Architecture -> ShowS
$cshow :: Architecture -> String
show :: Architecture -> String
$cshowList :: [Architecture] -> ShowS
showList :: [Architecture] -> ShowS
Show)

instance NFData Architecture

archToString :: Architecture -> String
archToString :: Architecture -> String
archToString Architecture
A_64 = String
"x86_64"
archToString Architecture
A_32 = String
"i386"
archToString Architecture
A_PowerPC = String
"powerpc"
archToString Architecture
A_PowerPC64 = String
"powerpc64"
archToString Architecture
A_Sparc = String
"sparc"
archToString Architecture
A_Sparc64 = String
"sparc64"
archToString Architecture
A_ARM = String
"arm"
archToString Architecture
A_ARM64 = String
"aarch64"

instance Pretty Architecture where
  pPrint :: Architecture -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Architecture -> String) -> Architecture -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Architecture -> String
archToString

data Platform = Linux LinuxDistro
              -- ^ must exit
              | Darwin
              -- ^ must exit
              | FreeBSD
              | Windows
              -- ^ must exit
  deriving (Platform -> Platform -> Bool
(Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool) -> Eq Platform
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Platform -> Platform -> Bool
== :: Platform -> Platform -> Bool
$c/= :: Platform -> Platform -> Bool
/= :: Platform -> Platform -> Bool
Eq, (forall x. Platform -> Rep Platform x)
-> (forall x. Rep Platform x -> Platform) -> Generic Platform
forall x. Rep Platform x -> Platform
forall x. Platform -> Rep Platform x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Platform -> Rep Platform x
from :: forall x. Platform -> Rep Platform x
$cto :: forall x. Rep Platform x -> Platform
to :: forall x. Rep Platform x -> Platform
GHC.Generic, Eq Platform
Eq Platform
-> (Platform -> Platform -> Ordering)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool)
-> (Platform -> Platform -> Platform)
-> (Platform -> Platform -> Platform)
-> Ord Platform
Platform -> Platform -> Bool
Platform -> Platform -> Ordering
Platform -> Platform -> Platform
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Platform -> Platform -> Ordering
compare :: Platform -> Platform -> Ordering
$c< :: Platform -> Platform -> Bool
< :: Platform -> Platform -> Bool
$c<= :: Platform -> Platform -> Bool
<= :: Platform -> Platform -> Bool
$c> :: Platform -> Platform -> Bool
> :: Platform -> Platform -> Bool
$c>= :: Platform -> Platform -> Bool
>= :: Platform -> Platform -> Bool
$cmax :: Platform -> Platform -> Platform
max :: Platform -> Platform -> Platform
$cmin :: Platform -> Platform -> Platform
min :: Platform -> Platform -> Platform
Ord, Int -> Platform -> ShowS
[Platform] -> ShowS
Platform -> String
(Int -> Platform -> ShowS)
-> (Platform -> String) -> ([Platform] -> ShowS) -> Show Platform
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Platform -> ShowS
showsPrec :: Int -> Platform -> ShowS
$cshow :: Platform -> String
show :: Platform -> String
$cshowList :: [Platform] -> ShowS
showList :: [Platform] -> ShowS
Show)

instance NFData Platform

platformToString :: Platform -> String
platformToString :: Platform -> String
platformToString (Linux LinuxDistro
distro) = String
"linux-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ LinuxDistro -> String
distroToString LinuxDistro
distro
platformToString Platform
Darwin = String
"darwin"
platformToString Platform
FreeBSD = String
"freebsd"
platformToString Platform
Windows = String
"windows"

instance Pretty Platform where
  pPrint :: Platform -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Platform -> String) -> Platform -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> String
platformToString

data LinuxDistro = Debian
                 | Ubuntu
                 | Mint
                 | Fedora
                 | CentOS
                 | RedHat
                 | Alpine
                 | AmazonLinux
                 | Rocky
                 | Void
                 -- rolling
                 | Gentoo
                 | Exherbo
                 -- not known
                 | UnknownLinux
                 -- ^ must exit
  deriving (LinuxDistro -> LinuxDistro -> Bool
(LinuxDistro -> LinuxDistro -> Bool)
-> (LinuxDistro -> LinuxDistro -> Bool) -> Eq LinuxDistro
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinuxDistro -> LinuxDistro -> Bool
== :: LinuxDistro -> LinuxDistro -> Bool
$c/= :: LinuxDistro -> LinuxDistro -> Bool
/= :: LinuxDistro -> LinuxDistro -> Bool
Eq, (forall x. LinuxDistro -> Rep LinuxDistro x)
-> (forall x. Rep LinuxDistro x -> LinuxDistro)
-> Generic LinuxDistro
forall x. Rep LinuxDistro x -> LinuxDistro
forall x. LinuxDistro -> Rep LinuxDistro x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LinuxDistro -> Rep LinuxDistro x
from :: forall x. LinuxDistro -> Rep LinuxDistro x
$cto :: forall x. Rep LinuxDistro x -> LinuxDistro
to :: forall x. Rep LinuxDistro x -> LinuxDistro
GHC.Generic, Eq LinuxDistro
Eq LinuxDistro
-> (LinuxDistro -> LinuxDistro -> Ordering)
-> (LinuxDistro -> LinuxDistro -> Bool)
-> (LinuxDistro -> LinuxDistro -> Bool)
-> (LinuxDistro -> LinuxDistro -> Bool)
-> (LinuxDistro -> LinuxDistro -> Bool)
-> (LinuxDistro -> LinuxDistro -> LinuxDistro)
-> (LinuxDistro -> LinuxDistro -> LinuxDistro)
-> Ord LinuxDistro
LinuxDistro -> LinuxDistro -> Bool
LinuxDistro -> LinuxDistro -> Ordering
LinuxDistro -> LinuxDistro -> LinuxDistro
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LinuxDistro -> LinuxDistro -> Ordering
compare :: LinuxDistro -> LinuxDistro -> Ordering
$c< :: LinuxDistro -> LinuxDistro -> Bool
< :: LinuxDistro -> LinuxDistro -> Bool
$c<= :: LinuxDistro -> LinuxDistro -> Bool
<= :: LinuxDistro -> LinuxDistro -> Bool
$c> :: LinuxDistro -> LinuxDistro -> Bool
> :: LinuxDistro -> LinuxDistro -> Bool
$c>= :: LinuxDistro -> LinuxDistro -> Bool
>= :: LinuxDistro -> LinuxDistro -> Bool
$cmax :: LinuxDistro -> LinuxDistro -> LinuxDistro
max :: LinuxDistro -> LinuxDistro -> LinuxDistro
$cmin :: LinuxDistro -> LinuxDistro -> LinuxDistro
min :: LinuxDistro -> LinuxDistro -> LinuxDistro
Ord, Int -> LinuxDistro -> ShowS
[LinuxDistro] -> ShowS
LinuxDistro -> String
(Int -> LinuxDistro -> ShowS)
-> (LinuxDistro -> String)
-> ([LinuxDistro] -> ShowS)
-> Show LinuxDistro
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinuxDistro -> ShowS
showsPrec :: Int -> LinuxDistro -> ShowS
$cshow :: LinuxDistro -> String
show :: LinuxDistro -> String
$cshowList :: [LinuxDistro] -> ShowS
showList :: [LinuxDistro] -> ShowS
Show, Int -> LinuxDistro
LinuxDistro -> Int
LinuxDistro -> [LinuxDistro]
LinuxDistro -> LinuxDistro
LinuxDistro -> LinuxDistro -> [LinuxDistro]
LinuxDistro -> LinuxDistro -> LinuxDistro -> [LinuxDistro]
(LinuxDistro -> LinuxDistro)
-> (LinuxDistro -> LinuxDistro)
-> (Int -> LinuxDistro)
-> (LinuxDistro -> Int)
-> (LinuxDistro -> [LinuxDistro])
-> (LinuxDistro -> LinuxDistro -> [LinuxDistro])
-> (LinuxDistro -> LinuxDistro -> [LinuxDistro])
-> (LinuxDistro -> LinuxDistro -> LinuxDistro -> [LinuxDistro])
-> Enum LinuxDistro
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LinuxDistro -> LinuxDistro
succ :: LinuxDistro -> LinuxDistro
$cpred :: LinuxDistro -> LinuxDistro
pred :: LinuxDistro -> LinuxDistro
$ctoEnum :: Int -> LinuxDistro
toEnum :: Int -> LinuxDistro
$cfromEnum :: LinuxDistro -> Int
fromEnum :: LinuxDistro -> Int
$cenumFrom :: LinuxDistro -> [LinuxDistro]
enumFrom :: LinuxDistro -> [LinuxDistro]
$cenumFromThen :: LinuxDistro -> LinuxDistro -> [LinuxDistro]
enumFromThen :: LinuxDistro -> LinuxDistro -> [LinuxDistro]
$cenumFromTo :: LinuxDistro -> LinuxDistro -> [LinuxDistro]
enumFromTo :: LinuxDistro -> LinuxDistro -> [LinuxDistro]
$cenumFromThenTo :: LinuxDistro -> LinuxDistro -> LinuxDistro -> [LinuxDistro]
enumFromThenTo :: LinuxDistro -> LinuxDistro -> LinuxDistro -> [LinuxDistro]
Enum, LinuxDistro
LinuxDistro -> LinuxDistro -> Bounded LinuxDistro
forall a. a -> a -> Bounded a
$cminBound :: LinuxDistro
minBound :: LinuxDistro
$cmaxBound :: LinuxDistro
maxBound :: LinuxDistro
Bounded)

allDistros :: [LinuxDistro]
allDistros :: [LinuxDistro]
allDistros = LinuxDistro -> LinuxDistro -> [LinuxDistro]
forall a. Enum a => a -> a -> [a]
enumFromTo LinuxDistro
forall a. Bounded a => a
minBound LinuxDistro
forall a. Bounded a => a
maxBound

instance NFData LinuxDistro

distroToString :: LinuxDistro -> String
distroToString :: LinuxDistro -> String
distroToString LinuxDistro
Debian = String
"debian"
distroToString LinuxDistro
Ubuntu = String
"ubuntu"
distroToString LinuxDistro
Mint = String
"mint"
distroToString LinuxDistro
Fedora = String
"fedora"
distroToString LinuxDistro
CentOS = String
"centos"
distroToString LinuxDistro
RedHat = String
"redhat"
distroToString LinuxDistro
Alpine = String
"alpine"
distroToString LinuxDistro
AmazonLinux = String
"amazon"
distroToString LinuxDistro
Rocky = String
"rocky"
distroToString LinuxDistro
Void = String
"void"
distroToString LinuxDistro
Gentoo = String
"gentoo"
distroToString LinuxDistro
Exherbo = String
"exherbo"
distroToString LinuxDistro
UnknownLinux = String
"unknown"

instance Pretty LinuxDistro where
  pPrint :: LinuxDistro -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (LinuxDistro -> String) -> LinuxDistro -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinuxDistro -> String
distroToString


-- | An encapsulation of a download. This can be used
-- to download, extract and install a tool.
data DownloadInfo = DownloadInfo
  { DownloadInfo -> URI
_dlUri    :: URI
  , DownloadInfo -> Maybe TarDir
_dlSubdir :: Maybe TarDir
  , DownloadInfo -> Text
_dlHash   :: Text
  , DownloadInfo -> Maybe Integer
_dlCSize  :: Maybe Integer
  , DownloadInfo -> Maybe String
_dlOutput :: Maybe FilePath
  }
  deriving (DownloadInfo -> DownloadInfo -> Bool
(DownloadInfo -> DownloadInfo -> Bool)
-> (DownloadInfo -> DownloadInfo -> Bool) -> Eq DownloadInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadInfo -> DownloadInfo -> Bool
== :: DownloadInfo -> DownloadInfo -> Bool
$c/= :: DownloadInfo -> DownloadInfo -> Bool
/= :: DownloadInfo -> DownloadInfo -> Bool
Eq, Eq DownloadInfo
Eq DownloadInfo
-> (DownloadInfo -> DownloadInfo -> Ordering)
-> (DownloadInfo -> DownloadInfo -> Bool)
-> (DownloadInfo -> DownloadInfo -> Bool)
-> (DownloadInfo -> DownloadInfo -> Bool)
-> (DownloadInfo -> DownloadInfo -> Bool)
-> (DownloadInfo -> DownloadInfo -> DownloadInfo)
-> (DownloadInfo -> DownloadInfo -> DownloadInfo)
-> Ord DownloadInfo
DownloadInfo -> DownloadInfo -> Bool
DownloadInfo -> DownloadInfo -> Ordering
DownloadInfo -> DownloadInfo -> DownloadInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DownloadInfo -> DownloadInfo -> Ordering
compare :: DownloadInfo -> DownloadInfo -> Ordering
$c< :: DownloadInfo -> DownloadInfo -> Bool
< :: DownloadInfo -> DownloadInfo -> Bool
$c<= :: DownloadInfo -> DownloadInfo -> Bool
<= :: DownloadInfo -> DownloadInfo -> Bool
$c> :: DownloadInfo -> DownloadInfo -> Bool
> :: DownloadInfo -> DownloadInfo -> Bool
$c>= :: DownloadInfo -> DownloadInfo -> Bool
>= :: DownloadInfo -> DownloadInfo -> Bool
$cmax :: DownloadInfo -> DownloadInfo -> DownloadInfo
max :: DownloadInfo -> DownloadInfo -> DownloadInfo
$cmin :: DownloadInfo -> DownloadInfo -> DownloadInfo
min :: DownloadInfo -> DownloadInfo -> DownloadInfo
Ord, (forall x. DownloadInfo -> Rep DownloadInfo x)
-> (forall x. Rep DownloadInfo x -> DownloadInfo)
-> Generic DownloadInfo
forall x. Rep DownloadInfo x -> DownloadInfo
forall x. DownloadInfo -> Rep DownloadInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DownloadInfo -> Rep DownloadInfo x
from :: forall x. DownloadInfo -> Rep DownloadInfo x
$cto :: forall x. Rep DownloadInfo x -> DownloadInfo
to :: forall x. Rep DownloadInfo x -> DownloadInfo
GHC.Generic, Int -> DownloadInfo -> ShowS
[DownloadInfo] -> ShowS
DownloadInfo -> String
(Int -> DownloadInfo -> ShowS)
-> (DownloadInfo -> String)
-> ([DownloadInfo] -> ShowS)
-> Show DownloadInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadInfo -> ShowS
showsPrec :: Int -> DownloadInfo -> ShowS
$cshow :: DownloadInfo -> String
show :: DownloadInfo -> String
$cshowList :: [DownloadInfo] -> ShowS
showList :: [DownloadInfo] -> ShowS
Show)

instance NFData DownloadInfo



    --------------
    --[ Others ]--
    --------------

data DownloadMirror = DownloadMirror {
     DownloadMirror -> Authority
authority :: Authority
   , DownloadMirror -> Maybe Text
pathPrefix :: Maybe Text
} deriving (DownloadMirror -> DownloadMirror -> Bool
(DownloadMirror -> DownloadMirror -> Bool)
-> (DownloadMirror -> DownloadMirror -> Bool) -> Eq DownloadMirror
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadMirror -> DownloadMirror -> Bool
== :: DownloadMirror -> DownloadMirror -> Bool
$c/= :: DownloadMirror -> DownloadMirror -> Bool
/= :: DownloadMirror -> DownloadMirror -> Bool
Eq, Eq DownloadMirror
Eq DownloadMirror
-> (DownloadMirror -> DownloadMirror -> Ordering)
-> (DownloadMirror -> DownloadMirror -> Bool)
-> (DownloadMirror -> DownloadMirror -> Bool)
-> (DownloadMirror -> DownloadMirror -> Bool)
-> (DownloadMirror -> DownloadMirror -> Bool)
-> (DownloadMirror -> DownloadMirror -> DownloadMirror)
-> (DownloadMirror -> DownloadMirror -> DownloadMirror)
-> Ord DownloadMirror
DownloadMirror -> DownloadMirror -> Bool
DownloadMirror -> DownloadMirror -> Ordering
DownloadMirror -> DownloadMirror -> DownloadMirror
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DownloadMirror -> DownloadMirror -> Ordering
compare :: DownloadMirror -> DownloadMirror -> Ordering
$c< :: DownloadMirror -> DownloadMirror -> Bool
< :: DownloadMirror -> DownloadMirror -> Bool
$c<= :: DownloadMirror -> DownloadMirror -> Bool
<= :: DownloadMirror -> DownloadMirror -> Bool
$c> :: DownloadMirror -> DownloadMirror -> Bool
> :: DownloadMirror -> DownloadMirror -> Bool
$c>= :: DownloadMirror -> DownloadMirror -> Bool
>= :: DownloadMirror -> DownloadMirror -> Bool
$cmax :: DownloadMirror -> DownloadMirror -> DownloadMirror
max :: DownloadMirror -> DownloadMirror -> DownloadMirror
$cmin :: DownloadMirror -> DownloadMirror -> DownloadMirror
min :: DownloadMirror -> DownloadMirror -> DownloadMirror
Ord, (forall x. DownloadMirror -> Rep DownloadMirror x)
-> (forall x. Rep DownloadMirror x -> DownloadMirror)
-> Generic DownloadMirror
forall x. Rep DownloadMirror x -> DownloadMirror
forall x. DownloadMirror -> Rep DownloadMirror x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DownloadMirror -> Rep DownloadMirror x
from :: forall x. DownloadMirror -> Rep DownloadMirror x
$cto :: forall x. Rep DownloadMirror x -> DownloadMirror
to :: forall x. Rep DownloadMirror x -> DownloadMirror
GHC.Generic, Int -> DownloadMirror -> ShowS
[DownloadMirror] -> ShowS
DownloadMirror -> String
(Int -> DownloadMirror -> ShowS)
-> (DownloadMirror -> String)
-> ([DownloadMirror] -> ShowS)
-> Show DownloadMirror
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadMirror -> ShowS
showsPrec :: Int -> DownloadMirror -> ShowS
$cshow :: DownloadMirror -> String
show :: DownloadMirror -> String
$cshowList :: [DownloadMirror] -> ShowS
showList :: [DownloadMirror] -> ShowS
Show)

instance NFData DownloadMirror

newtype DownloadMirrors = DM (Map Text DownloadMirror)
  deriving (DownloadMirrors -> DownloadMirrors -> Bool
(DownloadMirrors -> DownloadMirrors -> Bool)
-> (DownloadMirrors -> DownloadMirrors -> Bool)
-> Eq DownloadMirrors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DownloadMirrors -> DownloadMirrors -> Bool
== :: DownloadMirrors -> DownloadMirrors -> Bool
$c/= :: DownloadMirrors -> DownloadMirrors -> Bool
/= :: DownloadMirrors -> DownloadMirrors -> Bool
Eq, Eq DownloadMirrors
Eq DownloadMirrors
-> (DownloadMirrors -> DownloadMirrors -> Ordering)
-> (DownloadMirrors -> DownloadMirrors -> Bool)
-> (DownloadMirrors -> DownloadMirrors -> Bool)
-> (DownloadMirrors -> DownloadMirrors -> Bool)
-> (DownloadMirrors -> DownloadMirrors -> Bool)
-> (DownloadMirrors -> DownloadMirrors -> DownloadMirrors)
-> (DownloadMirrors -> DownloadMirrors -> DownloadMirrors)
-> Ord DownloadMirrors
DownloadMirrors -> DownloadMirrors -> Bool
DownloadMirrors -> DownloadMirrors -> Ordering
DownloadMirrors -> DownloadMirrors -> DownloadMirrors
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DownloadMirrors -> DownloadMirrors -> Ordering
compare :: DownloadMirrors -> DownloadMirrors -> Ordering
$c< :: DownloadMirrors -> DownloadMirrors -> Bool
< :: DownloadMirrors -> DownloadMirrors -> Bool
$c<= :: DownloadMirrors -> DownloadMirrors -> Bool
<= :: DownloadMirrors -> DownloadMirrors -> Bool
$c> :: DownloadMirrors -> DownloadMirrors -> Bool
> :: DownloadMirrors -> DownloadMirrors -> Bool
$c>= :: DownloadMirrors -> DownloadMirrors -> Bool
>= :: DownloadMirrors -> DownloadMirrors -> Bool
$cmax :: DownloadMirrors -> DownloadMirrors -> DownloadMirrors
max :: DownloadMirrors -> DownloadMirrors -> DownloadMirrors
$cmin :: DownloadMirrors -> DownloadMirrors -> DownloadMirrors
min :: DownloadMirrors -> DownloadMirrors -> DownloadMirrors
Ord, (forall x. DownloadMirrors -> Rep DownloadMirrors x)
-> (forall x. Rep DownloadMirrors x -> DownloadMirrors)
-> Generic DownloadMirrors
forall x. Rep DownloadMirrors x -> DownloadMirrors
forall x. DownloadMirrors -> Rep DownloadMirrors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DownloadMirrors -> Rep DownloadMirrors x
from :: forall x. DownloadMirrors -> Rep DownloadMirrors x
$cto :: forall x. Rep DownloadMirrors x -> DownloadMirrors
to :: forall x. Rep DownloadMirrors x -> DownloadMirrors
GHC.Generic, Int -> DownloadMirrors -> ShowS
[DownloadMirrors] -> ShowS
DownloadMirrors -> String
(Int -> DownloadMirrors -> ShowS)
-> (DownloadMirrors -> String)
-> ([DownloadMirrors] -> ShowS)
-> Show DownloadMirrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DownloadMirrors -> ShowS
showsPrec :: Int -> DownloadMirrors -> ShowS
$cshow :: DownloadMirrors -> String
show :: DownloadMirrors -> String
$cshowList :: [DownloadMirrors] -> ShowS
showList :: [DownloadMirrors] -> ShowS
Show)

instance NFData DownloadMirrors

instance NFData UserInfo
instance NFData Host
instance NFData Port
instance NFData Authority


-- | How to descend into a tar archive.
data TarDir = RealDir FilePath
            | RegexDir String     -- ^ will be compiled to regex, the first match will "win"
            deriving (TarDir -> TarDir -> Bool
(TarDir -> TarDir -> Bool)
-> (TarDir -> TarDir -> Bool) -> Eq TarDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TarDir -> TarDir -> Bool
== :: TarDir -> TarDir -> Bool
$c/= :: TarDir -> TarDir -> Bool
/= :: TarDir -> TarDir -> Bool
Eq, Eq TarDir
Eq TarDir
-> (TarDir -> TarDir -> Ordering)
-> (TarDir -> TarDir -> Bool)
-> (TarDir -> TarDir -> Bool)
-> (TarDir -> TarDir -> Bool)
-> (TarDir -> TarDir -> Bool)
-> (TarDir -> TarDir -> TarDir)
-> (TarDir -> TarDir -> TarDir)
-> Ord TarDir
TarDir -> TarDir -> Bool
TarDir -> TarDir -> Ordering
TarDir -> TarDir -> TarDir
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TarDir -> TarDir -> Ordering
compare :: TarDir -> TarDir -> Ordering
$c< :: TarDir -> TarDir -> Bool
< :: TarDir -> TarDir -> Bool
$c<= :: TarDir -> TarDir -> Bool
<= :: TarDir -> TarDir -> Bool
$c> :: TarDir -> TarDir -> Bool
> :: TarDir -> TarDir -> Bool
$c>= :: TarDir -> TarDir -> Bool
>= :: TarDir -> TarDir -> Bool
$cmax :: TarDir -> TarDir -> TarDir
max :: TarDir -> TarDir -> TarDir
$cmin :: TarDir -> TarDir -> TarDir
min :: TarDir -> TarDir -> TarDir
Ord, (forall x. TarDir -> Rep TarDir x)
-> (forall x. Rep TarDir x -> TarDir) -> Generic TarDir
forall x. Rep TarDir x -> TarDir
forall x. TarDir -> Rep TarDir x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TarDir -> Rep TarDir x
from :: forall x. TarDir -> Rep TarDir x
$cto :: forall x. Rep TarDir x -> TarDir
to :: forall x. Rep TarDir x -> TarDir
GHC.Generic, Int -> TarDir -> ShowS
[TarDir] -> ShowS
TarDir -> String
(Int -> TarDir -> ShowS)
-> (TarDir -> String) -> ([TarDir] -> ShowS) -> Show TarDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TarDir -> ShowS
showsPrec :: Int -> TarDir -> ShowS
$cshow :: TarDir -> String
show :: TarDir -> String
$cshowList :: [TarDir] -> ShowS
showList :: [TarDir] -> ShowS
Show)

instance NFData TarDir

instance Pretty TarDir where
  pPrint :: TarDir -> Doc
pPrint (RealDir String
path) = String -> Doc
text String
path
  pPrint (RegexDir String
regex) = String -> Doc
text String
regex


-- | 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 (URLSource -> URLSource -> Bool
(URLSource -> URLSource -> Bool)
-> (URLSource -> URLSource -> Bool) -> Eq URLSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URLSource -> URLSource -> Bool
== :: URLSource -> URLSource -> Bool
$c/= :: URLSource -> URLSource -> Bool
/= :: URLSource -> URLSource -> Bool
Eq, (forall x. URLSource -> Rep URLSource x)
-> (forall x. Rep URLSource x -> URLSource) -> Generic URLSource
forall x. Rep URLSource x -> URLSource
forall x. URLSource -> Rep URLSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. URLSource -> Rep URLSource x
from :: forall x. URLSource -> Rep URLSource x
$cto :: forall x. Rep URLSource x -> URLSource
to :: forall x. Rep URLSource x -> URLSource
GHC.Generic, Int -> URLSource -> ShowS
[URLSource] -> ShowS
URLSource -> String
(Int -> URLSource -> ShowS)
-> (URLSource -> String)
-> ([URLSource] -> ShowS)
-> Show URLSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URLSource -> ShowS
showsPrec :: Int -> URLSource -> ShowS
$cshow :: URLSource -> String
show :: URLSource -> String
$cshowList :: [URLSource] -> ShowS
showList :: [URLSource] -> ShowS
Show)

data NewURLSource = NewGHCupURL
                  | NewStackSetupURL
                  | NewGHCupInfo     GHCupInfo
                  | NewSetupInfo     SetupInfo
                  | NewURI           URI
               deriving (NewURLSource -> NewURLSource -> Bool
(NewURLSource -> NewURLSource -> Bool)
-> (NewURLSource -> NewURLSource -> Bool) -> Eq NewURLSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewURLSource -> NewURLSource -> Bool
== :: NewURLSource -> NewURLSource -> Bool
$c/= :: NewURLSource -> NewURLSource -> Bool
/= :: NewURLSource -> NewURLSource -> Bool
Eq, (forall x. NewURLSource -> Rep NewURLSource x)
-> (forall x. Rep NewURLSource x -> NewURLSource)
-> Generic NewURLSource
forall x. Rep NewURLSource x -> NewURLSource
forall x. NewURLSource -> Rep NewURLSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NewURLSource -> Rep NewURLSource x
from :: forall x. NewURLSource -> Rep NewURLSource x
$cto :: forall x. Rep NewURLSource x -> NewURLSource
to :: forall x. Rep NewURLSource x -> NewURLSource
GHC.Generic, Int -> NewURLSource -> ShowS
[NewURLSource] -> ShowS
NewURLSource -> String
(Int -> NewURLSource -> ShowS)
-> (NewURLSource -> String)
-> ([NewURLSource] -> ShowS)
-> Show NewURLSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewURLSource -> ShowS
showsPrec :: Int -> NewURLSource -> ShowS
$cshow :: NewURLSource -> String
show :: NewURLSource -> String
$cshowList :: [NewURLSource] -> ShowS
showList :: [NewURLSource] -> ShowS
Show)

instance NFData NewURLSource

fromURLSource :: URLSource -> [NewURLSource]
fromURLSource :: URLSource -> [NewURLSource]
fromURLSource URLSource
GHCupURL              = [NewURLSource
NewGHCupURL]
fromURLSource URLSource
StackSetupURL         = [NewURLSource
NewStackSetupURL]
fromURLSource (OwnSource [Either (Either GHCupInfo SetupInfo) URI]
arr)       = Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
convert' (Either (Either GHCupInfo SetupInfo) URI -> NewURLSource)
-> [Either (Either GHCupInfo SetupInfo) URI] -> [NewURLSource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either (Either GHCupInfo SetupInfo) URI]
arr
fromURLSource (AddSource [Either (Either GHCupInfo SetupInfo) URI]
arr)       = NewURLSource
NewGHCupURLNewURLSource -> [NewURLSource] -> [NewURLSource]
forall a. a -> [a] -> [a]
:(Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
convert' (Either (Either GHCupInfo SetupInfo) URI -> NewURLSource)
-> [Either (Either GHCupInfo SetupInfo) URI] -> [NewURLSource]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either (Either GHCupInfo SetupInfo) URI]
arr)
fromURLSource (SimpleList [NewURLSource]
arr)      = [NewURLSource]
arr
fromURLSource (OwnSpec (Left GHCupInfo
gi))   = [GHCupInfo -> NewURLSource
NewGHCupInfo GHCupInfo
gi]
fromURLSource (OwnSpec (Right SetupInfo
si)) = [SetupInfo -> NewURLSource
NewSetupInfo SetupInfo
si]

convert' :: Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
convert' :: Either (Either GHCupInfo SetupInfo) URI -> NewURLSource
convert' (Left (Left GHCupInfo
gi))  = GHCupInfo -> NewURLSource
NewGHCupInfo GHCupInfo
gi
convert' (Left (Right SetupInfo
si)) = SetupInfo -> NewURLSource
NewSetupInfo SetupInfo
si
convert' (Right URI
uri)       = URI -> NewURLSource
NewURI URI
uri

instance NFData URLSource
instance NFData (URIRef Absolute) where
  rnf :: URI -> ()
rnf (URI !Scheme
_ !Maybe Authority
_ !ByteString
_ !Query
_ !Maybe ByteString
_) = ()


data MetaMode = Strict
              | Lax
  deriving (Int -> MetaMode -> ShowS
[MetaMode] -> ShowS
MetaMode -> String
(Int -> MetaMode -> ShowS)
-> (MetaMode -> String) -> ([MetaMode] -> ShowS) -> Show MetaMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetaMode -> ShowS
showsPrec :: Int -> MetaMode -> ShowS
$cshow :: MetaMode -> String
show :: MetaMode -> String
$cshowList :: [MetaMode] -> ShowS
showList :: [MetaMode] -> ShowS
Show, ReadPrec [MetaMode]
ReadPrec MetaMode
Int -> ReadS MetaMode
ReadS [MetaMode]
(Int -> ReadS MetaMode)
-> ReadS [MetaMode]
-> ReadPrec MetaMode
-> ReadPrec [MetaMode]
-> Read MetaMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MetaMode
readsPrec :: Int -> ReadS MetaMode
$creadList :: ReadS [MetaMode]
readList :: ReadS [MetaMode]
$creadPrec :: ReadPrec MetaMode
readPrec :: ReadPrec MetaMode
$creadListPrec :: ReadPrec [MetaMode]
readListPrec :: ReadPrec [MetaMode]
Read, MetaMode -> MetaMode -> Bool
(MetaMode -> MetaMode -> Bool)
-> (MetaMode -> MetaMode -> Bool) -> Eq MetaMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetaMode -> MetaMode -> Bool
== :: MetaMode -> MetaMode -> Bool
$c/= :: MetaMode -> MetaMode -> Bool
/= :: MetaMode -> MetaMode -> Bool
Eq, (forall x. MetaMode -> Rep MetaMode x)
-> (forall x. Rep MetaMode x -> MetaMode) -> Generic MetaMode
forall x. Rep MetaMode x -> MetaMode
forall x. MetaMode -> Rep MetaMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetaMode -> Rep MetaMode x
from :: forall x. MetaMode -> Rep MetaMode x
$cto :: forall x. Rep MetaMode x -> MetaMode
to :: forall x. Rep MetaMode x -> MetaMode
GHC.Generic)

instance NFData MetaMode

data UserSettings = UserSettings
  { UserSettings -> Maybe Bool
uCache       :: Maybe Bool
  , UserSettings -> Maybe Integer
uMetaCache   :: Maybe Integer
  , UserSettings -> Maybe MetaMode
uMetaMode    :: Maybe MetaMode
  , UserSettings -> Maybe Bool
uNoVerify    :: Maybe Bool
  , UserSettings -> Maybe Bool
uVerbose     :: Maybe Bool
  , UserSettings -> Maybe KeepDirs
uKeepDirs    :: Maybe KeepDirs
  , UserSettings -> Maybe Downloader
uDownloader  :: Maybe Downloader
  , UserSettings -> Maybe UserKeyBindings
uKeyBindings :: Maybe UserKeyBindings
  , UserSettings -> Maybe URLSource
uUrlSource   :: Maybe URLSource
  , UserSettings -> Maybe Bool
uNoNetwork   :: Maybe Bool
  , UserSettings -> Maybe GPGSetting
uGPGSetting  :: Maybe GPGSetting
  , UserSettings -> Maybe PlatformRequest
uPlatformOverride :: Maybe PlatformRequest
  , UserSettings -> Maybe DownloadMirrors
uMirrors     :: Maybe DownloadMirrors
  }
  deriving (Int -> UserSettings -> ShowS
[UserSettings] -> ShowS
UserSettings -> String
(Int -> UserSettings -> ShowS)
-> (UserSettings -> String)
-> ([UserSettings] -> ShowS)
-> Show UserSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserSettings -> ShowS
showsPrec :: Int -> UserSettings -> ShowS
$cshow :: UserSettings -> String
show :: UserSettings -> String
$cshowList :: [UserSettings] -> ShowS
showList :: [UserSettings] -> ShowS
Show, (forall x. UserSettings -> Rep UserSettings x)
-> (forall x. Rep UserSettings x -> UserSettings)
-> Generic UserSettings
forall x. Rep UserSettings x -> UserSettings
forall x. UserSettings -> Rep UserSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserSettings -> Rep UserSettings x
from :: forall x. UserSettings -> Rep UserSettings x
$cto :: forall x. Rep UserSettings x -> UserSettings
to :: forall x. Rep UserSettings x -> UserSettings
GHC.Generic)

defaultUserSettings :: UserSettings
defaultUserSettings :: UserSettings
defaultUserSettings = Maybe Bool
-> Maybe Integer
-> Maybe MetaMode
-> Maybe Bool
-> Maybe Bool
-> Maybe KeepDirs
-> Maybe Downloader
-> Maybe UserKeyBindings
-> Maybe URLSource
-> Maybe Bool
-> Maybe GPGSetting
-> Maybe PlatformRequest
-> Maybe DownloadMirrors
-> UserSettings
UserSettings Maybe Bool
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe MetaMode
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe KeepDirs
forall a. Maybe a
Nothing Maybe Downloader
forall a. Maybe a
Nothing Maybe UserKeyBindings
forall a. Maybe a
Nothing Maybe URLSource
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe GPGSetting
forall a. Maybe a
Nothing Maybe PlatformRequest
forall a. Maybe a
Nothing Maybe DownloadMirrors
forall a. Maybe a
Nothing

fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
fromSettings Settings{Bool
Integer
Maybe PlatformRequest
GPGSetting
Downloader
KeepDirs
MetaMode
URLSource
DownloadMirrors
cache :: Bool
metaCache :: Integer
metaMode :: MetaMode
noVerify :: Bool
keepDirs :: KeepDirs
downloader :: Downloader
verbose :: Bool
urlSource :: URLSource
noNetwork :: Bool
gpgSetting :: GPGSetting
noColor :: Bool
platformOverride :: Maybe PlatformRequest
mirrors :: DownloadMirrors
$sel:cache:Settings :: Settings -> Bool
$sel:metaCache:Settings :: Settings -> Integer
$sel:metaMode:Settings :: Settings -> MetaMode
$sel:noVerify:Settings :: Settings -> Bool
$sel:keepDirs:Settings :: Settings -> KeepDirs
$sel:downloader:Settings :: Settings -> Downloader
$sel:verbose:Settings :: Settings -> Bool
$sel:urlSource:Settings :: Settings -> URLSource
$sel:noNetwork:Settings :: Settings -> Bool
$sel:gpgSetting:Settings :: Settings -> GPGSetting
$sel:noColor:Settings :: Settings -> Bool
$sel:platformOverride:Settings :: Settings -> Maybe PlatformRequest
$sel:mirrors:Settings :: Settings -> DownloadMirrors
..} Maybe KeyBindings
Nothing =
  UserSettings {
      $sel:uCache:UserSettings :: Maybe Bool
uCache = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
cache
    , $sel:uMetaCache:UserSettings :: Maybe Integer
uMetaCache = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
metaCache
    , $sel:uMetaMode:UserSettings :: Maybe MetaMode
uMetaMode = MetaMode -> Maybe MetaMode
forall a. a -> Maybe a
Just MetaMode
metaMode
    , $sel:uNoVerify:UserSettings :: Maybe Bool
uNoVerify = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
noVerify
    , $sel:uVerbose:UserSettings :: Maybe Bool
uVerbose = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
verbose
    , $sel:uKeepDirs:UserSettings :: Maybe KeepDirs
uKeepDirs = KeepDirs -> Maybe KeepDirs
forall a. a -> Maybe a
Just KeepDirs
keepDirs
    , $sel:uDownloader:UserSettings :: Maybe Downloader
uDownloader = Downloader -> Maybe Downloader
forall a. a -> Maybe a
Just Downloader
downloader
    , $sel:uNoNetwork:UserSettings :: Maybe Bool
uNoNetwork = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
noNetwork
    , $sel:uKeyBindings:UserSettings :: Maybe UserKeyBindings
uKeyBindings = Maybe UserKeyBindings
forall a. Maybe a
Nothing
    , $sel:uUrlSource:UserSettings :: Maybe URLSource
uUrlSource = URLSource -> Maybe URLSource
forall a. a -> Maybe a
Just URLSource
urlSource
    , $sel:uGPGSetting:UserSettings :: Maybe GPGSetting
uGPGSetting = GPGSetting -> Maybe GPGSetting
forall a. a -> Maybe a
Just GPGSetting
gpgSetting
    , $sel:uPlatformOverride:UserSettings :: Maybe PlatformRequest
uPlatformOverride = Maybe PlatformRequest
platformOverride
    , $sel:uMirrors:UserSettings :: Maybe DownloadMirrors
uMirrors = DownloadMirrors -> Maybe DownloadMirrors
forall a. a -> Maybe a
Just DownloadMirrors
mirrors
  }
fromSettings Settings{Bool
Integer
Maybe PlatformRequest
GPGSetting
Downloader
KeepDirs
MetaMode
URLSource
DownloadMirrors
$sel:cache:Settings :: Settings -> Bool
$sel:metaCache:Settings :: Settings -> Integer
$sel:metaMode:Settings :: Settings -> MetaMode
$sel:noVerify:Settings :: Settings -> Bool
$sel:keepDirs:Settings :: Settings -> KeepDirs
$sel:downloader:Settings :: Settings -> Downloader
$sel:verbose:Settings :: Settings -> Bool
$sel:urlSource:Settings :: Settings -> URLSource
$sel:noNetwork:Settings :: Settings -> Bool
$sel:gpgSetting:Settings :: Settings -> GPGSetting
$sel:noColor:Settings :: Settings -> Bool
$sel:platformOverride:Settings :: Settings -> Maybe PlatformRequest
$sel:mirrors:Settings :: Settings -> DownloadMirrors
cache :: Bool
metaCache :: Integer
metaMode :: MetaMode
noVerify :: Bool
keepDirs :: KeepDirs
downloader :: Downloader
verbose :: Bool
urlSource :: URLSource
noNetwork :: Bool
gpgSetting :: GPGSetting
noColor :: Bool
platformOverride :: Maybe PlatformRequest
mirrors :: DownloadMirrors
..} (Just KeyBindings{KeyCombination
bUp :: KeyCombination
bDown :: KeyCombination
bQuit :: KeyCombination
bInstall :: KeyCombination
bUninstall :: KeyCombination
bSet :: KeyCombination
bChangelog :: KeyCombination
bShowAllVersions :: KeyCombination
bShowAllTools :: KeyCombination
$sel:bUp:KeyBindings :: KeyBindings -> KeyCombination
$sel:bDown:KeyBindings :: KeyBindings -> KeyCombination
$sel:bQuit:KeyBindings :: KeyBindings -> KeyCombination
$sel:bInstall:KeyBindings :: KeyBindings -> KeyCombination
$sel:bUninstall:KeyBindings :: KeyBindings -> KeyCombination
$sel:bSet:KeyBindings :: KeyBindings -> KeyCombination
$sel:bChangelog:KeyBindings :: KeyBindings -> KeyCombination
$sel:bShowAllVersions:KeyBindings :: KeyBindings -> KeyCombination
$sel:bShowAllTools:KeyBindings :: KeyBindings -> KeyCombination
..}) =
  let ukb :: UserKeyBindings
ukb = UserKeyBindings
            { $sel:kUp:UserKeyBindings :: Maybe KeyCombination
kUp           = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bUp
            , $sel:kDown:UserKeyBindings :: Maybe KeyCombination
kDown         = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bDown
            , $sel:kQuit:UserKeyBindings :: Maybe KeyCombination
kQuit         = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bQuit
            , $sel:kInstall:UserKeyBindings :: Maybe KeyCombination
kInstall      = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bInstall
            , $sel:kUninstall:UserKeyBindings :: Maybe KeyCombination
kUninstall    = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bUninstall
            , $sel:kSet:UserKeyBindings :: Maybe KeyCombination
kSet          = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bSet
            , $sel:kChangelog:UserKeyBindings :: Maybe KeyCombination
kChangelog    = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bChangelog
            , $sel:kShowAll:UserKeyBindings :: Maybe KeyCombination
kShowAll      = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bShowAllVersions
            , $sel:kShowAllTools:UserKeyBindings :: Maybe KeyCombination
kShowAllTools = KeyCombination -> Maybe KeyCombination
forall a. a -> Maybe a
Just KeyCombination
bShowAllTools
            }
  in UserSettings {
      $sel:uCache:UserSettings :: Maybe Bool
uCache = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
cache
    , $sel:uMetaCache:UserSettings :: Maybe Integer
uMetaCache = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
metaCache
    , $sel:uMetaMode:UserSettings :: Maybe MetaMode
uMetaMode = MetaMode -> Maybe MetaMode
forall a. a -> Maybe a
Just MetaMode
metaMode
    , $sel:uNoVerify:UserSettings :: Maybe Bool
uNoVerify = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
noVerify
    , $sel:uVerbose:UserSettings :: Maybe Bool
uVerbose = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
verbose
    , $sel:uKeepDirs:UserSettings :: Maybe KeepDirs
uKeepDirs = KeepDirs -> Maybe KeepDirs
forall a. a -> Maybe a
Just KeepDirs
keepDirs
    , $sel:uDownloader:UserSettings :: Maybe Downloader
uDownloader = Downloader -> Maybe Downloader
forall a. a -> Maybe a
Just Downloader
downloader
    , $sel:uNoNetwork:UserSettings :: Maybe Bool
uNoNetwork = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
noNetwork
    , $sel:uKeyBindings:UserSettings :: Maybe UserKeyBindings
uKeyBindings = UserKeyBindings -> Maybe UserKeyBindings
forall a. a -> Maybe a
Just UserKeyBindings
ukb
    , $sel:uUrlSource:UserSettings :: Maybe URLSource
uUrlSource = URLSource -> Maybe URLSource
forall a. a -> Maybe a
Just URLSource
urlSource
    , $sel:uGPGSetting:UserSettings :: Maybe GPGSetting
uGPGSetting = GPGSetting -> Maybe GPGSetting
forall a. a -> Maybe a
Just GPGSetting
gpgSetting
    , $sel:uPlatformOverride:UserSettings :: Maybe PlatformRequest
uPlatformOverride = Maybe PlatformRequest
platformOverride
    , $sel:uMirrors:UserSettings :: Maybe DownloadMirrors
uMirrors = DownloadMirrors -> Maybe DownloadMirrors
forall a. a -> Maybe a
Just DownloadMirrors
mirrors
  }

data UserKeyBindings = UserKeyBindings
  { UserKeyBindings -> Maybe KeyCombination
kUp           :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kDown         :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kQuit         :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kInstall      :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kUninstall    :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kSet          :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kChangelog    :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kShowAll      :: Maybe KeyCombination
  , UserKeyBindings -> Maybe KeyCombination
kShowAllTools :: Maybe KeyCombination
  }
  deriving (Int -> UserKeyBindings -> ShowS
[UserKeyBindings] -> ShowS
UserKeyBindings -> String
(Int -> UserKeyBindings -> ShowS)
-> (UserKeyBindings -> String)
-> ([UserKeyBindings] -> ShowS)
-> Show UserKeyBindings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserKeyBindings -> ShowS
showsPrec :: Int -> UserKeyBindings -> ShowS
$cshow :: UserKeyBindings -> String
show :: UserKeyBindings -> String
$cshowList :: [UserKeyBindings] -> ShowS
showList :: [UserKeyBindings] -> ShowS
Show, (forall x. UserKeyBindings -> Rep UserKeyBindings x)
-> (forall x. Rep UserKeyBindings x -> UserKeyBindings)
-> Generic UserKeyBindings
forall x. Rep UserKeyBindings x -> UserKeyBindings
forall x. UserKeyBindings -> Rep UserKeyBindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserKeyBindings -> Rep UserKeyBindings x
from :: forall x. UserKeyBindings -> Rep UserKeyBindings x
$cto :: forall x. Rep UserKeyBindings x -> UserKeyBindings
to :: forall x. Rep UserKeyBindings x -> UserKeyBindings
GHC.Generic)

data KeyBindings = KeyBindings
  { KeyBindings -> KeyCombination
bUp              :: KeyCombination
  , KeyBindings -> KeyCombination
bDown            :: KeyCombination
  , KeyBindings -> KeyCombination
bQuit            :: KeyCombination
  , KeyBindings -> KeyCombination
bInstall         :: KeyCombination
  , KeyBindings -> KeyCombination
bUninstall       :: KeyCombination
  , KeyBindings -> KeyCombination
bSet             :: KeyCombination
  , KeyBindings -> KeyCombination
bChangelog       :: KeyCombination
  , KeyBindings -> KeyCombination
bShowAllVersions :: KeyCombination
  , KeyBindings -> KeyCombination
bShowAllTools    :: KeyCombination
  }
  deriving (Int -> KeyBindings -> ShowS
[KeyBindings] -> ShowS
KeyBindings -> String
(Int -> KeyBindings -> ShowS)
-> (KeyBindings -> String)
-> ([KeyBindings] -> ShowS)
-> Show KeyBindings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyBindings -> ShowS
showsPrec :: Int -> KeyBindings -> ShowS
$cshow :: KeyBindings -> String
show :: KeyBindings -> String
$cshowList :: [KeyBindings] -> ShowS
showList :: [KeyBindings] -> ShowS
Show, (forall x. KeyBindings -> Rep KeyBindings x)
-> (forall x. Rep KeyBindings x -> KeyBindings)
-> Generic KeyBindings
forall x. Rep KeyBindings x -> KeyBindings
forall x. KeyBindings -> Rep KeyBindings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyBindings -> Rep KeyBindings x
from :: forall x. KeyBindings -> Rep KeyBindings x
$cto :: forall x. Rep KeyBindings x -> KeyBindings
to :: forall x. Rep KeyBindings x -> KeyBindings
GHC.Generic)

instance NFData KeyBindings
#if !defined(BRICK)
instance NFData Key

instance NFData Modifier

#endif
instance NFData KeyCombination

defaultKeyBindings :: KeyBindings
defaultKeyBindings :: KeyBindings
defaultKeyBindings = KeyBindings
  { $sel:bUp:KeyBindings :: KeyCombination
bUp              = KeyCombination { $sel:key:KeyCombination :: Key
key = Key
KUp      , $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bDown:KeyBindings :: KeyCombination
bDown            = KeyCombination { $sel:key:KeyCombination :: Key
key = Key
KDown    , $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bQuit:KeyBindings :: KeyCombination
bQuit            = KeyCombination { $sel:key:KeyCombination :: Key
key = Char -> Key
KChar Char
'q', $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bInstall:KeyBindings :: KeyCombination
bInstall         = KeyCombination { $sel:key:KeyCombination :: Key
key = Char -> Key
KChar Char
'i', $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bUninstall:KeyBindings :: KeyCombination
bUninstall       = KeyCombination { $sel:key:KeyCombination :: Key
key = Char -> Key
KChar Char
'u', $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bSet:KeyBindings :: KeyCombination
bSet             = KeyCombination { $sel:key:KeyCombination :: Key
key = Char -> Key
KChar Char
's', $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bChangelog:KeyBindings :: KeyCombination
bChangelog       = KeyCombination { $sel:key:KeyCombination :: Key
key = Char -> Key
KChar Char
'c', $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bShowAllVersions:KeyBindings :: KeyCombination
bShowAllVersions = KeyCombination { $sel:key:KeyCombination :: Key
key = Char -> Key
KChar Char
'a', $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  , $sel:bShowAllTools:KeyBindings :: KeyCombination
bShowAllTools    = KeyCombination { $sel:key:KeyCombination :: Key
key = Char -> Key
KChar Char
't', $sel:mods:KeyCombination :: [Modifier]
mods = [] }
  }

data AppState = AppState
  { AppState -> Settings
settings :: Settings
  , AppState -> Dirs
dirs :: Dirs
  , AppState -> KeyBindings
keyBindings :: KeyBindings
  , AppState -> GHCupInfo
ghcupInfo :: GHCupInfo
  , AppState -> PlatformRequest
pfreq :: PlatformRequest
  , AppState -> LoggerConfig
loggerConfig :: LoggerConfig
  } deriving (Int -> AppState -> ShowS
[AppState] -> ShowS
AppState -> String
(Int -> AppState -> ShowS)
-> (AppState -> String) -> ([AppState] -> ShowS) -> Show AppState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AppState -> ShowS
showsPrec :: Int -> AppState -> ShowS
$cshow :: AppState -> String
show :: AppState -> String
$cshowList :: [AppState] -> ShowS
showList :: [AppState] -> ShowS
Show, (forall x. AppState -> Rep AppState x)
-> (forall x. Rep AppState x -> AppState) -> Generic AppState
forall x. Rep AppState x -> AppState
forall x. AppState -> Rep AppState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AppState -> Rep AppState x
from :: forall x. AppState -> Rep AppState x
$cto :: forall x. Rep AppState x -> AppState
to :: forall x. Rep AppState x -> AppState
GHC.Generic)

instance NFData AppState

fromAppState :: AppState -> LeanAppState
fromAppState :: AppState -> LeanAppState
fromAppState AppState {LoggerConfig
PlatformRequest
Dirs
Settings
KeyBindings
GHCupInfo
$sel:settings:AppState :: AppState -> Settings
$sel:dirs:AppState :: AppState -> Dirs
$sel:keyBindings:AppState :: AppState -> KeyBindings
$sel:ghcupInfo:AppState :: AppState -> GHCupInfo
$sel:pfreq:AppState :: AppState -> PlatformRequest
$sel:loggerConfig:AppState :: AppState -> LoggerConfig
settings :: Settings
dirs :: Dirs
keyBindings :: KeyBindings
ghcupInfo :: GHCupInfo
pfreq :: PlatformRequest
loggerConfig :: LoggerConfig
..} = LeanAppState {LoggerConfig
Dirs
Settings
KeyBindings
settings :: Settings
dirs :: Dirs
keyBindings :: KeyBindings
loggerConfig :: LoggerConfig
$sel:settings:LeanAppState :: Settings
$sel:dirs:LeanAppState :: Dirs
$sel:keyBindings:LeanAppState :: KeyBindings
$sel:loggerConfig:LeanAppState :: LoggerConfig
..}

data LeanAppState = LeanAppState
  { LeanAppState -> Settings
settings :: Settings
  , LeanAppState -> Dirs
dirs :: Dirs
  , LeanAppState -> KeyBindings
keyBindings :: KeyBindings
  , LeanAppState -> LoggerConfig
loggerConfig :: LoggerConfig
  } deriving (Int -> LeanAppState -> ShowS
[LeanAppState] -> ShowS
LeanAppState -> String
(Int -> LeanAppState -> ShowS)
-> (LeanAppState -> String)
-> ([LeanAppState] -> ShowS)
-> Show LeanAppState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LeanAppState -> ShowS
showsPrec :: Int -> LeanAppState -> ShowS
$cshow :: LeanAppState -> String
show :: LeanAppState -> String
$cshowList :: [LeanAppState] -> ShowS
showList :: [LeanAppState] -> ShowS
Show, (forall x. LeanAppState -> Rep LeanAppState x)
-> (forall x. Rep LeanAppState x -> LeanAppState)
-> Generic LeanAppState
forall x. Rep LeanAppState x -> LeanAppState
forall x. LeanAppState -> Rep LeanAppState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LeanAppState -> Rep LeanAppState x
from :: forall x. LeanAppState -> Rep LeanAppState x
$cto :: forall x. Rep LeanAppState x -> LeanAppState
to :: forall x. Rep LeanAppState x -> LeanAppState
GHC.Generic)

instance NFData LeanAppState


data Settings = Settings
  { Settings -> Bool
cache            :: Bool
  , Settings -> Integer
metaCache        :: Integer
  , Settings -> MetaMode
metaMode         :: MetaMode
  , Settings -> Bool
noVerify         :: Bool
  , Settings -> KeepDirs
keepDirs         :: KeepDirs
  , Settings -> Downloader
downloader       :: Downloader
  , Settings -> Bool
verbose          :: Bool
  , Settings -> URLSource
urlSource        :: URLSource
  , Settings -> Bool
noNetwork        :: Bool
  , Settings -> GPGSetting
gpgSetting       :: GPGSetting
  , Settings -> Bool
noColor          :: Bool -- this also exists in LoggerConfig
  , Settings -> Maybe PlatformRequest
platformOverride :: Maybe PlatformRequest
  , Settings -> DownloadMirrors
mirrors          :: DownloadMirrors
  }
  deriving (Int -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
(Int -> Settings -> ShowS)
-> (Settings -> String) -> ([Settings] -> ShowS) -> Show Settings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Settings -> ShowS
showsPrec :: Int -> Settings -> ShowS
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> ShowS
showList :: [Settings] -> ShowS
Show, (forall x. Settings -> Rep Settings x)
-> (forall x. Rep Settings x -> Settings) -> Generic Settings
forall x. Rep Settings x -> Settings
forall x. Settings -> Rep Settings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Settings -> Rep Settings x
from :: forall x. Settings -> Rep Settings x
$cto :: forall x. Rep Settings x -> Settings
to :: forall x. Rep Settings x -> Settings
GHC.Generic)

defaultMetaCache :: Integer
defaultMetaCache :: Integer
defaultMetaCache = Integer
300 -- 5 minutes

defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings = Bool
-> Integer
-> MetaMode
-> Bool
-> KeepDirs
-> Downloader
-> Bool
-> URLSource
-> Bool
-> GPGSetting
-> Bool
-> Maybe PlatformRequest
-> DownloadMirrors
-> Settings
Settings Bool
False Integer
defaultMetaCache MetaMode
Lax Bool
False KeepDirs
Never Downloader
Curl Bool
False URLSource
GHCupURL Bool
False GPGSetting
GPGNone Bool
False Maybe PlatformRequest
forall a. Maybe a
Nothing (Map Text DownloadMirror -> DownloadMirrors
DM Map Text DownloadMirror
forall a. Monoid a => a
mempty)

instance NFData Settings

data Dirs = Dirs
  { Dirs -> GHCupPath
baseDir    :: GHCupPath
  , Dirs -> String
binDir     :: FilePath
  , Dirs -> GHCupPath
cacheDir   :: GHCupPath
  , Dirs -> GHCupPath
logsDir    :: GHCupPath
  , Dirs -> GHCupPath
confDir    :: GHCupPath
  , Dirs -> GHCupPath
dbDir      :: GHCupPath
  , Dirs -> GHCupPath
recycleDir :: GHCupPath -- mainly used on windows
  , Dirs -> GHCupPath
tmpDir     :: GHCupPath
  }
  deriving (Int -> Dirs -> ShowS
[Dirs] -> ShowS
Dirs -> String
(Int -> Dirs -> ShowS)
-> (Dirs -> String) -> ([Dirs] -> ShowS) -> Show Dirs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Dirs -> ShowS
showsPrec :: Int -> Dirs -> ShowS
$cshow :: Dirs -> String
show :: Dirs -> String
$cshowList :: [Dirs] -> ShowS
showList :: [Dirs] -> ShowS
Show, (forall x. Dirs -> Rep Dirs x)
-> (forall x. Rep Dirs x -> Dirs) -> Generic Dirs
forall x. Rep Dirs x -> Dirs
forall x. Dirs -> Rep Dirs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Dirs -> Rep Dirs x
from :: forall x. Dirs -> Rep Dirs x
$cto :: forall x. Rep Dirs x -> Dirs
to :: forall x. Rep Dirs x -> Dirs
GHC.Generic)

instance NFData Dirs

data KeepDirs = Always
              | Errors
              | Never
  deriving (KeepDirs -> KeepDirs -> Bool
(KeepDirs -> KeepDirs -> Bool)
-> (KeepDirs -> KeepDirs -> Bool) -> Eq KeepDirs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeepDirs -> KeepDirs -> Bool
== :: KeepDirs -> KeepDirs -> Bool
$c/= :: KeepDirs -> KeepDirs -> Bool
/= :: KeepDirs -> KeepDirs -> Bool
Eq, Int -> KeepDirs -> ShowS
[KeepDirs] -> ShowS
KeepDirs -> String
(Int -> KeepDirs -> ShowS)
-> (KeepDirs -> String) -> ([KeepDirs] -> ShowS) -> Show KeepDirs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeepDirs -> ShowS
showsPrec :: Int -> KeepDirs -> ShowS
$cshow :: KeepDirs -> String
show :: KeepDirs -> String
$cshowList :: [KeepDirs] -> ShowS
showList :: [KeepDirs] -> ShowS
Show, Eq KeepDirs
Eq KeepDirs
-> (KeepDirs -> KeepDirs -> Ordering)
-> (KeepDirs -> KeepDirs -> Bool)
-> (KeepDirs -> KeepDirs -> Bool)
-> (KeepDirs -> KeepDirs -> Bool)
-> (KeepDirs -> KeepDirs -> Bool)
-> (KeepDirs -> KeepDirs -> KeepDirs)
-> (KeepDirs -> KeepDirs -> KeepDirs)
-> Ord KeepDirs
KeepDirs -> KeepDirs -> Bool
KeepDirs -> KeepDirs -> Ordering
KeepDirs -> KeepDirs -> KeepDirs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: KeepDirs -> KeepDirs -> Ordering
compare :: KeepDirs -> KeepDirs -> Ordering
$c< :: KeepDirs -> KeepDirs -> Bool
< :: KeepDirs -> KeepDirs -> Bool
$c<= :: KeepDirs -> KeepDirs -> Bool
<= :: KeepDirs -> KeepDirs -> Bool
$c> :: KeepDirs -> KeepDirs -> Bool
> :: KeepDirs -> KeepDirs -> Bool
$c>= :: KeepDirs -> KeepDirs -> Bool
>= :: KeepDirs -> KeepDirs -> Bool
$cmax :: KeepDirs -> KeepDirs -> KeepDirs
max :: KeepDirs -> KeepDirs -> KeepDirs
$cmin :: KeepDirs -> KeepDirs -> KeepDirs
min :: KeepDirs -> KeepDirs -> KeepDirs
Ord, (forall x. KeepDirs -> Rep KeepDirs x)
-> (forall x. Rep KeepDirs x -> KeepDirs) -> Generic KeepDirs
forall x. Rep KeepDirs x -> KeepDirs
forall x. KeepDirs -> Rep KeepDirs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeepDirs -> Rep KeepDirs x
from :: forall x. KeepDirs -> Rep KeepDirs x
$cto :: forall x. Rep KeepDirs x -> KeepDirs
to :: forall x. Rep KeepDirs x -> KeepDirs
GHC.Generic)

instance NFData KeepDirs

data Downloader = Curl
                | Wget
#if defined(INTERNAL_DOWNLOADER)
                | Internal
#endif
  deriving (Downloader -> Downloader -> Bool
(Downloader -> Downloader -> Bool)
-> (Downloader -> Downloader -> Bool) -> Eq Downloader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Downloader -> Downloader -> Bool
== :: Downloader -> Downloader -> Bool
$c/= :: Downloader -> Downloader -> Bool
/= :: Downloader -> Downloader -> Bool
Eq, Int -> Downloader -> ShowS
[Downloader] -> ShowS
Downloader -> String
(Int -> Downloader -> ShowS)
-> (Downloader -> String)
-> ([Downloader] -> ShowS)
-> Show Downloader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Downloader -> ShowS
showsPrec :: Int -> Downloader -> ShowS
$cshow :: Downloader -> String
show :: Downloader -> String
$cshowList :: [Downloader] -> ShowS
showList :: [Downloader] -> ShowS
Show, Eq Downloader
Eq Downloader
-> (Downloader -> Downloader -> Ordering)
-> (Downloader -> Downloader -> Bool)
-> (Downloader -> Downloader -> Bool)
-> (Downloader -> Downloader -> Bool)
-> (Downloader -> Downloader -> Bool)
-> (Downloader -> Downloader -> Downloader)
-> (Downloader -> Downloader -> Downloader)
-> Ord Downloader
Downloader -> Downloader -> Bool
Downloader -> Downloader -> Ordering
Downloader -> Downloader -> Downloader
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Downloader -> Downloader -> Ordering
compare :: Downloader -> Downloader -> Ordering
$c< :: Downloader -> Downloader -> Bool
< :: Downloader -> Downloader -> Bool
$c<= :: Downloader -> Downloader -> Bool
<= :: Downloader -> Downloader -> Bool
$c> :: Downloader -> Downloader -> Bool
> :: Downloader -> Downloader -> Bool
$c>= :: Downloader -> Downloader -> Bool
>= :: Downloader -> Downloader -> Bool
$cmax :: Downloader -> Downloader -> Downloader
max :: Downloader -> Downloader -> Downloader
$cmin :: Downloader -> Downloader -> Downloader
min :: Downloader -> Downloader -> Downloader
Ord, (forall x. Downloader -> Rep Downloader x)
-> (forall x. Rep Downloader x -> Downloader) -> Generic Downloader
forall x. Rep Downloader x -> Downloader
forall x. Downloader -> Rep Downloader x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Downloader -> Rep Downloader x
from :: forall x. Downloader -> Rep Downloader x
$cto :: forall x. Rep Downloader x -> Downloader
to :: forall x. Rep Downloader x -> Downloader
GHC.Generic)

instance NFData Downloader

data GPGSetting = GPGStrict
                | GPGLax
                | GPGNone
  deriving (GPGSetting -> GPGSetting -> Bool
(GPGSetting -> GPGSetting -> Bool)
-> (GPGSetting -> GPGSetting -> Bool) -> Eq GPGSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GPGSetting -> GPGSetting -> Bool
== :: GPGSetting -> GPGSetting -> Bool
$c/= :: GPGSetting -> GPGSetting -> Bool
/= :: GPGSetting -> GPGSetting -> Bool
Eq, Int -> GPGSetting -> ShowS
[GPGSetting] -> ShowS
GPGSetting -> String
(Int -> GPGSetting -> ShowS)
-> (GPGSetting -> String)
-> ([GPGSetting] -> ShowS)
-> Show GPGSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GPGSetting -> ShowS
showsPrec :: Int -> GPGSetting -> ShowS
$cshow :: GPGSetting -> String
show :: GPGSetting -> String
$cshowList :: [GPGSetting] -> ShowS
showList :: [GPGSetting] -> ShowS
Show, Eq GPGSetting
Eq GPGSetting
-> (GPGSetting -> GPGSetting -> Ordering)
-> (GPGSetting -> GPGSetting -> Bool)
-> (GPGSetting -> GPGSetting -> Bool)
-> (GPGSetting -> GPGSetting -> Bool)
-> (GPGSetting -> GPGSetting -> Bool)
-> (GPGSetting -> GPGSetting -> GPGSetting)
-> (GPGSetting -> GPGSetting -> GPGSetting)
-> Ord GPGSetting
GPGSetting -> GPGSetting -> Bool
GPGSetting -> GPGSetting -> Ordering
GPGSetting -> GPGSetting -> GPGSetting
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GPGSetting -> GPGSetting -> Ordering
compare :: GPGSetting -> GPGSetting -> Ordering
$c< :: GPGSetting -> GPGSetting -> Bool
< :: GPGSetting -> GPGSetting -> Bool
$c<= :: GPGSetting -> GPGSetting -> Bool
<= :: GPGSetting -> GPGSetting -> Bool
$c> :: GPGSetting -> GPGSetting -> Bool
> :: GPGSetting -> GPGSetting -> Bool
$c>= :: GPGSetting -> GPGSetting -> Bool
>= :: GPGSetting -> GPGSetting -> Bool
$cmax :: GPGSetting -> GPGSetting -> GPGSetting
max :: GPGSetting -> GPGSetting -> GPGSetting
$cmin :: GPGSetting -> GPGSetting -> GPGSetting
min :: GPGSetting -> GPGSetting -> GPGSetting
Ord, (forall x. GPGSetting -> Rep GPGSetting x)
-> (forall x. Rep GPGSetting x -> GPGSetting) -> Generic GPGSetting
forall x. Rep GPGSetting x -> GPGSetting
forall x. GPGSetting -> Rep GPGSetting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GPGSetting -> Rep GPGSetting x
from :: forall x. GPGSetting -> Rep GPGSetting x
$cto :: forall x. Rep GPGSetting x -> GPGSetting
to :: forall x. Rep GPGSetting x -> GPGSetting
GHC.Generic)

instance NFData GPGSetting

data DebugInfo = DebugInfo
  { DebugInfo -> String
diBaseDir  :: FilePath
  , DebugInfo -> String
diBinDir   :: FilePath
  , DebugInfo -> String
diGHCDir   :: FilePath
  , DebugInfo -> String
diCacheDir :: FilePath
  , DebugInfo -> Architecture
diArch     :: Architecture
  , DebugInfo -> PlatformResult
diPlatform :: PlatformResult
  }
  deriving Int -> DebugInfo -> ShowS
[DebugInfo] -> ShowS
DebugInfo -> String
(Int -> DebugInfo -> ShowS)
-> (DebugInfo -> String)
-> ([DebugInfo] -> ShowS)
-> Show DebugInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DebugInfo -> ShowS
showsPrec :: Int -> DebugInfo -> ShowS
$cshow :: DebugInfo -> String
show :: DebugInfo -> String
$cshowList :: [DebugInfo] -> ShowS
showList :: [DebugInfo] -> ShowS
Show


data SetGHC = SetGHCOnly  -- ^ unversioned 'ghc'
            | SetGHC_XY   -- ^ ghc-x.y
            | SetGHC_XYZ  -- ^ ghc-x.y.z
            deriving (SetGHC -> SetGHC -> Bool
(SetGHC -> SetGHC -> Bool)
-> (SetGHC -> SetGHC -> Bool) -> Eq SetGHC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetGHC -> SetGHC -> Bool
== :: SetGHC -> SetGHC -> Bool
$c/= :: SetGHC -> SetGHC -> Bool
/= :: SetGHC -> SetGHC -> Bool
Eq, Int -> SetGHC -> ShowS
[SetGHC] -> ShowS
SetGHC -> String
(Int -> SetGHC -> ShowS)
-> (SetGHC -> String) -> ([SetGHC] -> ShowS) -> Show SetGHC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetGHC -> ShowS
showsPrec :: Int -> SetGHC -> ShowS
$cshow :: SetGHC -> String
show :: SetGHC -> String
$cshowList :: [SetGHC] -> ShowS
showList :: [SetGHC] -> ShowS
Show)

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 (SetHLS -> SetHLS -> Bool
(SetHLS -> SetHLS -> Bool)
-> (SetHLS -> SetHLS -> Bool) -> Eq SetHLS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetHLS -> SetHLS -> Bool
== :: SetHLS -> SetHLS -> Bool
$c/= :: SetHLS -> SetHLS -> Bool
/= :: SetHLS -> SetHLS -> Bool
Eq, Int -> SetHLS -> ShowS
[SetHLS] -> ShowS
SetHLS -> String
(Int -> SetHLS -> ShowS)
-> (SetHLS -> String) -> ([SetHLS] -> ShowS) -> Show SetHLS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetHLS -> ShowS
showsPrec :: Int -> SetHLS -> ShowS
$cshow :: SetHLS -> String
show :: SetHLS -> String
$cshowList :: [SetHLS] -> ShowS
showList :: [SetHLS] -> ShowS
Show)


data PlatformResult = PlatformResult
  { PlatformResult -> Platform
_platform      :: Platform
  , PlatformResult -> Maybe Versioning
_distroVersion :: Maybe Versioning
  }
  deriving (PlatformResult -> PlatformResult -> Bool
(PlatformResult -> PlatformResult -> Bool)
-> (PlatformResult -> PlatformResult -> Bool) -> Eq PlatformResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlatformResult -> PlatformResult -> Bool
== :: PlatformResult -> PlatformResult -> Bool
$c/= :: PlatformResult -> PlatformResult -> Bool
/= :: PlatformResult -> PlatformResult -> Bool
Eq, Int -> PlatformResult -> ShowS
[PlatformResult] -> ShowS
PlatformResult -> String
(Int -> PlatformResult -> ShowS)
-> (PlatformResult -> String)
-> ([PlatformResult] -> ShowS)
-> Show PlatformResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlatformResult -> ShowS
showsPrec :: Int -> PlatformResult -> ShowS
$cshow :: PlatformResult -> String
show :: PlatformResult -> String
$cshowList :: [PlatformResult] -> ShowS
showList :: [PlatformResult] -> ShowS
Show, (forall x. PlatformResult -> Rep PlatformResult x)
-> (forall x. Rep PlatformResult x -> PlatformResult)
-> Generic PlatformResult
forall x. Rep PlatformResult x -> PlatformResult
forall x. PlatformResult -> Rep PlatformResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PlatformResult -> Rep PlatformResult x
from :: forall x. PlatformResult -> Rep PlatformResult x
$cto :: forall x. Rep PlatformResult x -> PlatformResult
to :: forall x. Rep PlatformResult x -> PlatformResult
GHC.Generic)

instance NFData PlatformResult

platResToString :: PlatformResult -> String
platResToString :: PlatformResult -> String
platResToString PlatformResult { $sel:_platform:PlatformResult :: PlatformResult -> Platform
_platform = Platform
plat, $sel:_distroVersion:PlatformResult :: PlatformResult -> Maybe Versioning
_distroVersion = Just Versioning
v' }
  = Platform -> String
forall a. Show a => a -> String
show Platform
plat String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Versioning -> Text
prettyV Versioning
v')
platResToString PlatformResult { $sel:_platform:PlatformResult :: PlatformResult -> Platform
_platform = Platform
plat, $sel:_distroVersion:PlatformResult :: PlatformResult -> Maybe Versioning
_distroVersion = Maybe Versioning
Nothing }
  = Platform -> String
forall a. Show a => a -> String
show Platform
plat

instance Pretty PlatformResult where
  pPrint :: PlatformResult -> Doc
pPrint = String -> Doc
text (String -> Doc)
-> (PlatformResult -> String) -> PlatformResult -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformResult -> String
platResToString

data PlatformRequest = PlatformRequest
  { PlatformRequest -> Architecture
_rArch     :: Architecture
  , PlatformRequest -> Platform
_rPlatform :: Platform
  , PlatformRequest -> Maybe Versioning
_rVersion  :: Maybe Versioning
  }
  deriving (PlatformRequest -> PlatformRequest -> Bool
(PlatformRequest -> PlatformRequest -> Bool)
-> (PlatformRequest -> PlatformRequest -> Bool)
-> Eq PlatformRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlatformRequest -> PlatformRequest -> Bool
== :: PlatformRequest -> PlatformRequest -> Bool
$c/= :: PlatformRequest -> PlatformRequest -> Bool
/= :: PlatformRequest -> PlatformRequest -> Bool
Eq, Int -> PlatformRequest -> ShowS
[PlatformRequest] -> ShowS
PlatformRequest -> String
(Int -> PlatformRequest -> ShowS)
-> (PlatformRequest -> String)
-> ([PlatformRequest] -> ShowS)
-> Show PlatformRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlatformRequest -> ShowS
showsPrec :: Int -> PlatformRequest -> ShowS
$cshow :: PlatformRequest -> String
show :: PlatformRequest -> String
$cshowList :: [PlatformRequest] -> ShowS
showList :: [PlatformRequest] -> ShowS
Show, (forall x. PlatformRequest -> Rep PlatformRequest x)
-> (forall x. Rep PlatformRequest x -> PlatformRequest)
-> Generic PlatformRequest
forall x. Rep PlatformRequest x -> PlatformRequest
forall x. PlatformRequest -> Rep PlatformRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PlatformRequest -> Rep PlatformRequest x
from :: forall x. PlatformRequest -> Rep PlatformRequest x
$cto :: forall x. Rep PlatformRequest x -> PlatformRequest
to :: forall x. Rep PlatformRequest x -> PlatformRequest
GHC.Generic)

instance NFData PlatformRequest

pfReqToString :: PlatformRequest -> String
pfReqToString :: PlatformRequest -> String
pfReqToString (PlatformRequest Architecture
arch Platform
plat Maybe Versioning
ver) =
  Architecture -> String
archToString Architecture
arch String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Platform -> String
platformToString Platform
plat String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pver
 where
  pver :: String
pver = case Maybe Versioning
ver of
           Just Versioning
v' -> String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Versioning -> Text
prettyV Versioning
v')
           Maybe Versioning
Nothing -> String
""

instance Pretty PlatformRequest where
  pPrint :: PlatformRequest -> Doc
pPrint = String -> Doc
text (String -> Doc)
-> (PlatformRequest -> String) -> PlatformRequest -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformRequest -> String
pfReqToString

-- | A GHC identified by the target platform triple
-- and the version.
data GHCTargetVersion = GHCTargetVersion
  { GHCTargetVersion -> Maybe Text
_tvTarget  :: Maybe Text
  , GHCTargetVersion -> Version
_tvVersion :: Version
  }
  deriving (Eq GHCTargetVersion
Eq GHCTargetVersion
-> (GHCTargetVersion -> GHCTargetVersion -> Ordering)
-> (GHCTargetVersion -> GHCTargetVersion -> Bool)
-> (GHCTargetVersion -> GHCTargetVersion -> Bool)
-> (GHCTargetVersion -> GHCTargetVersion -> Bool)
-> (GHCTargetVersion -> GHCTargetVersion -> Bool)
-> (GHCTargetVersion -> GHCTargetVersion -> GHCTargetVersion)
-> (GHCTargetVersion -> GHCTargetVersion -> GHCTargetVersion)
-> Ord GHCTargetVersion
GHCTargetVersion -> GHCTargetVersion -> Bool
GHCTargetVersion -> GHCTargetVersion -> Ordering
GHCTargetVersion -> GHCTargetVersion -> GHCTargetVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GHCTargetVersion -> GHCTargetVersion -> Ordering
compare :: GHCTargetVersion -> GHCTargetVersion -> Ordering
$c< :: GHCTargetVersion -> GHCTargetVersion -> Bool
< :: GHCTargetVersion -> GHCTargetVersion -> Bool
$c<= :: GHCTargetVersion -> GHCTargetVersion -> Bool
<= :: GHCTargetVersion -> GHCTargetVersion -> Bool
$c> :: GHCTargetVersion -> GHCTargetVersion -> Bool
> :: GHCTargetVersion -> GHCTargetVersion -> Bool
$c>= :: GHCTargetVersion -> GHCTargetVersion -> Bool
>= :: GHCTargetVersion -> GHCTargetVersion -> Bool
$cmax :: GHCTargetVersion -> GHCTargetVersion -> GHCTargetVersion
max :: GHCTargetVersion -> GHCTargetVersion -> GHCTargetVersion
$cmin :: GHCTargetVersion -> GHCTargetVersion -> GHCTargetVersion
min :: GHCTargetVersion -> GHCTargetVersion -> GHCTargetVersion
Ord, GHCTargetVersion -> GHCTargetVersion -> Bool
(GHCTargetVersion -> GHCTargetVersion -> Bool)
-> (GHCTargetVersion -> GHCTargetVersion -> Bool)
-> Eq GHCTargetVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GHCTargetVersion -> GHCTargetVersion -> Bool
== :: GHCTargetVersion -> GHCTargetVersion -> Bool
$c/= :: GHCTargetVersion -> GHCTargetVersion -> Bool
/= :: GHCTargetVersion -> GHCTargetVersion -> Bool
Eq, Int -> GHCTargetVersion -> ShowS
[GHCTargetVersion] -> ShowS
GHCTargetVersion -> String
(Int -> GHCTargetVersion -> ShowS)
-> (GHCTargetVersion -> String)
-> ([GHCTargetVersion] -> ShowS)
-> Show GHCTargetVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GHCTargetVersion -> ShowS
showsPrec :: Int -> GHCTargetVersion -> ShowS
$cshow :: GHCTargetVersion -> String
show :: GHCTargetVersion -> String
$cshowList :: [GHCTargetVersion] -> ShowS
showList :: [GHCTargetVersion] -> ShowS
Show, (forall x. GHCTargetVersion -> Rep GHCTargetVersion x)
-> (forall x. Rep GHCTargetVersion x -> GHCTargetVersion)
-> Generic GHCTargetVersion
forall x. Rep GHCTargetVersion x -> GHCTargetVersion
forall x. GHCTargetVersion -> Rep GHCTargetVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GHCTargetVersion -> Rep GHCTargetVersion x
from :: forall x. GHCTargetVersion -> Rep GHCTargetVersion x
$cto :: forall x. Rep GHCTargetVersion x -> GHCTargetVersion
to :: forall x. Rep GHCTargetVersion x -> GHCTargetVersion
GHC.Generic)

instance NFData GHCTargetVersion

data GitBranch = GitBranch
  { GitBranch -> String
ref  :: String
  , GitBranch -> Maybe String
repo :: Maybe String
  }
  deriving (Eq GitBranch
Eq GitBranch
-> (GitBranch -> GitBranch -> Ordering)
-> (GitBranch -> GitBranch -> Bool)
-> (GitBranch -> GitBranch -> Bool)
-> (GitBranch -> GitBranch -> Bool)
-> (GitBranch -> GitBranch -> Bool)
-> (GitBranch -> GitBranch -> GitBranch)
-> (GitBranch -> GitBranch -> GitBranch)
-> Ord GitBranch
GitBranch -> GitBranch -> Bool
GitBranch -> GitBranch -> Ordering
GitBranch -> GitBranch -> GitBranch
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GitBranch -> GitBranch -> Ordering
compare :: GitBranch -> GitBranch -> Ordering
$c< :: GitBranch -> GitBranch -> Bool
< :: GitBranch -> GitBranch -> Bool
$c<= :: GitBranch -> GitBranch -> Bool
<= :: GitBranch -> GitBranch -> Bool
$c> :: GitBranch -> GitBranch -> Bool
> :: GitBranch -> GitBranch -> Bool
$c>= :: GitBranch -> GitBranch -> Bool
>= :: GitBranch -> GitBranch -> Bool
$cmax :: GitBranch -> GitBranch -> GitBranch
max :: GitBranch -> GitBranch -> GitBranch
$cmin :: GitBranch -> GitBranch -> GitBranch
min :: GitBranch -> GitBranch -> GitBranch
Ord, GitBranch -> GitBranch -> Bool
(GitBranch -> GitBranch -> Bool)
-> (GitBranch -> GitBranch -> Bool) -> Eq GitBranch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitBranch -> GitBranch -> Bool
== :: GitBranch -> GitBranch -> Bool
$c/= :: GitBranch -> GitBranch -> Bool
/= :: GitBranch -> GitBranch -> Bool
Eq, Int -> GitBranch -> ShowS
[GitBranch] -> ShowS
GitBranch -> String
(Int -> GitBranch -> ShowS)
-> (GitBranch -> String)
-> ([GitBranch] -> ShowS)
-> Show GitBranch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitBranch -> ShowS
showsPrec :: Int -> GitBranch -> ShowS
$cshow :: GitBranch -> String
show :: GitBranch -> String
$cshowList :: [GitBranch] -> ShowS
showList :: [GitBranch] -> ShowS
Show)

mkTVer :: Version -> GHCTargetVersion
mkTVer :: Version -> GHCTargetVersion
mkTVer = Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
forall a. Maybe a
Nothing

tVerToText :: GHCTargetVersion -> Text
tVerToText :: GHCTargetVersion -> Text
tVerToText (GHCTargetVersion (Just Text
t) Version
v') = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
v'
tVerToText (GHCTargetVersion Maybe Text
Nothing  Version
v') = Version -> Text
prettyVer Version
v'

-- | Assembles a path of the form: <target-triple>-<version>
instance Pretty GHCTargetVersion where
  pPrint :: GHCTargetVersion -> Doc
pPrint = String -> Doc
text (String -> Doc)
-> (GHCTargetVersion -> String) -> GHCTargetVersion -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> (GHCTargetVersion -> Text) -> GHCTargetVersion -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCTargetVersion -> Text
tVerToText


-- | A comparator and a version.
data VersionCmp = VR_gt Versioning
                | VR_gteq Versioning
                | VR_lt Versioning
                | VR_lteq Versioning
                | VR_eq Versioning
  deriving (VersionCmp -> VersionCmp -> Bool
(VersionCmp -> VersionCmp -> Bool)
-> (VersionCmp -> VersionCmp -> Bool) -> Eq VersionCmp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionCmp -> VersionCmp -> Bool
== :: VersionCmp -> VersionCmp -> Bool
$c/= :: VersionCmp -> VersionCmp -> Bool
/= :: VersionCmp -> VersionCmp -> Bool
Eq, (forall x. VersionCmp -> Rep VersionCmp x)
-> (forall x. Rep VersionCmp x -> VersionCmp) -> Generic VersionCmp
forall x. Rep VersionCmp x -> VersionCmp
forall x. VersionCmp -> Rep VersionCmp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VersionCmp -> Rep VersionCmp x
from :: forall x. VersionCmp -> Rep VersionCmp x
$cto :: forall x. Rep VersionCmp x -> VersionCmp
to :: forall x. Rep VersionCmp x -> VersionCmp
GHC.Generic, Eq VersionCmp
Eq VersionCmp
-> (VersionCmp -> VersionCmp -> Ordering)
-> (VersionCmp -> VersionCmp -> Bool)
-> (VersionCmp -> VersionCmp -> Bool)
-> (VersionCmp -> VersionCmp -> Bool)
-> (VersionCmp -> VersionCmp -> Bool)
-> (VersionCmp -> VersionCmp -> VersionCmp)
-> (VersionCmp -> VersionCmp -> VersionCmp)
-> Ord VersionCmp
VersionCmp -> VersionCmp -> Bool
VersionCmp -> VersionCmp -> Ordering
VersionCmp -> VersionCmp -> VersionCmp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VersionCmp -> VersionCmp -> Ordering
compare :: VersionCmp -> VersionCmp -> Ordering
$c< :: VersionCmp -> VersionCmp -> Bool
< :: VersionCmp -> VersionCmp -> Bool
$c<= :: VersionCmp -> VersionCmp -> Bool
<= :: VersionCmp -> VersionCmp -> Bool
$c> :: VersionCmp -> VersionCmp -> Bool
> :: VersionCmp -> VersionCmp -> Bool
$c>= :: VersionCmp -> VersionCmp -> Bool
>= :: VersionCmp -> VersionCmp -> Bool
$cmax :: VersionCmp -> VersionCmp -> VersionCmp
max :: VersionCmp -> VersionCmp -> VersionCmp
$cmin :: VersionCmp -> VersionCmp -> VersionCmp
min :: VersionCmp -> VersionCmp -> VersionCmp
Ord, Int -> VersionCmp -> ShowS
[VersionCmp] -> ShowS
VersionCmp -> String
(Int -> VersionCmp -> ShowS)
-> (VersionCmp -> String)
-> ([VersionCmp] -> ShowS)
-> Show VersionCmp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionCmp -> ShowS
showsPrec :: Int -> VersionCmp -> ShowS
$cshow :: VersionCmp -> String
show :: VersionCmp -> String
$cshowList :: [VersionCmp] -> ShowS
showList :: [VersionCmp] -> ShowS
Show)

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 (VersionRange -> VersionRange -> Bool
(VersionRange -> VersionRange -> Bool)
-> (VersionRange -> VersionRange -> Bool) -> Eq VersionRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionRange -> VersionRange -> Bool
== :: VersionRange -> VersionRange -> Bool
$c/= :: VersionRange -> VersionRange -> Bool
/= :: VersionRange -> VersionRange -> Bool
Eq, (forall x. VersionRange -> Rep VersionRange x)
-> (forall x. Rep VersionRange x -> VersionRange)
-> Generic VersionRange
forall x. Rep VersionRange x -> VersionRange
forall x. VersionRange -> Rep VersionRange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VersionRange -> Rep VersionRange x
from :: forall x. VersionRange -> Rep VersionRange x
$cto :: forall x. Rep VersionRange x -> VersionRange
to :: forall x. Rep VersionRange x -> VersionRange
GHC.Generic, Eq VersionRange
Eq VersionRange
-> (VersionRange -> VersionRange -> Ordering)
-> (VersionRange -> VersionRange -> Bool)
-> (VersionRange -> VersionRange -> Bool)
-> (VersionRange -> VersionRange -> Bool)
-> (VersionRange -> VersionRange -> Bool)
-> (VersionRange -> VersionRange -> VersionRange)
-> (VersionRange -> VersionRange -> VersionRange)
-> Ord VersionRange
VersionRange -> VersionRange -> Bool
VersionRange -> VersionRange -> Ordering
VersionRange -> VersionRange -> VersionRange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VersionRange -> VersionRange -> Ordering
compare :: VersionRange -> VersionRange -> Ordering
$c< :: VersionRange -> VersionRange -> Bool
< :: VersionRange -> VersionRange -> Bool
$c<= :: VersionRange -> VersionRange -> Bool
<= :: VersionRange -> VersionRange -> Bool
$c> :: VersionRange -> VersionRange -> Bool
> :: VersionRange -> VersionRange -> Bool
$c>= :: VersionRange -> VersionRange -> Bool
>= :: VersionRange -> VersionRange -> Bool
$cmax :: VersionRange -> VersionRange -> VersionRange
max :: VersionRange -> VersionRange -> VersionRange
$cmin :: VersionRange -> VersionRange -> VersionRange
min :: VersionRange -> VersionRange -> VersionRange
Ord, Int -> VersionRange -> ShowS
[VersionRange] -> ShowS
VersionRange -> String
(Int -> VersionRange -> ShowS)
-> (VersionRange -> String)
-> ([VersionRange] -> ShowS)
-> Show VersionRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionRange -> ShowS
showsPrec :: Int -> VersionRange -> ShowS
$cshow :: VersionRange -> String
show :: VersionRange -> String
$cshowList :: [VersionRange] -> ShowS
showList :: [VersionRange] -> ShowS
Show)

instance NFData VersionRange

instance Pretty VersionCmp where
  pPrint :: VersionCmp -> Doc
pPrint (VR_gt Versioning
v) = String -> Doc
text String
"> " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Versioning -> Doc
forall a. Pretty a => a -> Doc
pPrint Versioning
v
  pPrint (VR_gteq Versioning
v) = String -> Doc
text String
">= " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Versioning -> Doc
forall a. Pretty a => a -> Doc
pPrint Versioning
v
  pPrint (VR_lt Versioning
v) = String -> Doc
text String
"< " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Versioning -> Doc
forall a. Pretty a => a -> Doc
pPrint Versioning
v
  pPrint (VR_lteq Versioning
v) = String -> Doc
text String
"<= " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Versioning -> Doc
forall a. Pretty a => a -> Doc
pPrint Versioning
v
  pPrint (VR_eq Versioning
v) = String -> Doc
text String
"= " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Versioning -> Doc
forall a. Pretty a => a -> Doc
pPrint Versioning
v

instance Pretty VersionRange where
  pPrint :: VersionRange -> Doc
pPrint (SimpleRange NonEmpty VersionCmp
xs) = (Doc -> Doc -> Doc) -> NonEmpty Doc -> Doc
forall a. (a -> a -> a) -> NonEmpty a -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\Doc
x Doc
y -> Doc
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" && " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
y) (NonEmpty Doc -> Doc) -> NonEmpty Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (VersionCmp -> Doc) -> NonEmpty VersionCmp -> NonEmpty Doc
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map VersionCmp -> Doc
forall a. Pretty a => a -> Doc
pPrint NonEmpty VersionCmp
xs
  pPrint (OrRange NonEmpty VersionCmp
xs VersionRange
vr) = (VersionCmp -> Doc) -> NonEmpty VersionCmp -> Doc
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap VersionCmp -> Doc
forall a. Pretty a => a -> Doc
pPrint NonEmpty VersionCmp
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" || " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> VersionRange -> Doc
forall a. Pretty a => a -> Doc
pPrint VersionRange
vr

instance Pretty Versioning where
  pPrint :: Versioning -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Versioning -> String) -> Versioning -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Versioning -> Text) -> Versioning -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Versioning -> Text
prettyV

instance Pretty Version where
  pPrint :: Version -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Version -> String) -> Version -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Version -> Text) -> Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer

instance Show (a -> b) where
  show :: (a -> b) -> String
show a -> b
_ = String
"<function>"

instance Show (IO ()) where
  show :: IO () -> String
show IO ()
_ = String
"<io>"


data LogLevel = Warn
              | Info
              | Debug
              | Error
  deriving (LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LogLevel -> LogLevel -> Ordering
compare :: LogLevel -> LogLevel -> Ordering
$c< :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
>= :: LogLevel -> LogLevel -> Bool
$cmax :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
min :: LogLevel -> LogLevel -> LogLevel
Ord, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show)

data LoggerConfig = LoggerConfig
  { LoggerConfig -> Bool
lcPrintDebug   :: Bool            -- ^ whether to print debug in colorOutter
  , LoggerConfig -> Text -> IO ()
consoleOutter  :: T.Text -> IO () -- ^ how to write the console output
  , LoggerConfig -> Text -> IO ()
fileOutter     :: T.Text -> IO () -- ^ how to write the file output
  , LoggerConfig -> Bool
fancyColors    :: Bool
  }
  deriving Int -> LoggerConfig -> ShowS
[LoggerConfig] -> ShowS
LoggerConfig -> String
(Int -> LoggerConfig -> ShowS)
-> (LoggerConfig -> String)
-> ([LoggerConfig] -> ShowS)
-> Show LoggerConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoggerConfig -> ShowS
showsPrec :: Int -> LoggerConfig -> ShowS
$cshow :: LoggerConfig -> String
show :: LoggerConfig -> String
$cshowList :: [LoggerConfig] -> ShowS
showList :: [LoggerConfig] -> ShowS
Show

instance NFData LoggerConfig where
  rnf :: LoggerConfig -> ()
rnf (LoggerConfig !Bool
lcPrintDebug !Text -> IO ()
_ !Text -> IO ()
_ !Bool
fancyColors) = (Bool, Bool) -> ()
forall a. NFData a => a -> ()
rnf (Bool
lcPrintDebug, Bool
fancyColors)

data ProcessError = NonZeroExit Int FilePath [String]
                  | PTerminated FilePath [String]
                  | PStopped FilePath [String]
                  | NoSuchPid FilePath [String]
                  deriving Int -> ProcessError -> ShowS
[ProcessError] -> ShowS
ProcessError -> String
(Int -> ProcessError -> ShowS)
-> (ProcessError -> String)
-> ([ProcessError] -> ShowS)
-> Show ProcessError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProcessError -> ShowS
showsPrec :: Int -> ProcessError -> ShowS
$cshow :: ProcessError -> String
show :: ProcessError -> String
$cshowList :: [ProcessError] -> ShowS
showList :: [ProcessError] -> ShowS
Show


data CapturedProcess = CapturedProcess
  { CapturedProcess -> ExitCode
_exitCode :: ExitCode
  , CapturedProcess -> ByteString
_stdOut   :: BL.ByteString
  , CapturedProcess -> ByteString
_stdErr   :: BL.ByteString
  }
  deriving (CapturedProcess -> CapturedProcess -> Bool
(CapturedProcess -> CapturedProcess -> Bool)
-> (CapturedProcess -> CapturedProcess -> Bool)
-> Eq CapturedProcess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CapturedProcess -> CapturedProcess -> Bool
== :: CapturedProcess -> CapturedProcess -> Bool
$c/= :: CapturedProcess -> CapturedProcess -> Bool
/= :: CapturedProcess -> CapturedProcess -> Bool
Eq, Int -> CapturedProcess -> ShowS
[CapturedProcess] -> ShowS
CapturedProcess -> String
(Int -> CapturedProcess -> ShowS)
-> (CapturedProcess -> String)
-> ([CapturedProcess] -> ShowS)
-> Show CapturedProcess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CapturedProcess -> ShowS
showsPrec :: Int -> CapturedProcess -> ShowS
$cshow :: CapturedProcess -> String
show :: CapturedProcess -> String
$cshowList :: [CapturedProcess] -> ShowS
showList :: [CapturedProcess] -> ShowS
Show)

makeLenses ''CapturedProcess


data InstallDir = IsolateDir FilePath
                | GHCupInternal
  deriving (InstallDir -> InstallDir -> Bool
(InstallDir -> InstallDir -> Bool)
-> (InstallDir -> InstallDir -> Bool) -> Eq InstallDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstallDir -> InstallDir -> Bool
== :: InstallDir -> InstallDir -> Bool
$c/= :: InstallDir -> InstallDir -> Bool
/= :: InstallDir -> InstallDir -> Bool
Eq, Int -> InstallDir -> ShowS
[InstallDir] -> ShowS
InstallDir -> String
(Int -> InstallDir -> ShowS)
-> (InstallDir -> String)
-> ([InstallDir] -> ShowS)
-> Show InstallDir
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallDir -> ShowS
showsPrec :: Int -> InstallDir -> ShowS
$cshow :: InstallDir -> String
show :: InstallDir -> String
$cshowList :: [InstallDir] -> ShowS
showList :: [InstallDir] -> ShowS
Show)

data InstallDirResolved = IsolateDirResolved FilePath
                        | GHCupDir GHCupPath
                        | GHCupBinDir FilePath
  deriving (InstallDirResolved -> InstallDirResolved -> Bool
(InstallDirResolved -> InstallDirResolved -> Bool)
-> (InstallDirResolved -> InstallDirResolved -> Bool)
-> Eq InstallDirResolved
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InstallDirResolved -> InstallDirResolved -> Bool
== :: InstallDirResolved -> InstallDirResolved -> Bool
$c/= :: InstallDirResolved -> InstallDirResolved -> Bool
/= :: InstallDirResolved -> InstallDirResolved -> Bool
Eq, Int -> InstallDirResolved -> ShowS
[InstallDirResolved] -> ShowS
InstallDirResolved -> String
(Int -> InstallDirResolved -> ShowS)
-> (InstallDirResolved -> String)
-> ([InstallDirResolved] -> ShowS)
-> Show InstallDirResolved
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InstallDirResolved -> ShowS
showsPrec :: Int -> InstallDirResolved -> ShowS
$cshow :: InstallDirResolved -> String
show :: InstallDirResolved -> String
$cshowList :: [InstallDirResolved] -> ShowS
showList :: [InstallDirResolved] -> ShowS
Show)

fromInstallDir :: InstallDirResolved -> FilePath
fromInstallDir :: InstallDirResolved -> String
fromInstallDir (IsolateDirResolved String
fp) = String
fp
fromInstallDir (GHCupDir GHCupPath
fp) = GHCupPath -> String
fromGHCupPath GHCupPath
fp
fromInstallDir (GHCupBinDir String
fp) = String
fp


isSafeDir :: InstallDirResolved -> Bool
isSafeDir :: InstallDirResolved -> Bool
isSafeDir (IsolateDirResolved String
_) = Bool
False
isSafeDir (GHCupDir GHCupPath
_)           = Bool
True
isSafeDir (GHCupBinDir String
_)        = Bool
False

type PromptQuestion = Text

data PromptResponse = PromptYes | PromptNo
  deriving (Int -> PromptResponse -> ShowS
[PromptResponse] -> ShowS
PromptResponse -> String
(Int -> PromptResponse -> ShowS)
-> (PromptResponse -> String)
-> ([PromptResponse] -> ShowS)
-> Show PromptResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptResponse -> ShowS
showsPrec :: Int -> PromptResponse -> ShowS
$cshow :: PromptResponse -> String
show :: PromptResponse -> String
$cshowList :: [PromptResponse] -> ShowS
showList :: [PromptResponse] -> ShowS
Show, PromptResponse -> PromptResponse -> Bool
(PromptResponse -> PromptResponse -> Bool)
-> (PromptResponse -> PromptResponse -> Bool) -> Eq PromptResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PromptResponse -> PromptResponse -> Bool
== :: PromptResponse -> PromptResponse -> Bool
$c/= :: PromptResponse -> PromptResponse -> Bool
/= :: PromptResponse -> PromptResponse -> Bool
Eq)

data ToolVersion = GHCVersion GHCTargetVersion
                 | ToolVersion Version
                 | ToolTag Tag
                 | ToolDay Day
                 deriving (ToolVersion -> ToolVersion -> Bool
(ToolVersion -> ToolVersion -> Bool)
-> (ToolVersion -> ToolVersion -> Bool) -> Eq ToolVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToolVersion -> ToolVersion -> Bool
== :: ToolVersion -> ToolVersion -> Bool
$c/= :: ToolVersion -> ToolVersion -> Bool
/= :: ToolVersion -> ToolVersion -> Bool
Eq, Int -> ToolVersion -> ShowS
[ToolVersion] -> ShowS
ToolVersion -> String
(Int -> ToolVersion -> ShowS)
-> (ToolVersion -> String)
-> ([ToolVersion] -> ShowS)
-> Show ToolVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolVersion -> ShowS
showsPrec :: Int -> ToolVersion -> ShowS
$cshow :: ToolVersion -> String
show :: ToolVersion -> String
$cshowList :: [ToolVersion] -> ShowS
showList :: [ToolVersion] -> ShowS
Show)

instance Pretty ToolVersion where
  pPrint :: ToolVersion -> Doc
pPrint (GHCVersion GHCTargetVersion
v) = GHCTargetVersion -> Doc
forall a. Pretty a => a -> Doc
pPrint GHCTargetVersion
v
  pPrint (ToolVersion Version
v) = Version -> Doc
forall a. Pretty a => a -> Doc
pPrint Version
v
  pPrint (ToolTag Tag
t) = Tag -> Doc
forall a. Pretty a => a -> Doc
pPrint Tag
t
  pPrint (ToolDay Day
d) = String -> Doc
text (Day -> String
forall a. Show a => a -> String
show Day
d)



data BuildSystem = Hadrian
                 | Make
  deriving (Int -> BuildSystem -> ShowS
[BuildSystem] -> ShowS
BuildSystem -> String
(Int -> BuildSystem -> ShowS)
-> (BuildSystem -> String)
-> ([BuildSystem] -> ShowS)
-> Show BuildSystem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildSystem -> ShowS
showsPrec :: Int -> BuildSystem -> ShowS
$cshow :: BuildSystem -> String
show :: BuildSystem -> String
$cshowList :: [BuildSystem] -> ShowS
showList :: [BuildSystem] -> ShowS
Show, BuildSystem -> BuildSystem -> Bool
(BuildSystem -> BuildSystem -> Bool)
-> (BuildSystem -> BuildSystem -> Bool) -> Eq BuildSystem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildSystem -> BuildSystem -> Bool
== :: BuildSystem -> BuildSystem -> Bool
$c/= :: BuildSystem -> BuildSystem -> Bool
/= :: BuildSystem -> BuildSystem -> Bool
Eq)