{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE QuasiQuotes #-}

module Hinit.Errors where

import Control.Algebra
import Control.Effect.Lift
import Control.Effect.Terminal
import Control.Exception
import Data.String.Interpolate
import Data.Text (Text)
import Data.Void
import GHC.Generics
import Hinit.Types
import Hinit.Utils
import Path
import Prettyprinter
import Prettyprinter.Render.Terminal
import System.Exit
import System.IO
import System.Process
import Text.Megaparsec.Error
import Text.Mustache.Render
import Toml.Codec.Error
import Prelude hiding (print)

data ExprParseError = ExprParseError
  { ExprParseError -> Text
expression :: Text,
    ExprParseError -> [ParseError Text Void]
errors :: [ParseError Text Void]
  }
  deriving (ExprParseError -> ExprParseError -> Bool
(ExprParseError -> ExprParseError -> Bool)
-> (ExprParseError -> ExprParseError -> Bool) -> Eq ExprParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExprParseError -> ExprParseError -> Bool
$c/= :: ExprParseError -> ExprParseError -> Bool
== :: ExprParseError -> ExprParseError -> Bool
$c== :: ExprParseError -> ExprParseError -> Bool
Eq, (forall x. ExprParseError -> Rep ExprParseError x)
-> (forall x. Rep ExprParseError x -> ExprParseError)
-> Generic ExprParseError
forall x. Rep ExprParseError x -> ExprParseError
forall x. ExprParseError -> Rep ExprParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExprParseError x -> ExprParseError
$cfrom :: forall x. ExprParseError -> Rep ExprParseError x
Generic)
  deriving (Int -> ExprParseError -> ShowS
[ExprParseError] -> ShowS
ExprParseError -> String
(Int -> ExprParseError -> ShowS)
-> (ExprParseError -> String)
-> ([ExprParseError] -> ShowS)
-> Show ExprParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExprParseError] -> ShowS
$cshowList :: [ExprParseError] -> ShowS
show :: ExprParseError -> String
$cshow :: ExprParseError -> String
showsPrec :: Int -> ExprParseError -> ShowS
$cshowsPrec :: Int -> ExprParseError -> ShowS
Show) via PrettyShow ExprParseError
  deriving anyclass (Show ExprParseError
Typeable ExprParseError
Typeable ExprParseError
-> Show ExprParseError
-> (ExprParseError -> SomeException)
-> (SomeException -> Maybe ExprParseError)
-> (ExprParseError -> String)
-> Exception ExprParseError
SomeException -> Maybe ExprParseError
ExprParseError -> String
ExprParseError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ExprParseError -> String
$cdisplayException :: ExprParseError -> String
fromException :: SomeException -> Maybe ExprParseError
$cfromException :: SomeException -> Maybe ExprParseError
toException :: ExprParseError -> SomeException
$ctoException :: ExprParseError -> SomeException
$cp2Exception :: Show ExprParseError
$cp1Exception :: Typeable ExprParseError
Exception)

instance Pretty ExprParseError where
  pretty :: ExprParseError -> Doc ann
pretty ExprParseError {[ParseError Text Void]
Text
errors :: [ParseError Text Void]
expression :: Text
$sel:errors:ExprParseError :: ExprParseError -> [ParseError Text Void]
$sel:expression:ExprParseError :: ExprParseError -> Text
..} =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ [i|failed to parse boolean expressionession "#{expression}":|],
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
mkBulletList ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (ParseError Text Void -> Doc ann)
-> [ParseError Text Void] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann)
-> (ParseError Text Void -> String)
-> ParseError Text Void
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError Text Void -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorPretty) [ParseError Text Void]
errors
      ]

data TomlFile
  = Global
  | Template Text
  deriving (TomlFile -> TomlFile -> Bool
(TomlFile -> TomlFile -> Bool)
-> (TomlFile -> TomlFile -> Bool) -> Eq TomlFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TomlFile -> TomlFile -> Bool
$c/= :: TomlFile -> TomlFile -> Bool
== :: TomlFile -> TomlFile -> Bool
$c== :: TomlFile -> TomlFile -> Bool
Eq)

instance Show TomlFile where
  show :: TomlFile -> String
show TomlFile
Global = String
"global config file (~/.config/hi/config.toml)"
  show (Template Text
t) = [i|template config file from #{t}|]

data ConfigParseError = ConfigParseError
  { ConfigParseError -> TomlFile
file :: TomlFile,
    ConfigParseError -> [TomlDecodeError]
errors :: [TomlDecodeError]
  }
  deriving (ConfigParseError -> ConfigParseError -> Bool
(ConfigParseError -> ConfigParseError -> Bool)
-> (ConfigParseError -> ConfigParseError -> Bool)
-> Eq ConfigParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigParseError -> ConfigParseError -> Bool
$c/= :: ConfigParseError -> ConfigParseError -> Bool
== :: ConfigParseError -> ConfigParseError -> Bool
$c== :: ConfigParseError -> ConfigParseError -> Bool
Eq, (forall x. ConfigParseError -> Rep ConfigParseError x)
-> (forall x. Rep ConfigParseError x -> ConfigParseError)
-> Generic ConfigParseError
forall x. Rep ConfigParseError x -> ConfigParseError
forall x. ConfigParseError -> Rep ConfigParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigParseError x -> ConfigParseError
$cfrom :: forall x. ConfigParseError -> Rep ConfigParseError x
Generic)
  deriving (Int -> ConfigParseError -> ShowS
[ConfigParseError] -> ShowS
ConfigParseError -> String
(Int -> ConfigParseError -> ShowS)
-> (ConfigParseError -> String)
-> ([ConfigParseError] -> ShowS)
-> Show ConfigParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigParseError] -> ShowS
$cshowList :: [ConfigParseError] -> ShowS
show :: ConfigParseError -> String
$cshow :: ConfigParseError -> String
showsPrec :: Int -> ConfigParseError -> ShowS
$cshowsPrec :: Int -> ConfigParseError -> ShowS
Show) via PrettyShow ConfigParseError
  deriving anyclass (Show ConfigParseError
Typeable ConfigParseError
Typeable ConfigParseError
-> Show ConfigParseError
-> (ConfigParseError -> SomeException)
-> (SomeException -> Maybe ConfigParseError)
-> (ConfigParseError -> String)
-> Exception ConfigParseError
SomeException -> Maybe ConfigParseError
ConfigParseError -> String
ConfigParseError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ConfigParseError -> String
$cdisplayException :: ConfigParseError -> String
fromException :: SomeException -> Maybe ConfigParseError
$cfromException :: SomeException -> Maybe ConfigParseError
toException :: ConfigParseError -> SomeException
$ctoException :: ConfigParseError -> SomeException
$cp2Exception :: Show ConfigParseError
$cp1Exception :: Typeable ConfigParseError
Exception)

instance Pretty ConfigParseError where
  pretty :: ConfigParseError -> Doc ann
pretty ConfigParseError {[TomlDecodeError]
TomlFile
errors :: [TomlDecodeError]
file :: TomlFile
$sel:errors:ConfigParseError :: ConfigParseError -> [TomlDecodeError]
$sel:file:ConfigParseError :: ConfigParseError -> TomlFile
..} =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ [i|failed to parse #{file}:|],
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
mkBulletList ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (TomlDecodeError -> Doc ann) -> [TomlDecodeError] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann)
-> (TomlDecodeError -> Text) -> TomlDecodeError -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TomlDecodeError -> Text
prettyTomlDecodeError) [TomlDecodeError]
errors
      ]

data MustacheError
  = forall a. RenderingError (Path Rel a) Bool [SubstitutionError]
  | forall a. TemplateParseError (Path Rel a) Bool Text
  deriving (Int -> MustacheError -> ShowS
[MustacheError] -> ShowS
MustacheError -> String
(Int -> MustacheError -> ShowS)
-> (MustacheError -> String)
-> ([MustacheError] -> ShowS)
-> Show MustacheError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MustacheError] -> ShowS
$cshowList :: [MustacheError] -> ShowS
show :: MustacheError -> String
$cshow :: MustacheError -> String
showsPrec :: Int -> MustacheError -> ShowS
$cshowsPrec :: Int -> MustacheError -> ShowS
Show) via PrettyShow MustacheError
  deriving anyclass (Show MustacheError
Typeable MustacheError
Typeable MustacheError
-> Show MustacheError
-> (MustacheError -> SomeException)
-> (SomeException -> Maybe MustacheError)
-> (MustacheError -> String)
-> Exception MustacheError
SomeException -> Maybe MustacheError
MustacheError -> String
MustacheError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: MustacheError -> String
$cdisplayException :: MustacheError -> String
fromException :: SomeException -> Maybe MustacheError
$cfromException :: SomeException -> Maybe MustacheError
toException :: MustacheError -> SomeException
$ctoException :: MustacheError -> SomeException
$cp2Exception :: Show MustacheError
$cp1Exception :: Typeable MustacheError
Exception)

instance Pretty MustacheError where
  pretty :: MustacheError -> Doc ann
pretty MustacheError
e
    | (RenderingError Path Rel a
p Bool
isFilename [SubstitutionError]
errors) <- MustacheError
e =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ [i|failed to substitute the #{s isFilename} of file #{toFilePath p}:|],
          Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
mkBulletList ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (SubstitutionError -> Doc ann) -> [SubstitutionError] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map SubstitutionError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow [SubstitutionError]
errors
        ]
    | (TemplateParseError Path Rel a
p Bool
isFilename Text
err) <- MustacheError
e =
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
        [ [i|failed to parse the #{s isFilename} of file #{toFilePath p}:|],
          Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
err
        ]
    where
      s :: Bool -> String
      s :: Bool -> String
s Bool
True = String
"filename"
      s Bool
False = String
"contents"

data IllformedPath
  = TemplateName Text
  | ProjectName Text
  | forall a. TemplateFile (Path Rel a) Text
  deriving (Int -> IllformedPath -> ShowS
[IllformedPath] -> ShowS
IllformedPath -> String
(Int -> IllformedPath -> ShowS)
-> (IllformedPath -> String)
-> ([IllformedPath] -> ShowS)
-> Show IllformedPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IllformedPath] -> ShowS
$cshowList :: [IllformedPath] -> ShowS
show :: IllformedPath -> String
$cshow :: IllformedPath -> String
showsPrec :: Int -> IllformedPath -> ShowS
$cshowsPrec :: Int -> IllformedPath -> ShowS
Show) via PrettyShow IllformedPath
  deriving anyclass (Show IllformedPath
Typeable IllformedPath
Typeable IllformedPath
-> Show IllformedPath
-> (IllformedPath -> SomeException)
-> (SomeException -> Maybe IllformedPath)
-> (IllformedPath -> String)
-> Exception IllformedPath
SomeException -> Maybe IllformedPath
IllformedPath -> String
IllformedPath -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: IllformedPath -> String
$cdisplayException :: IllformedPath -> String
fromException :: SomeException -> Maybe IllformedPath
$cfromException :: SomeException -> Maybe IllformedPath
toException :: IllformedPath -> SomeException
$ctoException :: IllformedPath -> SomeException
$cp2Exception :: Show IllformedPath
$cp1Exception :: Typeable IllformedPath
Exception)

instance Pretty IllformedPath where
  pretty :: IllformedPath -> Doc ann
pretty (TemplateName Text
s) =
    [i|illformed template name "#{s}" (there should be no slashes in template names)|]
  pretty (ProjectName Text
s) =
    [i|illformed project name "#{s}" (there should be no slashes in project names)|]
  pretty (TemplateFile Path Rel a
p Text
f) =
    [i|file "#{toFilePath p}"" has illformed name "#{f}" after substitution|]

newtype TemplateNotFound
  = TemplateNotFound Text
  deriving (TemplateNotFound -> TemplateNotFound -> Bool
(TemplateNotFound -> TemplateNotFound -> Bool)
-> (TemplateNotFound -> TemplateNotFound -> Bool)
-> Eq TemplateNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TemplateNotFound -> TemplateNotFound -> Bool
$c/= :: TemplateNotFound -> TemplateNotFound -> Bool
== :: TemplateNotFound -> TemplateNotFound -> Bool
$c== :: TemplateNotFound -> TemplateNotFound -> Bool
Eq, (forall x. TemplateNotFound -> Rep TemplateNotFound x)
-> (forall x. Rep TemplateNotFound x -> TemplateNotFound)
-> Generic TemplateNotFound
forall x. Rep TemplateNotFound x -> TemplateNotFound
forall x. TemplateNotFound -> Rep TemplateNotFound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TemplateNotFound x -> TemplateNotFound
$cfrom :: forall x. TemplateNotFound -> Rep TemplateNotFound x
Generic)
  deriving (Int -> TemplateNotFound -> ShowS
[TemplateNotFound] -> ShowS
TemplateNotFound -> String
(Int -> TemplateNotFound -> ShowS)
-> (TemplateNotFound -> String)
-> ([TemplateNotFound] -> ShowS)
-> Show TemplateNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TemplateNotFound] -> ShowS
$cshowList :: [TemplateNotFound] -> ShowS
show :: TemplateNotFound -> String
$cshow :: TemplateNotFound -> String
showsPrec :: Int -> TemplateNotFound -> ShowS
$cshowsPrec :: Int -> TemplateNotFound -> ShowS
Show) via PrettyShow TemplateNotFound
  deriving anyclass (Show TemplateNotFound
Typeable TemplateNotFound
Typeable TemplateNotFound
-> Show TemplateNotFound
-> (TemplateNotFound -> SomeException)
-> (SomeException -> Maybe TemplateNotFound)
-> (TemplateNotFound -> String)
-> Exception TemplateNotFound
SomeException -> Maybe TemplateNotFound
TemplateNotFound -> String
TemplateNotFound -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: TemplateNotFound -> String
$cdisplayException :: TemplateNotFound -> String
fromException :: SomeException -> Maybe TemplateNotFound
$cfromException :: SomeException -> Maybe TemplateNotFound
toException :: TemplateNotFound -> SomeException
$ctoException :: TemplateNotFound -> SomeException
$cp2Exception :: Show TemplateNotFound
$cp1Exception :: Typeable TemplateNotFound
Exception)

instance Pretty TemplateNotFound where
  pretty :: TemplateNotFound -> Doc ann
pretty (TemplateNotFound Text
t) =
    [i|template #{t} not found in both bundled templates and local templates|]

newtype ProjectAlreadExist
  = ProjectAlreadExist Text
  deriving (ProjectAlreadExist -> ProjectAlreadExist -> Bool
(ProjectAlreadExist -> ProjectAlreadExist -> Bool)
-> (ProjectAlreadExist -> ProjectAlreadExist -> Bool)
-> Eq ProjectAlreadExist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectAlreadExist -> ProjectAlreadExist -> Bool
$c/= :: ProjectAlreadExist -> ProjectAlreadExist -> Bool
== :: ProjectAlreadExist -> ProjectAlreadExist -> Bool
$c== :: ProjectAlreadExist -> ProjectAlreadExist -> Bool
Eq, (forall x. ProjectAlreadExist -> Rep ProjectAlreadExist x)
-> (forall x. Rep ProjectAlreadExist x -> ProjectAlreadExist)
-> Generic ProjectAlreadExist
forall x. Rep ProjectAlreadExist x -> ProjectAlreadExist
forall x. ProjectAlreadExist -> Rep ProjectAlreadExist x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectAlreadExist x -> ProjectAlreadExist
$cfrom :: forall x. ProjectAlreadExist -> Rep ProjectAlreadExist x
Generic)
  deriving (Int -> ProjectAlreadExist -> ShowS
[ProjectAlreadExist] -> ShowS
ProjectAlreadExist -> String
(Int -> ProjectAlreadExist -> ShowS)
-> (ProjectAlreadExist -> String)
-> ([ProjectAlreadExist] -> ShowS)
-> Show ProjectAlreadExist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectAlreadExist] -> ShowS
$cshowList :: [ProjectAlreadExist] -> ShowS
show :: ProjectAlreadExist -> String
$cshow :: ProjectAlreadExist -> String
showsPrec :: Int -> ProjectAlreadExist -> ShowS
$cshowsPrec :: Int -> ProjectAlreadExist -> ShowS
Show) via PrettyShow ProjectAlreadExist
  deriving anyclass (Show ProjectAlreadExist
Typeable ProjectAlreadExist
Typeable ProjectAlreadExist
-> Show ProjectAlreadExist
-> (ProjectAlreadExist -> SomeException)
-> (SomeException -> Maybe ProjectAlreadExist)
-> (ProjectAlreadExist -> String)
-> Exception ProjectAlreadExist
SomeException -> Maybe ProjectAlreadExist
ProjectAlreadExist -> String
ProjectAlreadExist -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ProjectAlreadExist -> String
$cdisplayException :: ProjectAlreadExist -> String
fromException :: SomeException -> Maybe ProjectAlreadExist
$cfromException :: SomeException -> Maybe ProjectAlreadExist
toException :: ProjectAlreadExist -> SomeException
$ctoException :: ProjectAlreadExist -> SomeException
$cp2Exception :: Show ProjectAlreadExist
$cp1Exception :: Typeable ProjectAlreadExist
Exception)

instance Pretty ProjectAlreadExist where
  pretty :: ProjectAlreadExist -> Doc ann
pretty (ProjectAlreadExist Text
a) =
    [i|project #{a} already exists, to overwrite it use -f/--force|]

newtype VcsCmdNotFound = VcsCmdNotFound VCS
  deriving (VcsCmdNotFound -> VcsCmdNotFound -> Bool
(VcsCmdNotFound -> VcsCmdNotFound -> Bool)
-> (VcsCmdNotFound -> VcsCmdNotFound -> Bool) -> Eq VcsCmdNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VcsCmdNotFound -> VcsCmdNotFound -> Bool
$c/= :: VcsCmdNotFound -> VcsCmdNotFound -> Bool
== :: VcsCmdNotFound -> VcsCmdNotFound -> Bool
$c== :: VcsCmdNotFound -> VcsCmdNotFound -> Bool
Eq, (forall x. VcsCmdNotFound -> Rep VcsCmdNotFound x)
-> (forall x. Rep VcsCmdNotFound x -> VcsCmdNotFound)
-> Generic VcsCmdNotFound
forall x. Rep VcsCmdNotFound x -> VcsCmdNotFound
forall x. VcsCmdNotFound -> Rep VcsCmdNotFound x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VcsCmdNotFound x -> VcsCmdNotFound
$cfrom :: forall x. VcsCmdNotFound -> Rep VcsCmdNotFound x
Generic)
  deriving (Int -> VcsCmdNotFound -> ShowS
[VcsCmdNotFound] -> ShowS
VcsCmdNotFound -> String
(Int -> VcsCmdNotFound -> ShowS)
-> (VcsCmdNotFound -> String)
-> ([VcsCmdNotFound] -> ShowS)
-> Show VcsCmdNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VcsCmdNotFound] -> ShowS
$cshowList :: [VcsCmdNotFound] -> ShowS
show :: VcsCmdNotFound -> String
$cshow :: VcsCmdNotFound -> String
showsPrec :: Int -> VcsCmdNotFound -> ShowS
$cshowsPrec :: Int -> VcsCmdNotFound -> ShowS
Show) via PrettyShow VcsCmdNotFound
  deriving anyclass (Show VcsCmdNotFound
Typeable VcsCmdNotFound
Typeable VcsCmdNotFound
-> Show VcsCmdNotFound
-> (VcsCmdNotFound -> SomeException)
-> (SomeException -> Maybe VcsCmdNotFound)
-> (VcsCmdNotFound -> String)
-> Exception VcsCmdNotFound
SomeException -> Maybe VcsCmdNotFound
VcsCmdNotFound -> String
VcsCmdNotFound -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: VcsCmdNotFound -> String
$cdisplayException :: VcsCmdNotFound -> String
fromException :: SomeException -> Maybe VcsCmdNotFound
$cfromException :: SomeException -> Maybe VcsCmdNotFound
toException :: VcsCmdNotFound -> SomeException
$ctoException :: VcsCmdNotFound -> SomeException
$cp2Exception :: Show VcsCmdNotFound
$cp1Exception :: Typeable VcsCmdNotFound
Exception)

instance Pretty VcsCmdNotFound where
  pretty :: VcsCmdNotFound -> Doc ann
pretty (VcsCmdNotFound VCS
vcs) =
    [i|vcs tool #{vcs} was not installed even though it was specified in your config|]

data ProcessExitFailure
  = ProcessExitFailure CmdSpec Int String String
  deriving (ProcessExitFailure -> ProcessExitFailure -> Bool
(ProcessExitFailure -> ProcessExitFailure -> Bool)
-> (ProcessExitFailure -> ProcessExitFailure -> Bool)
-> Eq ProcessExitFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessExitFailure -> ProcessExitFailure -> Bool
$c/= :: ProcessExitFailure -> ProcessExitFailure -> Bool
== :: ProcessExitFailure -> ProcessExitFailure -> Bool
$c== :: ProcessExitFailure -> ProcessExitFailure -> Bool
Eq, (forall x. ProcessExitFailure -> Rep ProcessExitFailure x)
-> (forall x. Rep ProcessExitFailure x -> ProcessExitFailure)
-> Generic ProcessExitFailure
forall x. Rep ProcessExitFailure x -> ProcessExitFailure
forall x. ProcessExitFailure -> Rep ProcessExitFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProcessExitFailure x -> ProcessExitFailure
$cfrom :: forall x. ProcessExitFailure -> Rep ProcessExitFailure x
Generic)
  deriving (Int -> ProcessExitFailure -> ShowS
[ProcessExitFailure] -> ShowS
ProcessExitFailure -> String
(Int -> ProcessExitFailure -> ShowS)
-> (ProcessExitFailure -> String)
-> ([ProcessExitFailure] -> ShowS)
-> Show ProcessExitFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessExitFailure] -> ShowS
$cshowList :: [ProcessExitFailure] -> ShowS
show :: ProcessExitFailure -> String
$cshow :: ProcessExitFailure -> String
showsPrec :: Int -> ProcessExitFailure -> ShowS
$cshowsPrec :: Int -> ProcessExitFailure -> ShowS
Show) via PrettyShow ProcessExitFailure
  deriving anyclass (Show ProcessExitFailure
Typeable ProcessExitFailure
Typeable ProcessExitFailure
-> Show ProcessExitFailure
-> (ProcessExitFailure -> SomeException)
-> (SomeException -> Maybe ProcessExitFailure)
-> (ProcessExitFailure -> String)
-> Exception ProcessExitFailure
SomeException -> Maybe ProcessExitFailure
ProcessExitFailure -> String
ProcessExitFailure -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ProcessExitFailure -> String
$cdisplayException :: ProcessExitFailure -> String
fromException :: SomeException -> Maybe ProcessExitFailure
$cfromException :: SomeException -> Maybe ProcessExitFailure
toException :: ProcessExitFailure -> SomeException
$ctoException :: ProcessExitFailure -> SomeException
$cp2Exception :: Show ProcessExitFailure
$cp1Exception :: Typeable ProcessExitFailure
Exception)

instance Pretty ProcessExitFailure where
  pretty :: ProcessExitFailure -> Doc ann
pretty (ProcessExitFailure CmdSpec
cmd Int
e String
out String
err) =
    [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      [ [i|process "#{prettyCmd cmd}" failed with exit code #{e}|],
        Doc ann
"stdout:",
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
out,
        Doc ann
"stderr:",
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
err
      ]
    where
      prettyCmd :: CmdSpec -> String
prettyCmd (ShellCommand String
c) = String
c
      prettyCmd (RawCommand String
c [String]
args) = [String] -> String
unwords (String
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args)

prettyPrintError :: Has Terminal sig m => Doc AnsiStyle -> m ()
prettyPrintError :: Doc AnsiStyle -> m ()
prettyPrintError Doc AnsiStyle
err = Handle -> Doc AnsiStyle -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
Handle -> Doc AnsiStyle -> m ()
prettyPrint Handle
stderr Doc AnsiStyle
doc
  where
    doc :: Doc AnsiStyle
doc = (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red) Doc AnsiStyle
"Error" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
":") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
err

prettyPrintWarning :: Has Terminal sig m => Doc AnsiStyle -> m ()
prettyPrintWarning :: Doc AnsiStyle -> m ()
prettyPrintWarning Doc AnsiStyle
warning = Handle -> Doc AnsiStyle -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
Handle -> Doc AnsiStyle -> m ()
prettyPrint Handle
stderr Doc AnsiStyle
doc
  where
    doc :: Doc AnsiStyle
doc = (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow) Doc AnsiStyle
"Warning" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
":") Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
warning

simpleHandler :: (Has Terminal sig m, Has (Lift IO) sig m, Pretty a) => a -> m ()
simpleHandler :: a -> m ()
simpleHandler a
a = do
  Doc AnsiStyle -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type).
Has Terminal sig m =>
Doc AnsiStyle -> m ()
prettyPrintError (Doc AnsiStyle -> m ()) -> Doc AnsiStyle -> m ()
forall a b. (a -> b) -> a -> b
$ a -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty a
a
  IO () -> m ()
forall (sig :: (Type -> Type) -> Type -> Type) (m :: Type -> Type)
       a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO ()
forall a. IO a
exitFailure