wip introduce ChooseCharSet and refactor code

Author: winitzki

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

@@ -1,6 +1,5 @@
 module Dhall.LSP.Backend.Formatting (formatExpr, formatExprWithHeader) where
 
-import Data.Maybe   (fromMaybe)
 import Data.Text    (Text)
 import Dhall.Core   (Expr)
 import Dhall.Parser (Header (..))
@@ -12,21 +11,21 @@ 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/State.hs

@@ -39,7 +39,7 @@ data Severity = Error
               -- ^ Log message, not displayed by default.
 
 data ServerConfig = ServerConfig
-  { chosenCharacterSet :: Maybe CharacterSet
+  { chosenCharacterSet :: ChooseCharacterSet
   } deriving Show
 
 instance Default ServerConfig where

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

@@ -36,6 +36,8 @@ import Dhall.Kubernetes.Types
     )
 import System.FilePath        ((</>))
 
+import Dhall.Pretty.Internal        (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/.DS_Store

@@ -50,6 +50,7 @@ import qualified Dhall.Core                  as Core
 import qualified Dhall.Map                   as Map
 import qualified Dhall.Marshal.Decode        as Decode
 import qualified Dhall.Pretty
+import Dhall.Pretty.Internal        (ChooseCharacterSet(..))
 import qualified Dhall.TypeCheck             as TypeCheck
 import qualified Dhall.Util                  as Util
 import qualified Prettyprinter               as Pretty
@@ -252,8 +253,8 @@ decodeDirectoryTree expr = Exception.throwIO $ FilesystemError $ Core.denote exp
 
 -- | 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,7 +266,7 @@ makeType = Record . Map.fromList <$> sequenceA
     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

dhall/src/Dhall/.DS_Store

@@ -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)
 import Dhall.Util
     ( Censor
     , CheckFailed (..)
@@ -34,10 +33,11 @@ import qualified System.AtomicWrite.Writer.LazyText as AtomicWrite.LazyText
 import qualified System.Console.ANSI
 import qualified System.FilePath
 import qualified System.IO
+import Dhall.Pretty.Internal        (ChooseCharacterSet(..), chooseCharsetOrUseDefault)
 
 -- | Arguments to the `format` subcommand
 data Format = Format
-    { chosenCharacterSet :: Maybe CharacterSet
+    { chosenCharacterSet :: ChooseCharacterSet
     , censor             :: Censor
     , transitivity       :: Transitivity
     , inputs             :: NonEmpty Input
@@ -59,7 +59,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/DirectoryTree.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/Format.hs

@@ -10,7 +10,7 @@ module Dhall.Import.Headers
     , toOriginHeaders
     ) where
 
-import Control.Applicative (Alternative (..), liftA2)
+import Control.Applicative (Alternative (..))
 import Control.Exception   (SomeException)
 import Control.Monad.Catch (handle, throwM)
 import Data.Text           (Text)

dhall/src/Dhall/Freeze.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 ()