From 416160b29af9fa04b5dce35c3e2101bcf4cf4748 Mon Sep 17 00:00:00 2001
From: Simon Jakobi <simon.jakobi@gmail.com>
Date: Sun, 17 Nov 2019 04:13:16 +0100
Subject: [PATCH] Fix formatting of POSIX env vars (#1552)

Fixes #1468.
---
 dhall/src/Dhall/Pretty/Internal.hs      | 17 ++++++++++++++++-
 dhall/src/Dhall/Pretty/Internal.hs-boot |  3 +++
 dhall/src/Dhall/Syntax.hs               |  2 +-
 dhall/tests/format/envVarsA.dhall       |  1 +
 dhall/tests/format/envVarsB.dhall       |  1 +
 5 files changed, 22 insertions(+), 2 deletions(-)
 create mode 100644 dhall/tests/format/envVarsA.dhall
 create mode 100644 dhall/tests/format/envVarsB.dhall

diff --git a/dhall/src/Dhall/Pretty/Internal.hs b/dhall/src/Dhall/Pretty/Internal.hs
index 0770093..e4ab7b4 100644
--- a/dhall/src/Dhall/Pretty/Internal.hs
+++ b/dhall/src/Dhall/Pretty/Internal.hs
@@ -21,6 +21,7 @@ module Dhall.Pretty.Internal (
     , prettyVar
     , pretty_
     , escapeText_
+    , prettyEnvironmentVariable
 
     , prettyConst
     , prettyLabel
@@ -409,11 +410,14 @@ alpha c = ('\x41' <= c && c <= '\x5A') || ('\x61' <= c && c <= '\x7A')
 digit :: Char -> Bool
 digit c = '\x30' <= c && c <= '\x39'
 
+alphaNum :: Char -> Bool
+alphaNum c = alpha c || digit c
+
 headCharacter :: Char -> Bool
 headCharacter c = alpha c || c == '_'
 
 tailCharacter :: Char -> Bool
-tailCharacter c = alpha c || digit c || c == '_' || c == '-' || c == '/'
+tailCharacter c = alphaNum c || c == '_' || c == '-' || c == '/'
 
 prettyLabelShared :: Bool -> Text -> Doc Ann
 prettyLabelShared allowReserved a = label doc
@@ -459,6 +463,17 @@ prettyVar :: Var -> Doc Ann
 prettyVar (V x 0) = label (Pretty.unAnnotate (prettyLabel x))
 prettyVar (V x n) = label (Pretty.unAnnotate (prettyLabel x <> "@" <> prettyInt n))
 
+prettyEnvironmentVariable :: Text -> Doc ann
+prettyEnvironmentVariable t
+  | validBashEnvVar t = Pretty.pretty t
+  | otherwise         = Pretty.pretty ("\"" <> escapeText_ t <> "\"")
+  where
+    validBashEnvVar v = case Text.uncons v of
+        Nothing      -> False
+        Just (c, v') ->
+                (alpha c || c == '_')
+            &&  Text.all (\c' -> alphaNum c' || c' == '_') v'
+
 {-  There is a close correspondence between the pretty-printers in 'prettyCharacterSet'
     and the sub-parsers in 'Dhall.Parser.Expression.parsers'.  Most pretty-printers are
     named after the corresponding parser and the relationship between pretty-printers
diff --git a/dhall/src/Dhall/Pretty/Internal.hs-boot b/dhall/src/Dhall/Pretty/Internal.hs-boot
index 88be68f..e51993e 100644
--- a/dhall/src/Dhall/Pretty/Internal.hs-boot
+++ b/dhall/src/Dhall/Pretty/Internal.hs-boot
@@ -1,5 +1,6 @@
 module Dhall.Pretty.Internal where
 
+import Data.Text (Text)
 import Data.Text.Prettyprint.Doc (Pretty, Doc)
 
 import {-# SOURCE #-} Dhall.Syntax
@@ -11,3 +12,5 @@ prettyVar :: Var -> Doc Ann
 prettyConst :: Const -> Doc Ann
 
 prettyExpr :: Pretty a => Expr s a -> Doc Ann
+
+prettyEnvironmentVariable :: Text -> Doc ann
diff --git a/dhall/src/Dhall/Syntax.hs b/dhall/src/Dhall/Syntax.hs
index 9e885c1..5ce30e1 100644
--- a/dhall/src/Dhall/Syntax.hs
+++ b/dhall/src/Dhall/Syntax.hs
@@ -989,7 +989,7 @@ instance Pretty ImportType where
 
     pretty (Remote url) = Pretty.pretty url
 
-    pretty (Env env) = "env:" <> Pretty.pretty env
+    pretty (Env env) = "env:" <> prettyEnvironmentVariable env
 
     pretty Missing = "missing"
 
diff --git a/dhall/tests/format/envVarsA.dhall b/dhall/tests/format/envVarsA.dhall
new file mode 100644
index 0000000..62a59a5
--- /dev/null
+++ b/dhall/tests/format/envVarsA.dhall
@@ -0,0 +1 @@
+[ env:x, env:"1", env:" ", env:"\\", env:"." ]
diff --git a/dhall/tests/format/envVarsB.dhall b/dhall/tests/format/envVarsB.dhall
new file mode 100644
index 0000000..62a59a5
--- /dev/null
+++ b/dhall/tests/format/envVarsB.dhall
@@ -0,0 +1 @@
+[ env:x, env:"1", env:" ", env:"\\", env:"." ]