{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}

module HS.Types.InstallMode where

import           Data.Default
import           Fmt
import           Text.Enum.Text


-- | how to react to a missing toolchain?
data InstallMode
  = IM_no_install   -- ^ do not try to install, report error
  | IM_install      -- ^ download and install
  | IM_ask_install  -- ^ ask the user if they want to install the misssing toolchain
  deriving stock    (InstallMode
InstallMode -> InstallMode -> Bounded InstallMode
forall a. a -> a -> Bounded a
maxBound :: InstallMode
$cmaxBound :: InstallMode
minBound :: InstallMode
$cminBound :: InstallMode
Bounded,Int -> InstallMode
InstallMode -> Int
InstallMode -> [InstallMode]
InstallMode -> InstallMode
InstallMode -> InstallMode -> [InstallMode]
InstallMode -> InstallMode -> InstallMode -> [InstallMode]
(InstallMode -> InstallMode)
-> (InstallMode -> InstallMode)
-> (Int -> InstallMode)
-> (InstallMode -> Int)
-> (InstallMode -> [InstallMode])
-> (InstallMode -> InstallMode -> [InstallMode])
-> (InstallMode -> InstallMode -> [InstallMode])
-> (InstallMode -> InstallMode -> InstallMode -> [InstallMode])
-> Enum InstallMode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InstallMode -> InstallMode -> InstallMode -> [InstallMode]
$cenumFromThenTo :: InstallMode -> InstallMode -> InstallMode -> [InstallMode]
enumFromTo :: InstallMode -> InstallMode -> [InstallMode]
$cenumFromTo :: InstallMode -> InstallMode -> [InstallMode]
enumFromThen :: InstallMode -> InstallMode -> [InstallMode]
$cenumFromThen :: InstallMode -> InstallMode -> [InstallMode]
enumFrom :: InstallMode -> [InstallMode]
$cenumFrom :: InstallMode -> [InstallMode]
fromEnum :: InstallMode -> Int
$cfromEnum :: InstallMode -> Int
toEnum :: Int -> InstallMode
$ctoEnum :: Int -> InstallMode
pred :: InstallMode -> InstallMode
$cpred :: InstallMode -> InstallMode
succ :: InstallMode -> InstallMode
$csucc :: InstallMode -> InstallMode
Enum,InstallMode -> InstallMode -> Bool
(InstallMode -> InstallMode -> Bool)
-> (InstallMode -> InstallMode -> Bool) -> Eq InstallMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallMode -> InstallMode -> Bool
$c/= :: InstallMode -> InstallMode -> Bool
== :: InstallMode -> InstallMode -> Bool
$c== :: InstallMode -> InstallMode -> Bool
Eq,Eq InstallMode
Eq InstallMode
-> (InstallMode -> InstallMode -> Ordering)
-> (InstallMode -> InstallMode -> Bool)
-> (InstallMode -> InstallMode -> Bool)
-> (InstallMode -> InstallMode -> Bool)
-> (InstallMode -> InstallMode -> Bool)
-> (InstallMode -> InstallMode -> InstallMode)
-> (InstallMode -> InstallMode -> InstallMode)
-> Ord InstallMode
InstallMode -> InstallMode -> Bool
InstallMode -> InstallMode -> Ordering
InstallMode -> InstallMode -> InstallMode
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
min :: InstallMode -> InstallMode -> InstallMode
$cmin :: InstallMode -> InstallMode -> InstallMode
max :: InstallMode -> InstallMode -> InstallMode
$cmax :: InstallMode -> InstallMode -> InstallMode
>= :: InstallMode -> InstallMode -> Bool
$c>= :: InstallMode -> InstallMode -> Bool
> :: InstallMode -> InstallMode -> Bool
$c> :: InstallMode -> InstallMode -> Bool
<= :: InstallMode -> InstallMode -> Bool
$c<= :: InstallMode -> InstallMode -> Bool
< :: InstallMode -> InstallMode -> Bool
$c< :: InstallMode -> InstallMode -> Bool
compare :: InstallMode -> InstallMode -> Ordering
$ccompare :: InstallMode -> InstallMode -> Ordering
$cp1Ord :: Eq InstallMode
Ord,Int -> InstallMode -> ShowS
[InstallMode] -> ShowS
InstallMode -> String
(Int -> InstallMode -> ShowS)
-> (InstallMode -> String)
-> ([InstallMode] -> ShowS)
-> Show InstallMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstallMode] -> ShowS
$cshowList :: [InstallMode] -> ShowS
show :: InstallMode -> String
$cshow :: InstallMode -> String
showsPrec :: Int -> InstallMode -> ShowS
$cshowsPrec :: Int -> InstallMode -> ShowS
Show)
  deriving anyclass (Bounded InstallMode
Enum InstallMode
Eq InstallMode
Ord InstallMode
Show InstallMode
TextParsable InstallMode
Buildable InstallMode
Int -> InstallMode -> Int
Text -> Possibly InstallMode
Buildable InstallMode
-> Bounded InstallMode
-> Enum InstallMode
-> Eq InstallMode
-> Ord InstallMode
-> Show InstallMode
-> TextParsable InstallMode
-> (InstallMode -> EnumTextConfig)
-> (InstallMode -> Text)
-> (InstallMode -> Builder)
-> (Text -> Possibly InstallMode)
-> (InstallMode -> ByteString)
-> (forall (m :: * -> *).
    MonadFail m =>
    ByteString -> m InstallMode)
-> (Int -> InstallMode -> Int)
-> EnumText InstallMode
InstallMode -> ByteString
InstallMode -> Builder
InstallMode -> Text
InstallMode -> EnumTextConfig
forall e.
Buildable e
-> Bounded e
-> Enum e
-> Eq e
-> Ord e
-> Show e
-> TextParsable e
-> (e -> EnumTextConfig)
-> (e -> Text)
-> (e -> Builder)
-> (Text -> Possibly e)
-> (e -> ByteString)
-> (forall (m :: * -> *). MonadFail m => ByteString -> m e)
-> (Int -> e -> Int)
-> EnumText e
forall (m :: * -> *). MonadFail m => ByteString -> m InstallMode
hashWithSaltEnumText :: Int -> InstallMode -> Int
$chashWithSaltEnumText :: Int -> InstallMode -> Int
fromFieldEnumText_ :: ByteString -> m InstallMode
$cfromFieldEnumText_ :: forall (m :: * -> *). MonadFail m => ByteString -> m InstallMode
toFieldEnumText :: InstallMode -> ByteString
$ctoFieldEnumText :: InstallMode -> ByteString
parseEnumText :: Text -> Possibly InstallMode
$cparseEnumText :: Text -> Possibly InstallMode
buildEnumText :: InstallMode -> Builder
$cbuildEnumText :: InstallMode -> Builder
renderEnumText :: InstallMode -> Text
$crenderEnumText :: InstallMode -> Text
configEnumText :: InstallMode -> EnumTextConfig
$cconfigEnumText :: InstallMode -> EnumTextConfig
$cp7EnumText :: TextParsable InstallMode
$cp6EnumText :: Show InstallMode
$cp5EnumText :: Ord InstallMode
$cp4EnumText :: Eq InstallMode
$cp3EnumText :: Enum InstallMode
$cp2EnumText :: Bounded InstallMode
$cp1EnumText :: Buildable InstallMode
EnumText)
  deriving (InstallMode -> Builder
(InstallMode -> Builder) -> Buildable InstallMode
forall p. (p -> Builder) -> Buildable p
build :: InstallMode -> Builder
$cbuild :: InstallMode -> Builder
Buildable,Text -> Possibly InstallMode
(Text -> Possibly InstallMode) -> TextParsable InstallMode
forall a. (Text -> Possibly a) -> TextParsable a
parseText :: Text -> Possibly InstallMode
$cparseText :: Text -> Possibly InstallMode
TextParsable) via UsingEnumText InstallMode

instance Default InstallMode where
  def :: InstallMode
def = InstallMode
forall a. Bounded a => a
minBound