issue2527 character set data type

dhall-lsp-server/src/Dhall/LSP/Backend/Formatting.hs

@@ -1,32 +1,31 @@
 module Dhall.LSP.Backend.Formatting (formatExpr, formatExprWithHeader) where
 
-import Data.Maybe   (fromMaybe)
 import Data.Text    (Text)
 import Dhall.Core   (Expr)
 import Dhall.Parser (Header (..))
-import Dhall.Pretty (CharacterSet (..))
+import Dhall.Pretty (ChooseCharacterSet (..), chooseCharsetOrUseDefault)
 import Dhall.Src    (Src)
 
 import qualified Dhall.Pretty
 import qualified Prettyprinter             as Pretty
 import qualified Prettyprinter.Render.Text as Pretty
 
 -- | Pretty-print the given Dhall expression.
-formatExpr :: Pretty.Pretty b => Maybe CharacterSet -> Expr Src b -> Text
+formatExpr :: Pretty.Pretty b => ChooseCharacterSet -> Expr Src b -> Text
 formatExpr chosenCharacterSet expr =
       Pretty.renderStrict
     . Dhall.Pretty.layout
     $ Dhall.Pretty.prettyCharacterSet charSet expr
   where
-    charSet = fromMaybe (Dhall.Pretty.detectCharacterSet expr) chosenCharacterSet
+    charSet = chooseCharsetOrUseDefault (Dhall.Pretty.detectCharacterSet expr) chosenCharacterSet
 
 -- | Pretty-print the given Dhall expression, prepending the given a "header"
 --   (usually consisting of comments and whitespace).
-formatExprWithHeader :: Pretty.Pretty b => Maybe CharacterSet -> Expr Src b -> Header -> Text
+formatExprWithHeader :: Pretty.Pretty b => ChooseCharacterSet -> Expr Src b -> Header -> Text
 formatExprWithHeader chosenCharacterSet expr (Header header) = Pretty.renderStrict
   (Dhall.Pretty.layout doc)
   where
-    charSet = fromMaybe (Dhall.Pretty.detectCharacterSet expr) chosenCharacterSet
+    charSet = chooseCharsetOrUseDefault (Dhall.Pretty.detectCharacterSet expr) chosenCharacterSet
 
     doc =
       Pretty.pretty header

dhall-lsp-server/src/Dhall/LSP/Backend/Parsing.hs

@@ -24,6 +24,7 @@ import Dhall.Core
 import Dhall.Parser
 import Dhall.Parser.Expression (importHash_, importType_, localOnly)
 import Dhall.Parser.Token      hiding (text)
+import Dhall.Pretty ( ChooseCharacterSet(Specify) )   
 import Text.Megaparsec
     ( SourcePos (..)
     , anySingle
@@ -295,7 +296,7 @@ binderExprFromText txt =
           <|> (do cs' <- skipManyTill anySingle _arrow; return (cs', holeExpr))
       whitespace
       inner <- parseBinderExpr
-      return (Pi (Just (cs <> cs')) name typ inner)
+      return (Pi (Specify (cs <> cs')) name typ inner)
 
     lambdaBinder = do
       cs <- _lambda
@@ -312,4 +313,4 @@ binderExprFromText txt =
           <|> (do cs' <- skipManyTill anySingle _arrow; return (cs', holeExpr))
       whitespace
       inner <- parseBinderExpr
-      return (Lam (Just (cs <> cs')) (makeFunctionBinding name typ) inner)
+      return (Lam (Specify (cs <> cs')) (makeFunctionBinding name typ) inner)

dhall-lsp-server/src/Dhall/LSP/State.hs

@@ -18,7 +18,7 @@ import Data.Dynamic                     (Dynamic)
 import Data.Map.Strict                  (Map, empty)
 import Data.Text                        (Text)
 import Dhall.LSP.Backend.Dhall          (Cache, DhallError, emptyCache)
-import Dhall.Pretty                     (CharacterSet)
+import Dhall.Pretty                     (ChooseCharacterSet(..))
 import Language.LSP.Server              (LspT)
 
 import qualified Language.LSP.Protocol.Types as J
@@ -39,19 +39,19 @@ data Severity = Error
               -- ^ Log message, not displayed by default.
 
 data ServerConfig = ServerConfig
-  { chosenCharacterSet :: Maybe CharacterSet
+  { chosenCharacterSet :: ChooseCharacterSet
   } deriving Show
 
 instance Default ServerConfig where
-  def = ServerConfig { chosenCharacterSet = Nothing }
+  def = ServerConfig { chosenCharacterSet = AutoInferCharSet }
 
 -- We need to derive the FromJSON instance manually in order to provide defaults
 -- for absent fields.
 instance FromJSON ServerConfig where
   parseJSON = withObject "settings" $ \v -> do
     s <- v .: "vscode-dhall-lsp-server"
     flip (withObject "vscode-dhall-lsp-server") s $ \o -> ServerConfig
-      <$> o .:? "character-set" .!= Nothing
+      <$> o .:? "character-set" .!= AutoInferCharSet
 
 data ServerState = ServerState
   { _importCache :: Cache  -- ^ The dhall import cache

dhall-openapi/openapi-to-dhall/Main.hs

@@ -36,6 +36,8 @@ import Dhall.Kubernetes.Types
     )
 import System.FilePath        ((</>))
 
+import Dhall.Pretty        (ChooseCharacterSet(..))
+
 import qualified Data.List                  as List
 import qualified Data.Map.Strict            as Data.Map
 import qualified Data.Ord                   as Ord
@@ -74,7 +76,7 @@ writeDhall path expr = do
   putStrLn $ "Writing file '" <> path <> "'"
   Text.writeFile path $ pretty expr <> "\n"
 
-  let chosenCharacterSet = Nothing -- Infer from input
+  let chosenCharacterSet = AutoInferCharSet
 
   let censor = Dhall.Util.NoCensor
 

dhall/src/Dhall/DirectoryTree.hs

@@ -30,6 +30,7 @@
 import Data.Void                 (Void)
 import Dhall.DirectoryTree.Types
 import Dhall.Marshal.Decode      (Decoder (..), Expector)
+import Dhall.Pretty              (ChooseCharacterSet(..))
 import Dhall.Src                 (Src)
 import Dhall.Syntax
     ( Chunks (..)
@@ -252,8 +253,8 @@
 
 -- | The type of a fixpoint directory tree expression.
 directoryTreeType :: Expector (Expr Src Void)
-directoryTreeType = Pi Nothing "tree" (Const Type)
-    <$> (Pi Nothing "make" <$> makeType <*> pure (App List (Var (V "tree" 0))))
+directoryTreeType = Pi AutoInferCharSet "tree" (Const Type)
+    <$> (Pi AutoInferCharSet "make" <$> makeType <*> pure (App List (Var (V "tree" 0))))
 
 -- | The type of make part of a fixpoint directory tree expression.
 makeType :: Expector (Expr Src Void)
@@ -265,12 +266,12 @@
     where
         makeConstructor :: Text -> Decoder b -> Expector (Text, RecordField Src Void)
         makeConstructor name dec = (name,) . Core.makeRecordField
-            <$> (Pi Nothing "_" <$> expected dec <*> pure (Var (V "tree" 0)))
+            <$> (Pi AutoInferCharSet "_" <$> expected dec <*> pure (Var (V "tree" 0)))
 
 -- | Resolve a `User` to a numerical id.
 getUser :: User -> IO UserID
 getUser (UserId uid) = return uid
 getUser (UserName name) =
 #ifdef mingw32_HOST_OS
     ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
     where x = "System.Posix.User.getUserEntryForName: not supported"
@@ -281,7 +282,7 @@
 -- | Resolve a `Group` to a numerical id.
 getGroup :: Group -> IO GroupID
 getGroup (GroupId gid) = return gid
 getGroup (GroupName name) =
 #ifdef mingw32_HOST_OS
     ioError $ mkIOError illegalOperationErrorType x Nothing Nothing
     where x = "System.Posix.User.getGroupEntryForName: not supported"

dhall/src/Dhall/Format.hs

@@ -11,8 +11,7 @@ module Dhall.Format
 
 import Data.Foldable      (for_)
 import Data.List.NonEmpty (NonEmpty)
-import Data.Maybe         (fromMaybe)
-import Dhall.Pretty       (CharacterSet, annToAnsiStyle, detectCharacterSet)
+import Dhall.Pretty       (annToAnsiStyle, detectCharacterSet, ChooseCharacterSet(..), chooseCharsetOrUseDefault)
 import Dhall.Util
     ( Censor
     , CheckFailed (..)
@@ -37,7 +36,7 @@ import qualified System.IO
 
 -- | Arguments to the `format` subcommand
 data Format = Format
-    { chosenCharacterSet :: Maybe CharacterSet
+    { chosenCharacterSet :: ChooseCharacterSet
     , censor             :: Censor
     , transitivity       :: Transitivity
     , inputs             :: NonEmpty Input
@@ -59,7 +58,7 @@ format (Format { inputs = inputs0, transitivity = transitivity0, ..}) =
         let status = Dhall.Import.emptyStatus directory
 
         let layoutHeaderAndExpr (Header header, expr) =
-                let characterSet = fromMaybe (detectCharacterSet expr) chosenCharacterSet
+                let characterSet = chooseCharsetOrUseDefault (detectCharacterSet expr) chosenCharacterSet
                 in
                 Dhall.Pretty.layout
                     (   Pretty.pretty header

dhall/src/Dhall/Freeze.hs

@@ -31,9 +31,10 @@ module Dhall.Freeze
 
 import Data.Foldable       (for_)
 import Data.List.NonEmpty  (NonEmpty)
-import Data.Maybe          (fromMaybe)
 import Dhall               (EvaluateSettings)
-import Dhall.Pretty        (CharacterSet, detectCharacterSet)
+import Dhall.Pretty        (detectCharacterSet)
+import Dhall.Pretty.Internal        (ChooseCharacterSet(..), chooseCharsetOrUseDefault)
+
 import Dhall.Syntax
     ( Expr (..)
     , Import (..)
@@ -128,7 +129,7 @@ freeze
     -> NonEmpty Input
     -> Scope
     -> Intent
-    -> Maybe CharacterSet
+    -> ChooseCharacterSet
     -> Censor
     -> IO ()
 freeze = freezeWithSettings Dhall.defaultEvaluateSettings
@@ -141,7 +142,7 @@ freezeWithManager
     -> NonEmpty Input
     -> Scope
     -> Intent
-    -> Maybe CharacterSet
+    -> ChooseCharacterSet
     -> Censor
     -> IO ()
 freezeWithManager newManager = freezeWithSettings (set Dhall.newManager newManager Dhall.defaultEvaluateSettings)
@@ -242,7 +243,7 @@ freezeWithSettings
     -> NonEmpty Input
     -> Scope
     -> Intent
-    -> Maybe CharacterSet
+    -> ChooseCharacterSet
     -> Censor
     -> IO ()
 freezeWithSettings settings outputMode transitivity0 inputs scope intent chosenCharacterSet censor =
@@ -270,7 +271,7 @@ freezeWithSettings settings outputMode transitivity0 inputs scope intent chosenC
 
         (Header header, parsedExpression) <- Util.getExpressionAndHeaderFromStdinText censor inputName originalText
 
-        let characterSet = fromMaybe (detectCharacterSet parsedExpression) chosenCharacterSet
+        let characterSet = chooseCharsetOrUseDefault (detectCharacterSet parsedExpression) chosenCharacterSet
 
         case transitivity of
             Transitive ->

dhall/src/Dhall/Main.hs

@@ -99,6 +99,7 @@ import qualified Dhall.Lint
 import qualified Dhall.Map
 import qualified Dhall.Package
 import qualified Dhall.Pretty
+import Dhall.Pretty.Internal (ChooseCharacterSet(..), chooseCharsetOrUseDefault)        
 import qualified Dhall.Repl
 import qualified Dhall.Schemas
 import qualified Dhall.Tags
@@ -122,7 +123,7 @@ data Options = Options
     { mode               :: Mode
     , explain            :: Bool
     , plain              :: Bool
-    , chosenCharacterSet :: Maybe CharacterSet
+    , chosenCharacterSet :: ChooseCharacterSet
     , censor             :: Censor
     }
 
@@ -221,16 +222,16 @@ parseOptions =
 
     parseCharacterSet =
             Options.Applicative.flag'
-                (Just Unicode)
+                (Specify Unicode)
                 (   Options.Applicative.long "unicode"
                 <>  Options.Applicative.help "Format code using only Unicode syntax"
                 )
         <|> Options.Applicative.flag'
-                (Just ASCII)
+                (Specify ASCII)
                 (   Options.Applicative.long "ascii"
                 <>  Options.Applicative.help "Format code using only ASCII syntax"
                 )
-        <|> pure Nothing
+        <|> pure AutoInferCharSet
 
 subcommand :: Group -> String -> String -> Parser a -> Parser a
 subcommand group name description parser =
@@ -634,7 +635,7 @@ command (Options {..}) = do
     let getExpressionAndCharacterSet file = do
             expr <- getExpression file
 
-            let characterSet = fromMaybe (detectCharacterSet expr) chosenCharacterSet
+            let characterSet = chooseCharsetOrUseDefault (detectCharacterSet expr) chosenCharacterSet
 
             return (expr, characterSet)
 
@@ -833,7 +834,7 @@ command (Options {..}) = do
 
         Repl ->
             Dhall.Repl.repl
-                (fromMaybe Unicode chosenCharacterSet) -- Default to Unicode if no characterSet specified
+                (chooseCharsetOrUseDefault Unicode chosenCharacterSet) -- Default to Unicode if no characterSet specified
                 explain
 
         Diff {..} -> do
@@ -908,7 +909,7 @@ command (Options {..}) = do
                 (Header header, parsedExpression) <-
                     Dhall.Util.getExpressionAndHeaderFromStdinText censor inputName originalText
 
-                let characterSet = fromMaybe (detectCharacterSet parsedExpression) chosenCharacterSet
+                let characterSet = chooseCharsetOrUseDefault (detectCharacterSet parsedExpression) chosenCharacterSet
 
                 case transitivity of
                     Transitive ->
@@ -994,7 +995,7 @@ command (Options {..}) = do
                 else do
                     let doc =
                             Dhall.Pretty.prettyCharacterSet
-                                (fromMaybe Unicode chosenCharacterSet) -- default to Unicode
+                                (chooseCharsetOrUseDefault Unicode chosenCharacterSet) -- default to Unicode
                                 (Dhall.Core.renote expression :: Expr Src Import)
 
                     renderDoc System.IO.stdout doc
@@ -1060,10 +1061,16 @@ command (Options {..}) = do
 
         Package {..} -> do
             let options = appEndo
-                    (maybe mempty (Endo . set Dhall.Package.characterSet) chosenCharacterSet
+                    (maybe mempty (Endo . set Dhall.Package.characterSet) chosenCharacterSetAsMaybe
                     <> packageOptions
                     ) Dhall.Package.defaultOptions
             writePackage options packageFiles
+              where
+                chosenCharacterSetAsMaybe :: Maybe CharacterSet
+                chosenCharacterSetAsMaybe = case chosenCharacterSet of
+                    AutoInferCharSet -> Nothing
+                    Specify c -> Just c  
+
 
 -- | Entry point for the @dhall@ executable
 main :: IO ()

dhall/src/Dhall/Marshal/Encode.hs

@@ -65,6 +65,7 @@ import Control.Monad.Trans.State.Strict
 import Data.Functor.Contravariant           (Contravariant (..), Op (..), (>$<))
 import Data.Functor.Contravariant.Divisible (Divisible (..), divided)
 import Dhall.Parser                         (Src (..))
+import Dhall.Pretty                         (ChooseCharacterSet(..))
 import Dhall.Syntax
     ( Chunks (..)
     , DhallDouble (..)
@@ -530,13 +531,13 @@ instance forall f. (Functor f, ToDhall (f (Result f))) => ToDhall (Fix f) where
     injectWith inputNormalizer = Encoder {..}
       where
         embed fixf =
-          Lam Nothing (Core.makeFunctionBinding "result" (Const Core.Type)) $
-            Lam Nothing (Core.makeFunctionBinding "Make" makeType) $
+          Lam AutoInferCharSet (Core.makeFunctionBinding "result" (Const Core.Type)) $
+            Lam AutoInferCharSet (Core.makeFunctionBinding "Make" makeType) $
               embed' . fixToResult $ fixf
 
-        declared = Pi Nothing "result" (Const Core.Type) $ Pi Nothing "_" makeType "result"
+        declared = Pi AutoInferCharSet "result" (Const Core.Type) $ Pi AutoInferCharSet "_" makeType "result"
 
-        makeType = Pi Nothing "_" declared' "result"
+        makeType = Pi AutoInferCharSet "_" declared' "result"
         Encoder embed' _ = injectWith @(Dhall.Marshal.Internal.Result f) inputNormalizer
         Encoder _ declared' = injectWith @(f (Dhall.Marshal.Internal.Result f)) inputNormalizer
 

dhall/src/Dhall/Normalize.hs

@@ -116,7 +116,7 @@ boundedType _                = False
 
 >>> mfb = Syntax.makeFunctionBinding
 >>> alphaNormalize (Lam mempty (mfb "a" (Const Type)) (Lam mempty (mfb "b" (Const Type)) (Lam mempty (mfb "x" "a") (Lam mempty (mfb "y" "b") "x"))))
-Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Lam Nothing (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Var (V "_" 1)))))
+Lam AutoInferCharSet (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam AutoInferCharSet (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Const Type}) (Lam AutoInferCharSet (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Lam AutoInferCharSet (FunctionBinding {functionBindingSrc0 = Nothing, functionBindingVariable = "_", functionBindingSrc1 = Nothing, functionBindingSrc2 = Nothing, functionBindingAnnotation = Var (V "_" 1)}) (Var (V "_" 1)))))
 
     α-normalization does not affect free variables:
 

dhall/src/Dhall/Parser/Expression.hs

@@ -8,7 +8,7 @@
 -- | Parsing Dhall expressions.
 module Dhall.Parser.Expression where
 
 import Control.Applicative     (Alternative (..), liftA2, optional)
 import Data.Foldable           (foldl')
 import Data.List.NonEmpty      (NonEmpty (..))
 import Data.Text               (Text)
@@ -33,6 +33,7 @@
 
 import Dhall.Parser.Combinators
 import Dhall.Parser.Token
+import {-# SOURCE #-} Dhall.Pretty.Internal        (ChooseCharacterSet(..))
 
 -- | Get the current source offset (in tokens)
 getOffset :: Text.Megaparsec.MonadParsec e s m => m Int
@@ -315,7 +316,7 @@
             cs' <- _arrow
             whitespace
             c <- expression
-            return (Lam (Just (cs <> cs')) (FunctionBinding (Just src0) a (Just src1) (Just src2) b) c)
+            return (Lam (Specify (cs <> cs')) (FunctionBinding (Just src0) a (Just src1) (Just src2) b) c)
 
         alternative1 = do
             try (_if *> nonemptyWhitespace)
@@ -368,7 +369,7 @@
             cs' <- _arrow
             whitespace
             c <- expression
-            return (Pi (Just (cs <> cs')) a b c)
+            return (Pi (Specify (cs <> cs')) a b c)
 
         alternative4 = do
             try (_assert *> whitespace *> _colon)
@@ -418,7 +419,7 @@
                             whitespace
                             b <- expression
                             whitespace
-                            return (Pi (Just cs) "_" a b)
+                            return (Pi (Specify cs) "_" a b)
 
                     let alternative5B1 = do
                             _colon
@@ -489,16 +490,16 @@
 
     operatorParsers :: [Parser (Expr s a -> Expr s a -> Expr s a)]
     operatorParsers =
-        [ Equivalent . Just           <$> _equivalent   <* whitespace
+        [ Equivalent . Specify        <$> _equivalent   <* whitespace
         , ImportAlt                   <$ _importAlt     <* nonemptyWhitespace
         , BoolOr                      <$ _or            <* whitespace
         , NaturalPlus                 <$ _plus          <* nonemptyWhitespace
         , TextAppend                  <$ _textAppend    <* whitespace
         , ListAppend                  <$ _listAppend    <* whitespace
         , BoolAnd                     <$ _and           <* whitespace
-        , (\cs -> Combine (Just cs) Nothing)         <$> _combine <* whitespace
-        , (\cs -> Prefer (Just cs) PreferFromSource) <$> _prefer  <* whitespace
-        , CombineTypes . Just         <$> _combineTypes <* whitespace
+        , (\cs -> Combine (Specify cs) Nothing)         <$> _combine <* whitespace
+        , (\cs -> Prefer (Specify cs) PreferFromSource) <$> _prefer  <* whitespace
+        , CombineTypes . Specify      <$> _combineTypes <* whitespace
         , NaturalTimes                <$ _times         <* whitespace
         -- Make sure that `==` is not actually the prefix of `===`
         , BoolEQ                      <$ try (_doubleEqual <* Text.Megaparsec.notFollowedBy (char '=')) <* whitespace