content: {-# LANGUAGE NoImplicitPrelude     #-}
  {-# LANGUAGE OverloadedStrings     #-}
  {-# LANGUAGE TypeFamilies          #-}
  
  {-|
  Module      : Stack.Types.Config.Exception
  License     : BSD-3-Clause
  -}
  
  module Stack.Types.Config.Exception
    ( ConfigException (..)
    , ConfigPrettyException (..)
    , ParseAbsolutePathException (..)
    ) where
  
  import qualified Data.Text as T
  import           Data.Yaml ( ParseException )
  import qualified Data.Yaml as Yaml
  import           Distribution.System ( Arch )
  import           Path( dirname, filename )
  import           Stack.Prelude
  import           Stack.Types.ConfigMonoid
                     ( configMonoidAllowDifferentUserName
                     , configMonoidGHCVariantName, configMonoidSystemGHCName
                     )
  import           Stack.Types.MsysEnvironment ( MsysEnvironment )
  import           Stack.Types.Version
                     ( VersionRange, stackVersion, versionRangeText )
  
  -- | Type representing exceptions thrown by functions exported by the
  -- "Stack.Config" module.
  data ConfigException
    = ParseCustomSnapshotException Text ParseException
    | NoProjectConfigFound (Path Abs Dir) (Maybe Text)
    | UnexpectedArchiveContents [Path Abs Dir] [Path Abs File]
    | UnableToExtractArchive Text (Path Abs File)
    | BadStackVersionException VersionRange
    | NoSuchDirectory FilePath
    | NoSuchFile FilePath
    | ParseGHCVariantException String
    | BadStackRoot (Path Abs Dir)
    | Won'tCreateStackRootInDirectoryOwnedByDifferentUser
        (Path Abs Dir)
        (Path Abs Dir)
      -- ^ @$STACK_ROOT@, parent dir
    | UserDoesn'tOwnDirectory (Path Abs Dir)
    | ManualGHCVariantSettingsAreIncompatibleWithSystemGHC
    | NixRequiresSystemGhc
    | NoSnapshotWhenUsingNoProject
    | NoLTSWithMajorVersion Int
    | NoLTSFound
    deriving Show
  
  instance Exception ConfigException where
    displayException (ParseCustomSnapshotException url exception) = concat
      [ "Error: [S-8981]\n"
      , "Could not parse '"
      , T.unpack url
      , "':\n"
      , Yaml.prettyPrintParseException exception
      , "\nSee https://docs.haskellstack.org/en/stable/topics/custom_snapshot/"
      ]
    displayException (NoProjectConfigFound dir mcmd) = concat
      [ "Error: [S-2206]\n"
      , "Unable to find a stack.yaml file in the current directory ("
      , toFilePath dir
      , ") or its ancestors"
      , case mcmd of
          Nothing -> ""
          Just cmd -> "\nRecommended action: stack " ++ T.unpack cmd
      ]
    displayException (UnexpectedArchiveContents dirs files) = concat
      [ "Error: [S-4964]\n"
      , "When unpacking an archive specified in your stack.yaml file, "
      , "did not find expected contents. Expected: a single directory. Found: "
      , show ( map (toFilePath . dirname) dirs
             , map (toFilePath . filename) files
             )
      ]
    displayException (UnableToExtractArchive url file) = concat
      [ "Error: [S-2040]\n"
      , "Archive extraction failed. Tarballs and zip archives are supported, \
        \couldn't handle the following URL, "
      , T.unpack url
      , " downloaded to the file "
      , toFilePath $ filename file
      ]
    displayException (BadStackVersionException requiredRange) = concat
      [ "Error: [S-1641]\n"
      , "The version of Stack you are using ("
      , show stackVersion
      , ") is outside the required\n"
      ,"version range specified in stack.yaml ("
      , T.unpack (versionRangeText requiredRange)
      , ").\n"
      , "You can upgrade Stack by running:\n\n"
      , "stack upgrade"
      ]
    displayException (NoSuchDirectory dir) = concat
      [ "Error: [S-8773]\n"
      , "No directory could be located matching the supplied path: "
      , dir
      ]
    displayException (NoSuchFile file) = concat
      [ "Error: [S-4335]\n"
      , "No file could be located matching the supplied path: "
      , file
      ]
    displayException (ParseGHCVariantException v) = concat
      [ "Error: [S-3938]\n"
      , "Invalid ghc-variant value: "
      , v
      ]
    displayException (BadStackRoot stackRoot) = concat
      [ "Error: [S-8530]\n"
      , "Invalid Stack root: '"
      , toFilePath stackRoot
      , "'. Please provide a valid absolute path."
      ]
    displayException (Won'tCreateStackRootInDirectoryOwnedByDifferentUser envStackRoot parentDir) = concat
      [ "Error: [S-7613]\n"
      , "Preventing creation of Stack root '"
      , toFilePath envStackRoot
      , "'. Parent directory '"
      , toFilePath parentDir
      , "' is owned by someone else."
      ]
    displayException (UserDoesn'tOwnDirectory dir) = concat
      [ "Error: [S-8707]\n"
      , "You are not the owner of '"
      , toFilePath dir
      , "'. Aborting to protect file permissions."
      , "\nRetry with '--"
      , T.unpack configMonoidAllowDifferentUserName
      , "' to disable this precaution."
      ]
    displayException ManualGHCVariantSettingsAreIncompatibleWithSystemGHC = T.unpack $ T.concat
      [ "Error: [S-3605]\n"
      , "Stack can only control the "
      , configMonoidGHCVariantName
      , " of its own GHC installations. Please use '--no-"
      , configMonoidSystemGHCName
      , "'."
      ]
    displayException NixRequiresSystemGhc = T.unpack $ T.concat
      [ "Error: [S-6816]\n"
      , "Stack's Nix integration is incompatible with '--no-system-ghc'. "
      , "Please use '--"
      , configMonoidSystemGHCName
      , "' or disable the Nix integration."
      ]
    displayException NoSnapshotWhenUsingNoProject =
      "Error: [S-5027]\n"
      ++ "When using the script command, you must provide a snapshot argument"
    displayException (NoLTSWithMajorVersion n) = concat
      [ "Error: [S-3803]\n"
      , "No LTS release found with major version "
      , show n
      , "."
      ]
    displayException NoLTSFound =
      "Error: [S-5472]\n"
      ++ "No LTS releases found."
  
  -- | Type representing \'pretty\' exceptions thrown by functions exported by the
  -- "Stack.Config" module.
  data ConfigPrettyException
    = ParseConfigFileException !(Path Abs File) !ParseException
    | StackWorkEnvNotRelativeDir !String
    | DuplicateLocalPackageNames ![(PackageName, [PackageLocation])]
    | BadMsysEnvironment !MsysEnvironment !Arch
    | NoMsysEnvironmentBug
    | ConfigFileNotProjectLevelBug
    | NoExecutablePath !String
    deriving Show
  
  instance Pretty ConfigPrettyException where
    pretty (ParseConfigFileException configFile exception) =
      "[S-6602]"
      <> line
      <> fillSep
           [ flow "Stack could not load and parse"
           , pretty configFile
           , flow "as a configuraton file."
           ]
      <> blankLine
      <> flow "While loading and parsing, Stack encountered the following \
              \error:"
      <> blankLine
      <> string (Yaml.prettyPrintParseException exception)
      <> blankLine
      <> fillSep
           [ flow "For help about the content of Stack's configuration files, \
                  \see (for the most recent release of Stack)"
           ,    style
                  Url
                  "http://docs.haskellstack.org/en/stable/configure/yaml/"
             <> "."
           ]
    pretty (StackWorkEnvNotRelativeDir x) =
      "[S-7462]"
      <> line
      <> flow "Stack failed to interpret the value of the STACK_WORK \
              \environment variable as a valid relative path to a directory. \
              \Stack will not accept an absolute path. A path containing a \
              \.. (parent directory) component is not valid."
      <> blankLine
      <> fillSep
           [ flow "If set, Stack expects the value to identify the location \
                  \of Stack's work directory, relative to the root directory \
                  \of the project or package. Stack encountered the value:"
           , style Error (fromString x) <> "."
           ]
    pretty (DuplicateLocalPackageNames pairs) =
      "[S-5470]"
      <> line
      <> fillSep
           [ flow "The same package name is used in more than one project \
                  \package or"
           , style Shell "extra-deps" <> "."
           ]
      <> mconcat (map go pairs)
     where
      go (name, dirs) =
           blankLine
        <> fillSep
             [ style Error (fromPackageName name)
             , flow "used in:"
             ]
        <> line
        <> bulletedList (map (fromString . T.unpack . textDisplay) dirs)
    pretty (BadMsysEnvironment msysEnv arch) =
      "[S-6854]"
      <> line
      <> fillSep
           [ flow "The specified MSYS2 environment"
           , style Error (fromString $ show msysEnv)
           , flow "is not consistent with the architecture"
           , fromString (show arch) <> "."
           ]
    pretty NoMsysEnvironmentBug = bugPrettyReport "[S-5006]" $
      flow "No default MSYS2 environment."
    pretty ConfigFileNotProjectLevelBug = bugPrettyReport "[S-8398]" $
      flow "The configuration file is not a project-level one."
    pretty (NoExecutablePath progName) =
      "[S-6890]"
      <> line
      <> fillSep
           [ flow "The path for the executable file invoked as"
           , style Shell (fromString progName)
           , flow "can not be identified."
           ]
  
  instance Exception ConfigPrettyException
  
  -- | Type representing an exception thrown by functions exported by the
  -- "Stack.Config" module.
  data ParseAbsolutePathException
    = ParseAbsolutePathException String String
    deriving Show
  
  instance Exception ParseAbsolutePathException where
    displayException (ParseAbsolutePathException envVar dir) = concat
      [ "Error: [S-9437]\n"
      , "Failed to parse "
      , envVar
      , " environment variable (expected absolute directory): "
      , dir
      ]
  