{-# LANGUAGE CPP #-}
-- | Module holding localized error messages to be presented as a response.
--
-- To localize error messages provided by HURL, provide your translations between
-- "BEGIN LOCALIZATION" & "END LOCALIZATION" in this file.
--
-- The lines are formatted:
--    trans ("LANG":_) (KEY) = "TRANSLATION"
-- with uppercase indicating the bits you fill in.
--
-- Translations between #if WITH_HTTP_URI & #endif are specific to HTTP error handling.
module Network.URI.Messages (trans, Errors(..)) where

import Data.List (stripPrefix)
import Data.Maybe (fromMaybe)

#if WITH_HTTP_URI
import Network.HTTP.Client (HttpException(..), HttpExceptionContent(..))
import Control.Exception (displayException)
#endif

trans :: [[Char]] -> Errors -> [Char]
trans [[Char]]
_ (RawXML [Char]
markup) = [Char]
markup
--- BEGIN LOCALIZATION
trans ([Char]
"en":[[Char]]
_) (UnsupportedScheme [Char]
scheme) = [Char]
"Unsupported protocol " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
scheme
trans ([Char]
"en":[[Char]]
_) (UnsupportedMIME [Char]
mime) = [Char]
"Unsupported filetype " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
mime
trans ([Char]
"en":[[Char]]
_) (RequiresInstall [Char]
mime [Char]
appsMarkup) =
    [Char]
"<h1>Please install a compatible app to open <code>" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
linkType [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"</code> links</h1>\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
appsMarkup
  where linkType :: [Char]
linkType = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
mime (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
"x-scheme-handler/" [Char]
mime
trans ([Char]
"en":[[Char]]
_) (OpenedWith [Char]
app) = [Char]
"Opened in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
app
trans ([Char]
"en":[[Char]]
_) (ReadFailed [Char]
msg) = [Char]
"Failed to read file: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
trans ([Char]
"en":[[Char]]
_) Errors
MalformedResponse = [Char]
"Invalid response!"
trans ([Char]
"en":[[Char]]
_) Errors
ExcessiveRedirects = [Char]
"Too many redirects!"
#if WITH_HTTP_URI
trans ([Char]
"en":[[Char]]
_) (Http (InvalidUrlException [Char]
url [Char]
msg)) = [Char]
"Invalid URL " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
url [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
trans ([Char]
"en":[[Char]]
_) (Http (HttpExceptionRequest Request
_ (TooManyRedirects [Response ByteString]
_))) = [Char]
"Too many redirects!"
trans ([Char]
"en":[[Char]]
_) (Http (HttpExceptionRequest Request
_ HttpExceptionContent
ResponseTimeout)) = [Char]
"The site took too long to respond!"
trans ([Char]
"en":[[Char]]
_) (Http (HttpExceptionRequest Request
_ HttpExceptionContent
ConnectionTimeout)) = [Char]
"The site took too long to connect!"
trans ([Char]
"en":[[Char]]
_) (Http (HttpExceptionRequest Request
_ (ConnectionFailure SomeException
err))) = [Char]
"Could not connect: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall e. Exception e => e -> [Char]
displayException SomeException
err
trans ([Char]
"en":[[Char]]
_) (Http (HttpExceptionRequest Request
_ HttpExceptionContent
_)) = [Char]
"The site doesn't appear to speak the same language as me!"
#endif
--- END LOCALIZATION

trans ([Char]
_:[[Char]]
locales) Errors
err = [[Char]] -> Errors -> [Char]
trans [[Char]]
locales Errors
err
trans [] Errors
err = [[Char]] -> Errors -> [Char]
trans [[Char]
"en"] Errors
err

data Errors = UnsupportedScheme String | UnsupportedMIME String | RequiresInstall String String
    | OpenedWith String | ReadFailed String | RawXML String | MalformedResponse
    | ExcessiveRedirects
#if WITH_HTTP_URI
    | Http HttpException
#endif