From 47f9ef33a45545cb312b5aa956da40ac2de2c99e Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Thu, 16 Jan 2020 22:21:23 +1300
Subject: [PATCH] Improve error reporting & it's localization

---
 hurl.cabal                  |  4 ++--
 src/Network/URI/Charset.hs  | 22 +++++++++++++---------
 src/Network/URI/Fetch.hs    |  4 +++-
 src/Network/URI/Locale.hs   |  8 +++++++-
 src/Network/URI/Messages.hs | 18 ++++++++++++++++++
 5 files changed, 43 insertions(+), 13 deletions(-)
 create mode 100644 src/Network/URI/Messages.hs

diff --git a/hurl.cabal b/hurl.cabal
index e3c8581..a511c0b 100644
--- a/hurl.cabal
+++ b/hurl.cabal
@@ -10,7 +10,7 @@ name:                hurl
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.1.0.0
+version:             1.0.0.0
 
 -- A short (one-line) description of the package.
 synopsis:            Haskell URL resolver
@@ -72,7 +72,7 @@ library
   exposed-modules:     Network.URI.Charset, Network.URI.Fetch
   
   -- Modules included in this library but not exported.
-  other-modules:       Network.URI.Locale
+  other-modules:       Network.URI.Locale, Network.URI.Messages, Network.URI.XDG.Ini
   
   -- LANGUAGE extensions used by modules in this package.
   -- other-extensions:    
diff --git a/src/Network/URI/Charset.hs b/src/Network/URI/Charset.hs
index c1b898d..da98afb 100644
--- a/src/Network/URI/Charset.hs
+++ b/src/Network/URI/Charset.hs
@@ -6,6 +6,7 @@ import           Data.Text (Text)
 import           Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as B
 import           Data.Text.Encoding
+import           Debug.Trace (trace)
 
 -- | If the MIMEtype specifies a charset parameter, apply it.
 resolveCharset :: [String] -- ^ The MIMEtype, split by ';'
@@ -20,15 +21,18 @@ resolveCharset [] response = ("text/plain", Left "Filetype unspecified")
 -- | Decodes bytes according to a charset identified by it's IANA-assigned name(s).
 convertCharset "iso-8859-1" = decodeLatin1
 convertCharset "latin1" = decodeLatin1
-convertCharset "us-ascii" = decodeUtf8
-convertCharset "utf-8" = decodeUtf8
-convertCharset "utf-16be" = decodeUtf16BE
-convertCharset "utf-16le" = decodeUtf16LE
-convertCharset "utf-16" = decodeUtf16LE
-convertCharset "utf-32be" = decodeUtf32BE
-convertCharset "utf-32le" = decodeUtf32LE
-convertCharset "utf-32" = decodeUtf32LE
-convertCharset _ = \_ -> "Unsupported text encoding!" -- TODO localize? Should I?
+convertCharset "us-ascii" = decodeUtf8With replaceChar
+convertCharset "utf-8" = decodeUtf8With replaceChar
+convertCharset "utf-16be" = decodeUtf16BEWith replaceChar
+convertCharset "utf-16le" = decodeUtf16LEWith replaceChar
+convertCharset "utf-16" = decodeUtf16LEWith replaceChar
+convertCharset "utf-32be" = decodeUtf32BEWith replaceChar
+convertCharset "utf-32le" = decodeUtf32LEWith replaceChar
+convertCharset "utf-32" = decodeUtf32LEWith replaceChar
+convertCharset charset = -- FIXME Is this the best fallback for unsupported charsets?
+    trace ("Unsupported text encoding" ++ charset) $ decodeUtf8With replaceChar
+
+replaceChar error _ = trace error $ Just '�'
 
 -- | Lists all charsets supported by convertCharset
 charsets :: [Text]
diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index da54b02..f8fdde2 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -24,6 +24,7 @@ import qualified Data.ByteString.Base64 as B64
 #endif
 
 import Network.URI.Locale
+import Network.URI.Messages
 
 -- | Data shared accross multiple URI requests.
 data Session = Session {
@@ -92,7 +93,8 @@ fetchURL _ (defaultMIME:_) uri@URI {uriScheme = "data:"} =
         (mime, response) -> return (mime, Left $ Txt.pack response)
 #endif
 
-fetchURL _ _ uri = return ("text/plain", Left $ Txt.concat ["Unsupported link type ", Txt.pack $ uriScheme uri])
+fetchURL Session {locale = l} _ URI {uriScheme = scheme} =
+    return ("text/plain", Left $ Txt.pack $ trans l $ UnsupportedScheme scheme)
 
 #ifdef WITH_DATA_URI
 breakOn c (a:as) | c == a = ([], as)
diff --git a/src/Network/URI/Locale.hs b/src/Network/URI/Locale.hs
index 3e3f59b..d78df0e 100644
--- a/src/Network/URI/Locale.hs
+++ b/src/Network/URI/Locale.hs
@@ -14,7 +14,8 @@ import Data.Char (toLower)
 rfc2616Locale :: IO [String]
 rfc2616Locale = do
     locales <- forM ["LANGUAGE", "LC_ALL", "LC_MESSAGES", "LANG"] lookupEnv
-    return $ mapMaybe toRFC2616Lang $ split ':' $ firstJust locales "en_US"
+    let locales' = mapMaybe toRFC2616Lang $ split ':' $ firstJust locales "en_US"
+    return (locales' ++ [l | l <- extractLangs locales', l `notElem` locales'])
 
 toRFC2616Lang "C" = Nothing
 toRFC2616Lang ('C':'.':_) = Nothing
@@ -29,6 +30,11 @@ toRFC2616Lang' ('@':_) = []
 toRFC2616Lang' (c:cs) = toLower c : toRFC2616Lang' cs
 toRFC2616Lang' [] = []
 
+-- Makes sure to include the raw languages, and not just localized variants.
+extractLangs (locale:locales) | (lang:_) <- split '-' locale = lang : extractLangs locales
+extractLangs (_:locales) = extractLangs locales
+extractLangs [] = []
+
 firstJust (Just a:_) _ | a /= "" = a
 firstJust (_:maybes) fallback = firstJust maybes fallback
 firstJust [] fallback = fallback
diff --git a/src/Network/URI/Messages.hs b/src/Network/URI/Messages.hs
new file mode 100644
index 0000000..3fbdcf1
--- /dev/null
+++ b/src/Network/URI/Messages.hs
@@ -0,0 +1,18 @@
+-- | 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.
+module Network.URI.Messages (trans, Errors(..)) where
+
+--- BEGIN LOCALIZATION
+trans ("en":_) (UnsupportedScheme scheme) = "Unsupported protocol " ++ scheme
+--- END LOCALIZATION
+
+trans (_:locales) err = trans locales err
+trans [] err = trans ["en"] err
+
+data Errors = UnsupportedScheme String
-- 
2.30.2