{-# LANGUAGE LambdaCase #-}
module Hpack.Error (
-- | /__NOTE:__/ This module is exposed to allow integration of Hpack into
-- other tools.  It is not meant for general use by end users.  The following
-- caveats apply:
--
-- * The API is undocumented, consult the source instead.
--
-- * The exposed types and functions primarily serve Hpack's own needs, not
-- that of a public API.  Breaking changes can happen as Hpack evolves.
--
-- As an Hpack user you either want to use the @hpack@ executable or a build
-- tool that supports Hpack (e.g. @stack@ or @cabal2nix@).
  HpackError (..)
, formatHpackError
, ProgramName (..)
, URL
, Status (..)
, formatStatus
) where

import qualified Data.ByteString.Char8 as B
import           Data.List (intercalate)
import           Data.String (IsString (..))
import           Data.Version (Version (..), showVersion)
import           Network.HTTP.Types.Status (Status (..))

type URL = String

data HpackError =
    HpackVersionNotSupported FilePath Version Version
  | DefaultsFileNotFound FilePath
  | DefaultsDownloadFailed URL Status
  | CycleInDefaults [FilePath]
  | ParseError String
  | DecodeValueError FilePath String
  deriving (HpackError -> HpackError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HpackError -> HpackError -> Bool
$c/= :: HpackError -> HpackError -> Bool
== :: HpackError -> HpackError -> Bool
$c== :: HpackError -> HpackError -> Bool
Eq, Int -> HpackError -> ShowS
[HpackError] -> ShowS
HpackError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HpackError] -> ShowS
$cshowList :: [HpackError] -> ShowS
show :: HpackError -> FilePath
$cshow :: HpackError -> FilePath
showsPrec :: Int -> HpackError -> ShowS
$cshowsPrec :: Int -> HpackError -> ShowS
Show)

newtype ProgramName = ProgramName {ProgramName -> FilePath
unProgramName :: String}
  deriving (ProgramName -> ProgramName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProgramName -> ProgramName -> Bool
$c/= :: ProgramName -> ProgramName -> Bool
== :: ProgramName -> ProgramName -> Bool
$c== :: ProgramName -> ProgramName -> Bool
Eq, Int -> ProgramName -> ShowS
[ProgramName] -> ShowS
ProgramName -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProgramName] -> ShowS
$cshowList :: [ProgramName] -> ShowS
show :: ProgramName -> FilePath
$cshow :: ProgramName -> FilePath
showsPrec :: Int -> ProgramName -> ShowS
$cshowsPrec :: Int -> ProgramName -> ShowS
Show)

instance IsString ProgramName where
  fromString :: FilePath -> ProgramName
fromString = FilePath -> ProgramName
ProgramName

formatHpackError :: ProgramName -> HpackError -> String
formatHpackError :: ProgramName -> HpackError -> FilePath
formatHpackError (ProgramName FilePath
progName) = \ case
  HpackVersionNotSupported FilePath
file Version
wanted Version
supported ->
    FilePath
"The file " forall a. [a] -> [a] -> [a]
++ FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
" requires version " forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
wanted forall a. [a] -> [a] -> [a]
++
    FilePath
" of the Hpack package specification, however this version of " forall a. [a] -> [a] -> [a]
++
    FilePath
progName forall a. [a] -> [a] -> [a]
++ FilePath
" only supports versions up to " forall a. [a] -> [a] -> [a]
++ Version -> FilePath
showVersion Version
supported forall a. [a] -> [a] -> [a]
++
    FilePath
". Upgrading to the latest version of " forall a. [a] -> [a] -> [a]
++ FilePath
progName forall a. [a] -> [a] -> [a]
++ FilePath
" may resolve this issue."
  DefaultsFileNotFound FilePath
file -> FilePath
"Invalid value for \"defaults\"! File " forall a. [a] -> [a] -> [a]
++ FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist!"
  DefaultsDownloadFailed FilePath
url Status
status -> FilePath
"Error while downloading " forall a. [a] -> [a] -> [a]
++ FilePath
url forall a. [a] -> [a] -> [a]
++ FilePath
" (" forall a. [a] -> [a] -> [a]
++ Status -> FilePath
formatStatus Status
status forall a. [a] -> [a] -> [a]
++ FilePath
")"
  CycleInDefaults [FilePath]
files -> FilePath
"cycle in defaults (" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" -> " [FilePath]
files forall a. [a] -> [a] -> [a]
++ FilePath
")"
  ParseError FilePath
err -> FilePath
err
  DecodeValueError FilePath
file FilePath
err -> FilePath
file forall a. [a] -> [a] -> [a]
++ FilePath
": " forall a. [a] -> [a] -> [a]
++ FilePath
err

formatStatus :: Status -> String
formatStatus :: Status -> FilePath
formatStatus (Status Int
code ByteString
message) = forall a. Show a => a -> FilePath
show Int
code forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
B.unpack ByteString
message