Skip to content

Commit c3a39dc

Browse files
robinheghanrobinheghan
authored
Merge pull request #165 from avh4/format-expose-constructors
format: good things to fix before 0.2
2 parents ec311b7 + afcb9d1 commit c3a39dc

File tree

16 files changed

+179
-69
lines changed

16 files changed

+179
-69
lines changed

‎compiler/src/AST/Source.hs‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,7 @@ import Data.List.NonEmpty (NonEmpty)
5050
import Data.Name (Name)
5151
import Data.Name qualified as Name
5252
import Gren.Float qualified as EF
53+
import Gren.Int qualified as GI
5354
import Gren.String qualified as ES
5455
import Parse.Primitives qualified as P
5556
import Reporting.Annotation qualified as A
@@ -60,8 +61,8 @@ type Expr = A.Located Expr_
6061

6162
data Expr_
6263
= Chr ES.String
63-
| Str ES.String
64-
| Int Int
64+
| Str ES.String ES.StringFormat
65+
| Int Int GI.IntFormat
6566
| Float EF.Float
6667
| Var VarType Name
6768
| VarQual VarType Name Name
@@ -120,7 +121,7 @@ data Pattern_
120121
| PArray [PArrayEntry]
121122
| PChr ES.String
122123
| PStr ES.String
123-
| PInt Int
124+
| PInt Int GI.IntFormat
124125
deriving (Show)
125126

126127
type RecordFieldPattern = A.Located RecordFieldPattern_
@@ -158,7 +159,7 @@ data Module = Module
158159
_values :: [(SourceOrder, A.Located Value)],
159160
_unions :: [(SourceOrder, A.Located Union)],
160161
_aliases :: [(SourceOrder, A.Located Alias)],
161-
_binops :: [A.Located Infix],
162+
_binops :: ([Comment], [A.Located Infix]),
162163
_topLevelComments :: [(SourceOrder, NonEmpty Comment)],
163164
_headerComments :: SC.HeaderComments,
164165
_effects :: Effects

‎compiler/src/Canonicalize/Expression.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -50,11 +50,11 @@ canonicalize :: Env.Env -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr
5050
canonicalize env (A.At region expression) =
5151
A.At region
5252
<$> case expression of
53-
Src.Str string ->
53+
Src.Str string _ ->
5454
Result.ok (Can.Str string)
5555
Src.Chr char ->
5656
Result.ok (Can.Chr char)
57-
Src.Int int ->
57+
Src.Int int _ ->
5858
Result.ok (Can.Int int)
5959
Src.Float float ->
6060
Result.ok (Can.Float float)
@@ -258,7 +258,7 @@ addBindingsHelp bindings (A.At region pattern) =
258258
bindings
259259
Src.PStr _ ->
260260
bindings
261-
Src.PInt _ ->
261+
Src.PInt _ _ ->
262262
bindings
263263

264264
-- BUILD BINDINGS GRAPH
@@ -361,7 +361,7 @@ getPatternNames names (A.At region pattern) =
361361
Src.PArray patterns -> List.foldl' getPatternNames names (fmap fst patterns)
362362
Src.PChr _ -> names
363363
Src.PStr _ -> names
364-
Src.PInt _ -> names
364+
Src.PInt _ _ -> names
365365

366366
extractRecordFieldPattern :: Src.RecordFieldPattern -> Src.Pattern
367367
extractRecordFieldPattern (A.At _ (Src.RFPattern _ pattern)) = pattern

‎compiler/src/Canonicalize/Module.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ type Result i w a =
3535
-- MODULES
3636

3737
canonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Result i [W.Warning] Can.Module
38-
canonicalize pkg ifaces modul@(Src.Module _ exports docs imports valuesWithSourceOrder _ _ binops _ _ effects) =
38+
canonicalize pkg ifaces modul@(Src.Module _ exports docs imports valuesWithSourceOrder _ _ (_, binops) _ _ effects) =
3939
do
4040
let values = fmap snd valuesWithSourceOrder
4141
let home = ModuleName.Canonical pkg (Src.getName modul)

‎compiler/src/Canonicalize/Pattern.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,7 @@ canonicalize env (A.At region pattern) =
7878
Result.ok (Can.PChr chr)
7979
Src.PStr str ->
8080
Result.ok (Can.PStr str)
81-
Src.PInt int ->
81+
Src.PInt int _ ->
8282
Result.ok (Can.PInt int)
8383

8484
canonicalizeRecordFields :: Env.Env -> [Src.RecordFieldPattern] -> Result DupsDict w [Can.PatternRecordField]

‎compiler/src/Data/Utf8.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ module Data.Utf8
2323
putVeryLong,
2424
--
2525
toChars,
26+
toText,
2627
toBuilder,
2728
toEscapedBuilder,
2829
--
@@ -46,6 +47,7 @@ import Data.ByteString.Builder.Internal qualified as B
4647
import Data.ByteString.Internal qualified as B
4748
import Data.Char qualified as Char
4849
import Data.List qualified as List
50+
import Data.Text qualified as Text
4951
import Foreign.ForeignPtr (touchForeignPtr)
5052
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
5153
import Foreign.Ptr (minusPtr, plusPtr)
@@ -330,6 +332,13 @@ word8ToInt# :: Word8# -> Int#
330332
word8ToInt# word8 =
331333
int8ToInt# (word8ToInt8# word8)
332334

335+
-- TO TEXT
336+
337+
toText :: Utf8 t -> Text.Text
338+
toText =
339+
-- This could most certainly be optimized for better performance
340+
Text.pack . toChars
341+
333342
-- TO BUILDER
334343

335344
toBuilder :: Utf8 t -> B.Builder

‎compiler/src/Gren/Format.hs‎

Lines changed: 63 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE LambdaCase #-}
22
{-# LANGUAGE OverloadedLists #-}
3+
{-# LANGUAGE OverloadedStrings #-}
34
{-# LANGUAGE TypeApplications #-}
45
{-# OPTIONS_GHC -Werror=incomplete-patterns #-}
56
{-# OPTIONS_GHC -Wno-error=unused-matches #-}
@@ -21,11 +22,16 @@ import Data.Maybe (catMaybes, maybeToList)
2122
import Data.Maybe qualified as Maybe
2223
import Data.Name (Name)
2324
import Data.Semigroup (sconcat)
25+
import Data.Text qualified as Text
26+
import Data.Text.Encoding (encodeUtf8Builder)
2427
import Data.Utf8 qualified as Utf8
28+
import Gren.Int qualified as GI
29+
import Gren.String qualified as GS
2530
import Parse.Primitives qualified as P
2631
import Reporting.Annotation qualified as A
2732
import Text.PrettyPrint.Avh4.Block (Block)
2833
import Text.PrettyPrint.Avh4.Block qualified as Block
34+
import Text.Printf qualified
2935

3036
toByteStringBuilder :: Src.Module -> B.Builder
3137
toByteStringBuilder module_ =
@@ -202,7 +208,7 @@ formatCommentBlockNonEmpty =
202208
spaceOrStack . fmap formatComment
203209

204210
formatModule :: Src.Module -> Block
205-
formatModule (Src.Module moduleName exports docs imports values unions aliases binops topLevelComments comments effects) =
211+
formatModule (Src.Module moduleName exports docs imports values unions aliases (commentsBeforeBinops, binops) topLevelComments comments effects) =
206212
Block.stack $
207213
NonEmpty.fromList $
208214
catMaybes
@@ -279,10 +285,21 @@ formatModule (Src.Module moduleName exports docs imports values unions aliases b
279285
Nothing -> Nothing
280286
Just some ->
281287
Just $
282-
Block.stack
283-
[ Block.blankLine,
284-
Block.stack $ fmap (formatInfix . A.toValue) some
285-
]
288+
Block.stack $
289+
NonEmpty.fromList $
290+
mconcat
291+
[ case formatCommentBlock commentsBeforeBinops of
292+
Just comments_ ->
293+
[ Block.blankLine,
294+
Block.blankLine,
295+
comments_,
296+
Block.blankLine
297+
]
298+
Nothing -> [],
299+
[ Block.blankLine,
300+
Block.stack $ fmap (formatInfix . A.toValue) some
301+
]
302+
]
286303

287304
formatTopLevelCommentBlock :: NonEmpty Src.Comment -> Block
288305
formatTopLevelCommentBlock comments =
@@ -352,23 +369,30 @@ formatExposing commentsAfterKeyword commentsAfterListing = \case
352369
formatExposed :: Src.Exposed -> Block
353370
formatExposed = \case
354371
Src.Lower name -> Block.line $ utf8 $ A.toValue name
355-
Src.Upper name privacy -> Block.line $ utf8 $ A.toValue name
372+
Src.Upper name Src.Private -> Block.line $ utf8 (A.toValue name)
373+
Src.Upper name (Src.Public _) -> Block.line $ utf8 (A.toValue name) <> Block.string7 "(..)"
356374
Src.Operator _ name -> Block.line $ Block.char7 '(' <> utf8 name <> Block.char7 ')'
357375

358376
formatImport :: ([Src.Comment], Src.Import) -> Block
359377
formatImport (commentsBefore, Src.Import name alias exposing exposingComments comments) =
360378
let (SC.ImportComments commentsAfterKeyword commentsAfterName) = comments
361-
in spaceOrIndent $
379+
in Block.stack $
362380
NonEmpty.fromList $
363381
catMaybes
364-
[ Just $ Block.line $ Block.string7 "import",
365-
Just $ withCommentsBefore commentsAfterKeyword $ Block.line $ utf8 $ A.toValue name,
366-
(spaceOrStack . fmap formatComment) <$> NonEmpty.nonEmpty commentsAfterName,
367-
fmap formatImportAlias alias,
368-
formatExposing
369-
(maybe [] SC._afterExposing exposingComments)
370-
(maybe [] SC._afterExposingListing exposingComments)
371-
exposing
382+
[ fmap (\b -> Block.stack [Block.blankLine, b]) $ formatCommentBlock commentsBefore,
383+
Just $
384+
spaceOrIndent $
385+
NonEmpty.fromList $
386+
catMaybes
387+
[ Just $ Block.line $ Block.string7 "import",
388+
Just $ withCommentsBefore commentsAfterKeyword $ Block.line $ utf8 $ A.toValue name,
389+
(spaceOrStack . fmap formatComment) <$> NonEmpty.nonEmpty commentsAfterName,
390+
fmap formatImportAlias alias,
391+
formatExposing
392+
(maybe [] SC._afterExposing exposingComments)
393+
(maybe [] SC._afterExposingListing exposingComments)
394+
exposing
395+
]
372396
]
373397

374398
formatImportAlias :: (Name, SC.ImportAliasComments) -> Block
@@ -536,13 +560,14 @@ formatExpr = \case
536560
Src.Chr char ->
537561
NoExpressionParens $
538562
formatString StringStyleChar char
539-
Src.Str string ->
563+
Src.Str string GS.SingleLineString ->
540564
NoExpressionParens $
541565
formatString StringStyleSingleQuoted string
542-
Src.Int int ->
566+
Src.Str string GS.MultilineString ->
543567
NoExpressionParens $
544-
Block.line $
545-
Block.string7 (show int)
568+
formatString StringStyleTripleQuoted string
569+
Src.Int int intFormat ->
570+
NoExpressionParens $ formatInt intFormat int
546571
Src.Float float ->
547572
NoExpressionParens $
548573
Block.line $
@@ -770,6 +795,16 @@ formatExpr = \case
770795
exprParensNone $
771796
formatExpr (A.toValue expr)
772797

798+
formatInt :: GI.IntFormat -> Int -> Block
799+
formatInt intFormat int =
800+
case intFormat of
801+
GI.DecimalInt ->
802+
Block.line $
803+
Block.string7 (show int)
804+
GI.HexInt ->
805+
Block.line $
806+
Block.string7 (Text.Printf.printf "0x%X" int)
807+
773808
parensComments :: [Src.Comment] -> [Src.Comment] -> Block -> Block
774809
parensComments [] [] inner = inner
775810
parensComments commentsBefore commentsAfter inner =
@@ -1005,10 +1040,8 @@ formatPattern = \case
10051040
Src.PStr string ->
10061041
NoPatternParens $
10071042
formatString StringStyleSingleQuoted string
1008-
Src.PInt int ->
1009-
NoPatternParens $
1010-
Block.line $
1011-
Block.string7 (show int)
1043+
Src.PInt int intFormat ->
1044+
NoPatternParens $ formatInt intFormat int
10121045

10131046
formatPatternConstructorArg :: ([Src.Comment], Src.Pattern) -> PatternBlock
10141047
formatPatternConstructorArg (commentsBefore, pat) =
@@ -1028,7 +1061,13 @@ formatString style str =
10281061
StringStyleSingleQuoted ->
10291062
stringBox (Block.char7 '"')
10301063
StringStyleTripleQuoted ->
1031-
stringBox (Block.string7 "\"\"\"")
1064+
Block.stack $
1065+
NonEmpty.fromList $
1066+
mconcat
1067+
[ [Block.line (Block.string7 "\"\"\"")],
1068+
fmap (Block.line . Block.lineFromBuilder . encodeUtf8Builder) $ Text.splitOn "\\n" $ (Utf8.toText str),
1069+
[Block.line (Block.string7 "\"\"\"")]
1070+
]
10321071
where
10331072
stringBox :: Block.Line -> Block
10341073
stringBox quotes =

‎compiler/src/Gren/Int.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module Gren.Int (IntFormat (..)) where
2+
3+
data IntFormat = DecimalInt | HexInt
4+
deriving (Show)

‎compiler/src/Gren/String.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55

66
module Gren.String
77
( String,
8+
StringFormat (..),
89
toChars,
910
fromChars,
1011
toBuilder,
@@ -31,6 +32,11 @@ type String =
3132

3233
data GREN_STRING
3334

35+
data StringFormat
36+
= SingleLineString
37+
| MultilineString
38+
deriving (Show)
39+
3440
-- HELPERS
3541

3642
toChars :: String -> [Char]

‎compiler/src/Parse/Declaration.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -234,7 +234,7 @@ portDecl maybeDocs =
234234

235235
-- INVARIANT: always chomps to a freshline
236236
--
237-
infix_ :: Parser E.Module (A.Located Src.Infix)
237+
infix_ :: Parser E.Module (A.Located Src.Infix, [Src.Comment])
238238
infix_ =
239239
let err = E.Infix
240240
_err = \_ -> E.Infix
@@ -260,6 +260,6 @@ infix_ =
260260
Space.chompAndCheckIndent _err err
261261
name <- Var.lower err
262262
end <- getPosition
263-
Space.chomp _err
263+
commentsAfter <- Space.chomp _err
264264
Space.checkFreshLine err
265-
return (A.at start end (Src.Infix op associativity precedence name))
265+
return (A.at start end (Src.Infix op associativity precedence name), commentsAfter)

‎compiler/src/Parse/Expression.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -44,8 +44,8 @@ term =
4444
string :: A.Position -> Parser E.Expr Src.Expr
4545
string start =
4646
do
47-
str <- String.string E.Start E.String
48-
addEnd start (Src.Str str)
47+
(str, stringFormat) <- String.string E.Start E.String
48+
addEnd start (Src.Str str stringFormat)
4949

5050
character :: A.Position -> Parser E.Expr Src.Expr
5151
character start =
@@ -59,7 +59,7 @@ number start =
5959
nmbr <- Number.number E.Start E.Number
6060
addEnd start $
6161
case nmbr of
62-
Number.Int int -> Src.Int int
62+
Number.Int int intFormat -> Src.Int int intFormat
6363
Number.Float float -> Src.Float float
6464

6565
parenthesizedExpr :: A.Position -> Parser E.Expr Src.Expr

0 commit comments

Comments
 (0)