never executed always true always false
1 {-# LANGUAGE TypeFamilies #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE Rank2Types #-}
5 {-# LANGUAGE DataKinds #-}
6
7 module ElmFormat.Render.Box where
8
9 import Elm.Utils ((|>))
10 import Box
11 import ElmVersion (ElmVersion(..))
12
13 import AST.V0_16
14 import qualified AST.Module
15 import AST.Structure
16 import qualified AST.Listing
17 import qualified Cheapskate.Types as Markdown
18 import qualified Control.Monad as Monad
19 import qualified Data.Char as Char
20 import Data.Coapplicative
21 import qualified Data.Foldable as Foldable
22 import Data.Functor.Identity
23 import qualified Data.Indexed as I
24 import qualified Data.List as List
25 import Data.List.Extra
26 import qualified Data.Map.Strict as Map
27 import Data.Maybe (fromMaybe, maybeToList)
28 import qualified Data.Maybe as Maybe
29 import Data.ReversedList (Reversed)
30 import qualified Data.ReversedList as ReversedList
31 import Data.Set (Set)
32 import qualified Data.Set as Set
33 import Data.Text (Text)
34 import qualified Data.Text as Text
35 import ElmFormat.ImportInfo (ImportInfo)
36 import qualified ElmFormat.ImportInfo as ImportInfo
37 import qualified ElmFormat.Render.ElmStructure as ElmStructure
38 import qualified ElmFormat.Render.Markdown
39 import qualified ElmVersion
40 import qualified Parse.Parse as Parse
41 import qualified Reporting.Annotation as RA
42 import qualified Reporting.Region as Region
43 import qualified Reporting.Result as Result
44 import Text.Printf (printf)
45
46
47 pleaseReport'' :: String -> String -> String
48 pleaseReport'' what details =
49 -- TODO: include version in the message
50 "<elm-format: "++ what ++ ": " ++ details ++ " -- please report this at https://github.com/avh4/elm-format/issues >"
51
52
53 pleaseReport' :: String -> String -> Line
54 pleaseReport' what details =
55 keyword $ pleaseReport'' what details
56
57
58 pleaseReport :: String -> String -> Box
59 pleaseReport what details =
60 line $ pleaseReport' what details
61
62
63 surround :: Char -> Char -> Box -> Box
64 surround left right b =
65 let
66 left' = punc (left : [])
67 right' = punc (right : [])
68 in
69 case b of
70 SingleLine b' ->
71 line $ row [ left', b', right' ]
72 _ ->
73 stack1
74 [ b
75 |> prefix left'
76 , line $ right'
77 ]
78
79
80 parens :: Box -> Box
81 parens = surround '(' ')'
82
83
84 formatBinary :: Bool -> Box -> [ ( Bool, Comments, Box, Box ) ] -> Box
85 formatBinary multiline left ops =
86 case ops of
87 [] ->
88 left
89
90 ( isLeftPipe, comments, op, next ) : rest ->
91 if isLeftPipe then
92 ElmStructure.forceableSpaceSepOrIndented multiline
93 (ElmStructure.spaceSepOrStack left $
94 concat
95 [ Maybe.maybeToList $ formatComments comments
96 , [op]
97 ]
98 )
99 [formatBinary multiline next rest]
100 else
101 formatBinary
102 multiline
103 (ElmStructure.forceableSpaceSepOrIndented multiline left [formatCommented' comments id $ ElmStructure.spaceSepOrPrefix op next])
104 rest
105
106
107 splitWhere :: (a -> Bool) -> [a] -> [[a]]
108 splitWhere predicate list =
109 let
110 merge acc result =
111 ReversedList.push (ReversedList.toList acc) result
112
113 step (acc,result) next =
114 if predicate next then
115 (ReversedList.empty, merge (ReversedList.push next acc) result)
116 else
117 (ReversedList.push next acc, result)
118 in
119 list
120 |> foldl step (ReversedList.empty, ReversedList.empty)
121 |> uncurry merge
122 |> ReversedList.toList
123 |> dropWhile null
124
125
126 data DeclarationType
127 = DComment
128 | DStarter
129 | DCloser
130 | DDefinition (Maybe (Ref ()))
131 | DFixity
132 | DDocComment
133 deriving (Show)
134
135
136 declarationType :: (a -> BodyEntryType) -> TopLevelStructure a -> DeclarationType
137 declarationType entryType decl =
138 case decl of
139 Entry entry ->
140 case entryType entry of
141 BodyNamed name -> DDefinition (Just name)
142 BodyUnnamed -> DDefinition Nothing
143 BodyFixity -> DFixity
144
145 DocComment _ ->
146 DDocComment
147
148 BodyComment CommentTrickOpener ->
149 DStarter
150
151 BodyComment CommentTrickCloser ->
152 DCloser
153
154 BodyComment _ ->
155 DComment
156
157
158 removeDuplicates :: Ord a => [[a]] -> [[a]]
159 removeDuplicates input =
160 foldl step (ReversedList.empty, Set.empty) input |> fst |> ReversedList.toList
161 where
162 step :: Ord a => (Reversed [a], Set a) -> [a] -> (Reversed [a], Set a)
163 step (acc, seen) next =
164 case foldl stepChildren (ReversedList.empty, seen) next |> (\(a,b) -> (ReversedList.toList a, b)) of
165 ([], seen') -> (acc, seen')
166 (children', seen') -> (ReversedList.push children' acc, seen')
167
168 stepChildren :: Ord a => (Reversed a, Set a) -> a -> (Reversed a, Set a)
169 stepChildren (acc, seen) next =
170 if Set.member next seen
171 then (acc, seen)
172 else (ReversedList.push next acc, Set.insert next seen)
173
174
175 sortVars :: Bool -> Set (C2 before after AST.Listing.Value) -> [[String]] -> ([[C2 before after AST.Listing.Value]], Comments)
176 sortVars forceMultiline fromExposing fromDocs =
177 let
178 varOrder :: Commented c AST.Listing.Value -> (Int, String)
179 varOrder (C _ (AST.Listing.OpValue (SymbolIdentifier name))) = (1, name)
180 varOrder (C _ (AST.Listing.Union (C _ (UppercaseIdentifier name)) _)) = (2, name)
181 varOrder (C _ (AST.Listing.Value (LowercaseIdentifier name))) = (3, name)
182
183 listedInDocs =
184 fromDocs
185 |> fmap (Maybe.mapMaybe (\v -> Map.lookup v allowedInDocs))
186 |> filter (not . List.null)
187 |> fmap (fmap (\v -> C ([], []) v))
188 |> removeDuplicates
189
190 listedInExposing =
191 fromExposing
192 |> Set.toList
193 |> List.sortOn varOrder
194
195 varName (C _ (AST.Listing.Value (LowercaseIdentifier name))) = name
196 varName (C _ (AST.Listing.OpValue (SymbolIdentifier name))) = name
197 varName (C _ (AST.Listing.Union (C _ (UppercaseIdentifier name)) _)) = name
198
199 varSetToMap set =
200 Set.toList set
201 |> fmap (\(C c var)-> (varName (C c var), var))
202 |> Map.fromList
203
204 allowedInDocs =
205 varSetToMap fromExposing
206
207 allFromDocs =
208 Set.fromList $ fmap varName $ concat listedInDocs
209
210 inDocs x =
211 Set.member (varName x) allFromDocs
212
213 remainingFromExposing =
214 listedInExposing
215 |> filter (not . inDocs)
216
217 commentsFromReorderedVars =
218 listedInExposing
219 |> filter inDocs
220 |> fmap (\(C (pre, post) _) -> pre ++ post)
221 |> concat
222 in
223 if List.null listedInDocs && forceMultiline
224 then ( fmap (\x -> [x]) remainingFromExposing, commentsFromReorderedVars )
225 else ( listedInDocs ++ if List.null remainingFromExposing then [] else [ remainingFromExposing ], commentsFromReorderedVars )
226
227
228 formatModuleHeader :: Coapplicative annf => ElmVersion -> Bool -> AST.Module.Module [UppercaseIdentifier] (ASTNS annf [UppercaseIdentifier] 'TopLevelNK) -> [Box]
229 formatModuleHeader elmVersion addDefaultHeader modu =
230 let
231 maybeHeader =
232 if addDefaultHeader
233 then Just (AST.Module.header modu |> Maybe.fromMaybe AST.Module.defaultHeader)
234 else AST.Module.header modu
235
236 refName (VarRef _ (LowercaseIdentifier name)) = name
237 refName (TagRef _ (UppercaseIdentifier name)) = name
238 refName (OpRef (SymbolIdentifier name)) = name
239
240 varName (C _ (AST.Listing.Value (LowercaseIdentifier name))) = name
241 varName (C _ (AST.Listing.OpValue (SymbolIdentifier name))) = name
242 varName (C _ (AST.Listing.Union (C _ (UppercaseIdentifier name)) _)) = name
243
244 documentedVars :: [[String]]
245 documentedVars =
246 AST.Module.docs modu
247 |> extract
248 |> fmap Foldable.toList
249 |> Maybe.fromMaybe []
250 |> concatMap extractDocs
251
252 documentedVarsSet :: Set String
253 documentedVarsSet = Set.fromList $ concat documentedVars
254
255 extractDocs block =
256 case block of
257 Markdown.ElmDocs vars ->
258 fmap (fmap (refName . textToRef)) vars
259 _ -> []
260
261 textToRef :: Text -> Ref [UppercaseIdentifier]
262 textToRef text =
263 case Text.unpack text of
264 s@(c:_) | Char.isUpper c -> TagRef [] (UppercaseIdentifier s)
265 s@(c:_) | Char.isLower c -> VarRef [] (LowercaseIdentifier s)
266 '(':a:')':[] -> OpRef (SymbolIdentifier $ a:[])
267 '(':a:b:')':[] -> OpRef (SymbolIdentifier $ a:b:[])
268 s -> VarRef [] (LowercaseIdentifier s)
269
270 definedVars :: Set (C2 before after AST.Listing.Value)
271 definedVars =
272 AST.Module.body modu
273 |> (extract . I.unFix)
274 |> (\(TopLevel decls) -> decls)
275 |> concatMap extractVarName
276 |> fmap (C ([], []))
277 |> Set.fromList
278
279 exportsList =
280 case
281 AST.Module.exports (maybeHeader |> Maybe.fromMaybe AST.Module.defaultHeader)
282 of
283 Just (C _ e) -> e
284 Nothing -> AST.Listing.ClosedListing
285
286 detailedListingToSet :: AST.Listing.Listing AST.Module.DetailedListing -> Set (C2 before after AST.Listing.Value)
287 detailedListingToSet (AST.Listing.OpenListing _) = Set.empty
288 detailedListingToSet AST.Listing.ClosedListing = Set.empty
289 detailedListingToSet (AST.Listing.ExplicitListing (AST.Module.DetailedListing values operators types) _) =
290 Set.unions
291 [ Map.assocs values |> fmap (\(name, C c ()) -> C c (AST.Listing.Value name)) |> Set.fromList
292 , Map.assocs operators |> fmap (\(name, C c ()) -> C c (AST.Listing.OpValue name)) |> Set.fromList
293 , Map.assocs types |> fmap (\(name, C c (C preListing listing)) -> C c (AST.Listing.Union (C preListing name) listing)) |> Set.fromList
294 ]
295
296 detailedListingIsMultiline :: AST.Listing.Listing a -> Bool
297 detailedListingIsMultiline (AST.Listing.ExplicitListing _ isMultiline) = isMultiline
298 detailedListingIsMultiline _ = False
299
300 varsToExpose =
301 case AST.Module.exports =<< maybeHeader of
302 Nothing ->
303 if null $ concat documentedVars
304 then definedVars
305 else definedVars |> Set.filter (\v -> Set.member (varName v) documentedVarsSet)
306 Just (C _ e) -> detailedListingToSet e
307
308 sortedExports =
309 sortVars
310 (detailedListingIsMultiline exportsList)
311 varsToExpose
312 documentedVars
313
314 extractVarName :: Coapplicative annf => TopLevelStructure (ASTNS annf ns 'TopLevelDeclarationNK) -> [AST.Listing.Value]
315 extractVarName decl =
316 case fmap (extract . I.unFix) decl of
317 DocComment _ -> []
318 BodyComment _ -> []
319 Entry (PortAnnotation (C _ (LowercaseIdentifier name)) _ _) -> [ AST.Listing.Value (LowercaseIdentifier name) ]
320 Entry (CommonDeclaration def) ->
321 case extract $ I.unFix def of
322 Definition pat _ _ _ ->
323 case extract $ I.unFix pat of
324 VarPattern (LowercaseIdentifier name) -> [ AST.Listing.Value (LowercaseIdentifier name) ]
325 RecordPattern fields -> fmap (AST.Listing.Value . extract) fields
326 _ -> []
327 _ -> []
328 Entry (Datatype (C _ (NameWithArgs (UppercaseIdentifier name) _)) _) -> [ AST.Listing.Union (C [] (UppercaseIdentifier name)) (AST.Listing.OpenListing (C ([], []) ()))]
329 Entry (TypeAlias _ (C _ (NameWithArgs (UppercaseIdentifier name) _)) _) -> [ AST.Listing.Union (C [] (UppercaseIdentifier name)) AST.Listing.ClosedListing ]
330 Entry _ -> []
331
332 formatModuleLine' header@(AST.Module.Header srcTag name moduleSettings exports) =
333 let
334 (preExposing, postExposing) =
335 case exports of
336 Nothing -> ([], [])
337 Just (C (pre, post) _) -> (pre, post)
338 in
339 case elmVersion of
340 Elm_0_16 ->
341 formatModuleLine_0_16 header
342
343 Elm_0_17 ->
344 formatModuleLine elmVersion sortedExports srcTag name moduleSettings preExposing postExposing
345
346 Elm_0_18 ->
347 formatModuleLine elmVersion sortedExports srcTag name moduleSettings preExposing postExposing
348
349 Elm_0_19 ->
350 formatModuleLine elmVersion sortedExports srcTag name moduleSettings preExposing postExposing
351
352 docs =
353 fmap (formatDocComment elmVersion (ImportInfo.fromModule mempty modu)) $ extract $ AST.Module.docs modu
354
355 imports =
356 formatImports elmVersion modu
357 in
358 List.intercalate [ blankLine ] $ concat
359 [ maybeToList $ fmap (return . formatModuleLine') maybeHeader
360 , maybeToList $ fmap return docs
361 , if null imports
362 then []
363 else [ imports ]
364 ]
365
366
367 formatImports :: ElmVersion -> AST.Module.Module [UppercaseIdentifier] decl -> [Box]
368 formatImports elmVersion modu =
369 let
370 (C comments imports) =
371 AST.Module.imports modu
372 in
373 [ formatComments comments
374 |> maybeToList
375 , imports
376 |> Map.assocs
377 |> fmap (\(name, (C pre method)) -> formatImport elmVersion (C pre name, method))
378 ]
379 |> List.filter (not . List.null)
380 |> List.intersperse [blankLine]
381 |> concat
382
383
384 formatModuleLine_0_16 :: AST.Module.Header -> Box
385 formatModuleLine_0_16 header =
386 let
387 elmVersion = Elm_0_16
388
389 exports =
390 case AST.Module.exports header of
391 Just (C _ value) -> value
392 Nothing -> AST.Listing.OpenListing (C ([], []) ())
393
394 formatExports =
395 case formatListing (formatDetailedListing elmVersion) exports of
396 Just listing ->
397 listing
398 _ ->
399 pleaseReport "UNEXPECTED MODULE DECLARATION" "empty listing"
400
401 whereComments =
402 case AST.Module.exports header of
403 Nothing -> ([], [])
404 Just (C (pre, post) _) -> (pre, post)
405
406 whereClause =
407 formatCommented (line . keyword) (C whereComments "where")
408 in
409 case
410 ( formatCommented (line . formatQualifiedUppercaseIdentifier elmVersion) $ AST.Module.name header
411 , formatExports
412 , whereClause
413 )
414 of
415 (SingleLine name', SingleLine exports', SingleLine where') ->
416 line $ row
417 [ keyword "module"
418 , space
419 , name'
420 , row [ space, exports' ]
421 , space
422 , where'
423 ]
424 (name', exports', _) ->
425 stack1
426 [ line $ keyword "module"
427 , indent $ name'
428 , indent $ exports'
429 , indent $ whereClause
430 ]
431
432
433 formatModuleLine ::
434 ElmVersion
435 -> ([[C2 before after AST.Listing.Value]], Comments)
436 -> AST.Module.SourceTag
437 -> C2 before after [UppercaseIdentifier]
438 -> Maybe (C2 before after AST.Module.SourceSettings)
439 -> Comments
440 -> Comments
441 -> Box
442 formatModuleLine elmVersion (varsToExpose, extraComments) srcTag name moduleSettings preExposing postExposing =
443 let
444 tag =
445 case srcTag of
446 AST.Module.Normal ->
447 line $ keyword "module"
448
449 AST.Module.Port comments ->
450 ElmStructure.spaceSepOrIndented
451 (formatTailCommented (line . keyword) (C comments "port"))
452 [ line $ keyword "module" ]
453
454 AST.Module.Effect comments ->
455 ElmStructure.spaceSepOrIndented
456 (formatTailCommented (line . keyword) (C comments "effect"))
457 [ line $ keyword "module" ]
458
459 exports =
460 case varsToExpose of
461 [] -> line $ keyword "(..)"
462 [oneGroup] ->
463 oneGroup
464 |> fmap (formatCommented $ formatVarValue elmVersion)
465 |> ElmStructure.group' False "(" "," (maybeToList (formatComments extraComments)) ")" False
466 _ ->
467 varsToExpose
468 |> fmap (ElmStructure.group False "" "," "" False . fmap (formatCommented $ formatVarValue elmVersion))
469 |> ElmStructure.group' False "(" "," (maybeToList (formatComments extraComments)) ")" True
470
471 formatSetting (k, v) =
472 formatRecordPair elmVersion "=" (line . formatUppercaseIdentifier elmVersion) (k, v, False)
473
474 formatSettings settings =
475 map formatSetting settings
476 |> ElmStructure.group True "{" "," "}" False
477
478 whereClause =
479 moduleSettings
480 |> fmap (formatKeywordCommented "where" formatSettings)
481 |> fmap (\x -> [x])
482 |> Maybe.fromMaybe []
483
484 nameClause =
485 case
486 ( tag
487 , formatCommented (line . formatQualifiedUppercaseIdentifier elmVersion) name
488 )
489 of
490 (SingleLine tag', SingleLine name') ->
491 line $ row
492 [ tag'
493 , space
494 , name'
495 ]
496
497 (tag', name') ->
498 stack1
499 [ tag'
500 , indent $ name'
501 ]
502 in
503 ElmStructure.spaceSepOrIndented
504 (ElmStructure.spaceSepOrIndented
505 nameClause
506 (whereClause ++ [formatCommented (line . keyword) (C (preExposing, postExposing) "exposing")])
507 )
508 [ exports ]
509
510
511 formatModule :: Coapplicative annf => ElmVersion -> Bool -> Int -> AST.Module.Module [UppercaseIdentifier] (ASTNS annf [UppercaseIdentifier] 'TopLevelNK) -> Box
512 formatModule elmVersion addDefaultHeader spacing modu =
513 let
514 initialComments' =
515 case AST.Module.initialComments modu of
516 [] ->
517 []
518 comments ->
519 (map formatComment comments)
520 ++ [ blankLine, blankLine ]
521
522 spaceBeforeBody =
523 case extract $ I.unFix $ AST.Module.body modu of
524 TopLevel [] -> 0
525 TopLevel (BodyComment _ : _) -> spacing + 1
526 TopLevel _ -> spacing
527
528 decls =
529 case extract $ I.unFix $ AST.Module.body modu of
530 TopLevel decls -> decls
531 in
532 stack1 $
533 concat
534 [ initialComments'
535 , formatModuleHeader elmVersion addDefaultHeader modu
536 , List.replicate spaceBeforeBody blankLine
537 , maybeToList $ formatModuleBody spacing elmVersion (ImportInfo.fromModule mempty modu) decls
538 ]
539
540
541 formatModuleBody :: forall annf. Coapplicative annf => Int -> ElmVersion -> ImportInfo [UppercaseIdentifier] -> [TopLevelStructure (ASTNS annf [UppercaseIdentifier] 'TopLevelDeclarationNK)] -> Maybe Box
542 formatModuleBody linesBetween elmVersion importInfo body =
543 let
544 entryType :: ASTNS annf ns 'TopLevelDeclarationNK -> BodyEntryType
545 entryType adecl =
546 case extract $ I.unFix adecl of
547 CommonDeclaration def ->
548 case extract $ I.unFix def of
549 Definition pat _ _ _ ->
550 case extract $ I.unFix pat of
551 VarPattern name ->
552 BodyNamed $ VarRef () name
553
554 OpPattern name ->
555 BodyNamed $ OpRef name
556
557 _ ->
558 BodyUnnamed
559
560 TypeAnnotation (C _ name) _ ->
561 BodyNamed name
562
563 Datatype (C _ (NameWithArgs name _)) _ ->
564 BodyNamed $ TagRef () name
565
566 TypeAlias _ (C _ (NameWithArgs name _)) _ ->
567 BodyNamed $ TagRef () name
568
569 PortDefinition_until_0_16 (C _ name) _ _ ->
570 BodyNamed $ VarRef () name
571
572 PortAnnotation (C _ name) _ _ ->
573 BodyNamed $ VarRef () name
574
575 Fixity_until_0_18 _ _ _ _ _ ->
576 BodyFixity
577
578 Fixity _ _ _ _ ->
579 BodyFixity
580 in
581 formatTopLevelBody linesBetween elmVersion importInfo entryType (formatDeclaration elmVersion importInfo) body
582
583
584 data BodyEntryType
585 = BodyNamed (Ref ())
586 | BodyUnnamed
587 | BodyFixity
588
589
590 formatTopLevelBody ::
591 Int
592 -> ElmVersion
593 -> ImportInfo [UppercaseIdentifier]
594 -> (a -> BodyEntryType)
595 -> (a -> Box)
596 -> [TopLevelStructure a]
597 -> Maybe Box
598 formatTopLevelBody linesBetween elmVersion importInfo entryType formatEntry body =
599 let
600 extraLines n =
601 List.replicate n blankLine
602
603 spacer first second =
604 case (declarationType entryType first, declarationType entryType second) of
605 (DStarter, _) -> 0
606 (_, DCloser) -> 0
607 (DComment, DComment) -> 0
608 (_, DComment) -> if linesBetween == 1 then 1 else linesBetween + 1
609 (DComment, DDefinition _) -> if linesBetween == 1 then 0 else linesBetween
610 (DComment, _) -> linesBetween
611 (DDocComment, DDefinition _) -> 0
612 (DDefinition Nothing, DDefinition (Just _)) -> linesBetween
613 (DDefinition _, DStarter) -> linesBetween
614 (DDefinition Nothing, DDefinition Nothing) -> linesBetween
615 (DDefinition a, DDefinition b) ->
616 if a == b
617 then 0
618 else linesBetween
619 (DCloser, _) -> linesBetween
620 (_, DDocComment) -> linesBetween
621 (DDocComment, DStarter) -> 0
622 (DFixity, DFixity) -> 0
623 (DFixity, _) -> linesBetween
624 (_, DFixity) -> linesBetween
625
626 boxes =
627 intersperseMap (\a b -> extraLines $ spacer a b)
628 (formatTopLevelStructure elmVersion importInfo formatEntry)
629 body
630 in
631 case boxes of
632 [] -> Nothing
633 _ -> Just $ stack1 boxes
634
635
636 data ElmCodeBlock annf ns
637 = DeclarationsCode [TopLevelStructure (ASTNS annf ns 'TopLevelDeclarationNK)]
638 | ExpressionsCode [TopLevelStructure (C0Eol (ASTNS annf ns 'ExpressionNK))]
639 | ModuleCode (AST.Module.Module ns (ASTNS annf ns 'TopLevelNK))
640
641 convertElmCodeBlock :: Functor ann => (forall x. ann x -> ann' x) -> ElmCodeBlock ann ns -> ElmCodeBlock ann' ns
642 convertElmCodeBlock f = \case
643 DeclarationsCode decls -> DeclarationsCode (fmap (fmap $ I.convert f) decls)
644 ExpressionsCode exprs -> ExpressionsCode (fmap (fmap $ fmap $ I.convert f) exprs)
645 ModuleCode mod -> ModuleCode (fmap (I.convert f) mod)
646
647
648 -- TODO: there must be an existing haskell function that does this, right?
649 firstOf :: [a -> Maybe b] -> a -> Maybe b
650 firstOf options value =
651 case options of
652 [] -> Nothing
653 (next:rest) ->
654 case next value of
655 Just result -> Just result
656 Nothing -> firstOf rest value
657
658
659 formatDocComment :: ElmVersion -> ImportInfo [UppercaseIdentifier] -> Markdown.Blocks -> Box
660 formatDocComment elmVersion importInfo blocks =
661 let
662 parse :: String -> Maybe (ElmCodeBlock Identity [UppercaseIdentifier])
663 parse source =
664 source
665 |> firstOf
666 [ fmap DeclarationsCode . Result.toMaybe . Parse.parseDeclarations elmVersion
667 , fmap ExpressionsCode . Result.toMaybe . Parse.parseExpressions elmVersion
668 , fmap ModuleCode . Result.toMaybe . Parse.parseModule elmVersion
669 ]
670 |> fmap (convertElmCodeBlock (pure . extract))
671
672 format ::
673 (Applicative annf, Coapplicative annf) =>
674 ElmCodeBlock annf [UppercaseIdentifier] -> String
675 format result =
676 case result of
677 ModuleCode modu ->
678 formatModule elmVersion False 1 modu
679 |> (Text.unpack . Box.render)
680
681 DeclarationsCode declarations ->
682 formatModuleBody 1 elmVersion importInfo declarations
683 |> fmap (Text.unpack . Box.render)
684 |> fromMaybe ""
685
686 ExpressionsCode expressions ->
687 let
688 entryType _ = BodyUnnamed
689 in
690 expressions
691 |> fmap (fmap $ fmap $ I.convert (Identity . extract))
692 |> formatTopLevelBody 1 elmVersion importInfo entryType (formatEolCommented $ formatExpression elmVersion importInfo SyntaxSeparated)
693 |> fmap (Text.unpack . Box.render)
694 |> fromMaybe ""
695
696 content :: String
697 content =
698 ElmFormat.Render.Markdown.formatMarkdown (fmap format . parse) $ fmap cleanBlock blocks
699
700 cleanBlock :: Markdown.Block -> Markdown.Block
701 cleanBlock block =
702 case block of
703 Markdown.ElmDocs docs ->
704 Markdown.ElmDocs $
705 (fmap . fmap)
706 (Text.replace (Text.pack "(..)") (Text.pack ""))
707 docs
708 _ ->
709 block
710 in
711 formatDocCommentString content
712
713
714 formatDocCommentString :: String -> Box
715 formatDocCommentString docs =
716 case lines docs of
717 [] ->
718 line $ row [ punc "{-|", space, punc "-}" ]
719 (first:[]) ->
720 stack1
721 [ line $ row [ punc "{-|", space, literal first ]
722 , line $ punc "-}"
723 ]
724 (first:rest) ->
725 (line $ row [ punc "{-|", space, literal first ])
726 |> andThen (map (line . literal) rest)
727 |> andThen [ line $ punc "-}" ]
728
729
730 formatImport :: ElmVersion -> AST.Module.UserImport -> Box
731 formatImport elmVersion (name@(C _ rawName), method) =
732 let
733 requestedAs =
734 case AST.Module.alias method of
735 Just (C _ aliasName) | [aliasName] == rawName -> Nothing
736 other -> other
737
738 as =
739 requestedAs
740 |> fmap (formatImportClause
741 (Just . line . formatUppercaseIdentifier elmVersion)
742 "as")
743 |> Monad.join
744
745 exposing =
746 formatImportClause
747 (formatListing (formatDetailedListing elmVersion))
748 "exposing"
749 (AST.Module.exposedVars method)
750
751 formatImportClause :: (a -> Maybe Box) -> String -> C2 beforeKeyword afterKeyword a -> Maybe Box
752 formatImportClause format keyw input =
753 case fmap format input of
754 C ([], []) Nothing ->
755 Nothing
756
757 C (preKeyword, postKeyword) (Just listing') ->
758 case
759 ( formatHeadCommented (line . keyword) (C preKeyword keyw)
760 , formatHeadCommented id (C postKeyword listing')
761 )
762 of
763 (SingleLine keyword', SingleLine listing'') ->
764 Just $ line $ row
765 [ keyword'
766 , space
767 , listing''
768 ]
769
770 (keyword', listing'') ->
771 Just $ stack1
772 [ keyword'
773 , indent listing''
774 ]
775
776 _ ->
777 Just $ pleaseReport "UNEXPECTED IMPORT" "import clause comments with no clause"
778 in
779 case
780 ( formatHeadCommented (line . formatQualifiedUppercaseIdentifier elmVersion) name
781 , as
782 , exposing
783 )
784 of
785 ( SingleLine name', Just (SingleLine as'), Just (SingleLine exposing') ) ->
786 line $ row
787 [ keyword "import"
788 , space
789 , name'
790 , space
791 , as'
792 , space
793 , exposing'
794 ]
795
796 (SingleLine name', Just (SingleLine as'), Nothing) ->
797 line $ row
798 [ keyword "import"
799 , space
800 , name'
801 , space
802 , as'
803 ]
804
805 (SingleLine name', Nothing, Just (SingleLine exposing')) ->
806 line $ row
807 [ keyword "import"
808 , space
809 , name'
810 , space
811 , exposing'
812 ]
813
814 (SingleLine name', Nothing, Nothing) ->
815 line $ row
816 [ keyword "import"
817 , space
818 , name'
819 ]
820
821 ( SingleLine name', Just (SingleLine as'), Just exposing' ) ->
822 stack1
823 [ line $ row
824 [ keyword "import"
825 , space
826 , name'
827 , space
828 , as'
829 ]
830 , indent exposing'
831 ]
832
833 ( SingleLine name', Just as', Just exposing' ) ->
834 stack1
835 [ line $ row
836 [ keyword "import"
837 , space
838 , name'
839 ]
840 , indent as'
841 , indent exposing'
842 ]
843
844 ( SingleLine name', Nothing, Just exposing' ) ->
845 stack1
846 [ line $ row
847 [ keyword "import"
848 , space
849 , name'
850 ]
851 , indent exposing'
852 ]
853
854 ( name', Just as', Just exposing' ) ->
855 stack1
856 [ line $ keyword "import"
857 , indent name'
858 , indent $ indent as'
859 , indent $ indent exposing'
860 ]
861
862 ( name', Nothing, Just exposing' ) ->
863 stack1
864 [ line $ keyword "import"
865 , indent name'
866 , indent $ indent exposing'
867 ]
868
869 ( name', Just as', Nothing ) ->
870 stack1
871 [ line $ keyword "import"
872 , indent name'
873 , indent $ indent as'
874 ]
875
876 ( name', Nothing, Nothing ) ->
877 stack1
878 [ line $ keyword "import"
879 , indent name'
880 ]
881
882
883 formatListing :: (a -> [Box]) -> AST.Listing.Listing a -> Maybe Box
884 formatListing format listing =
885 case listing of
886 AST.Listing.ClosedListing ->
887 Nothing
888
889 AST.Listing.OpenListing comments ->
890 Just $ parens $ formatCommented (line . keyword) $ fmap (const "..") comments
891
892 AST.Listing.ExplicitListing vars multiline ->
893 case format vars of
894 [] -> Nothing
895 vars' -> Just $ ElmStructure.group False "(" "," ")" multiline vars'
896
897
898 formatDetailedListing :: ElmVersion -> AST.Module.DetailedListing -> [Box]
899 formatDetailedListing elmVersion listing =
900 concat
901 [ formatCommentedMap
902 (\name () -> AST.Listing.OpValue name)
903 (formatVarValue elmVersion)
904 (AST.Module.operators listing)
905 , formatCommentedMap
906 (\name (C inner listing_) -> AST.Listing.Union (C inner name) listing_)
907 (formatVarValue elmVersion)
908 (AST.Module.types listing)
909 , formatCommentedMap
910 (\name () -> AST.Listing.Value name)
911 (formatVarValue elmVersion)
912 (AST.Module.values listing)
913 ]
914
915
916 formatCommentedMap :: (k -> v -> a) -> (a -> Box) -> AST.Listing.CommentedMap k v -> [Box]
917 formatCommentedMap construct format values =
918 let
919 format' (k, C c v)
920 = formatCommented format $ C c (construct k v)
921 in
922 values
923 |> Map.assocs
924 |> map format'
925
926
927 formatVarValue :: ElmVersion -> AST.Listing.Value -> Box
928 formatVarValue elmVersion aval =
929 case aval of
930 AST.Listing.Value val ->
931 line $ formatLowercaseIdentifier elmVersion [] val
932
933 AST.Listing.OpValue (SymbolIdentifier name) ->
934 line $ identifier $ "(" ++ name ++ ")"
935
936 AST.Listing.Union name listing ->
937 case
938 ( formatListing
939 (formatCommentedMap
940 (\name_ () -> name_)
941 (line . formatUppercaseIdentifier elmVersion)
942 )
943 listing
944 , formatTailCommented (line . formatUppercaseIdentifier elmVersion) name
945 , (\(C c _) -> c) name
946 , elmVersion
947 )
948 of
949 (Just _, _, _, Elm_0_19) ->
950 formatTailCommented
951 (\n -> line $ row [ formatUppercaseIdentifier elmVersion n, keyword "(..)" ])
952 name
953
954 (Just (SingleLine listing'), SingleLine name', [], _) ->
955 line $ row
956 [ name'
957 , listing'
958 ]
959
960 (Just (SingleLine listing'), SingleLine name', _, _) ->
961 line $ row
962 [ name'
963 , space
964 , listing'
965 ]
966
967 (Just listing', name', _, _) ->
968 stack1
969 [ name'
970 , indent $ listing'
971 ]
972
973 (Nothing, name', _, _) ->
974 name'
975
976
977 formatTopLevelStructure :: ElmVersion -> ImportInfo [UppercaseIdentifier] -> (a -> Box) -> TopLevelStructure a -> Box
978 formatTopLevelStructure elmVersion importInfo formatEntry topLevelStructure =
979 case topLevelStructure of
980 DocComment docs ->
981 formatDocComment elmVersion importInfo docs
982
983 BodyComment c ->
984 formatComment c
985
986 Entry entry ->
987 formatEntry entry
988
989
990 formatCommonDeclaration ::
991 Coapplicative annf =>
992 ElmVersion -> ImportInfo [UppercaseIdentifier] -> ASTNS annf [UppercaseIdentifier] 'CommonDeclarationNK -> Box
993 formatCommonDeclaration elmVersion importInfo decl =
994 case extract $ I.unFix $ I.convert (Identity . extract) decl of
995 Definition name args comments expr ->
996 formatDefinition elmVersion importInfo name args comments expr
997
998 TypeAnnotation name typ ->
999 formatTypeAnnotation elmVersion name typ
1000
1001
1002 formatDeclaration ::
1003 Coapplicative annf =>
1004 ElmVersion -> ImportInfo [UppercaseIdentifier] -> ASTNS annf [UppercaseIdentifier] 'TopLevelDeclarationNK -> Box
1005 formatDeclaration elmVersion importInfo decl =
1006 case extract $ I.unFix $ I.convert (Identity . extract) decl of
1007 CommonDeclaration def ->
1008 formatCommonDeclaration elmVersion importInfo def
1009
1010 Datatype nameWithArgs tags ->
1011 let
1012 ctor (NameWithArgs tag args') =
1013 case allSingles $ map (formatHeadCommented $ formatType' elmVersion ForCtor) args' of
1014 Right args'' ->
1015 line $ row $ List.intersperse space $ (formatUppercaseIdentifier elmVersion tag):args''
1016 Left [] ->
1017 line $ formatUppercaseIdentifier elmVersion tag
1018 Left args'' ->
1019 stack1
1020 [ line $ formatUppercaseIdentifier elmVersion tag
1021 , stack1 args''
1022 |> indent
1023 ]
1024 in
1025 case
1026 formatOpenCommentedList ctor tags
1027 of
1028 [] -> error "List can't be empty"
1029 first:rest ->
1030 case formatCommented (formatNameWithArgs elmVersion) nameWithArgs of
1031 SingleLine nameWithArgs' ->
1032 stack1
1033 [ line $ row
1034 [ keyword "type"
1035 , space
1036 , nameWithArgs'
1037 ]
1038 , first
1039 |> prefix (row [punc "=", space])
1040 |> andThen (map (prefix (row [punc "|", space])) rest)
1041 |> indent
1042 ]
1043 nameWithArgs' ->
1044 stack1
1045 [ line $ keyword "type"
1046 , indent $ nameWithArgs'
1047 , first
1048 |> prefix (row [punc "=", space])
1049 |> andThen (map (prefix (row [punc "|", space])) rest)
1050 |> indent
1051 ]
1052
1053 TypeAlias preAlias nameWithArgs typ ->
1054 ElmStructure.definition "=" True
1055 (line $ keyword "type")
1056 [ formatHeadCommented (line . keyword) (C preAlias "alias")
1057 , formatCommented (formatNameWithArgs elmVersion) nameWithArgs
1058 ]
1059 (formatHeadCommentedStack (formatType elmVersion) typ)
1060
1061 PortAnnotation name typeComments typ ->
1062 ElmStructure.definition ":" False
1063 (line $ keyword "port")
1064 [ formatCommented (line . formatLowercaseIdentifier elmVersion []) name ]
1065 (formatCommented' typeComments (formatType elmVersion) typ)
1066
1067 PortDefinition_until_0_16 name bodyComments expr ->
1068 ElmStructure.definition "=" True
1069 (line $ keyword "port")
1070 [formatCommented (line . formatLowercaseIdentifier elmVersion []) name]
1071 (formatCommented' bodyComments (formatExpression elmVersion importInfo SyntaxSeparated) $ expr)
1072
1073 Fixity_until_0_18 assoc precedenceComments precedence nameComments name ->
1074 case
1075 ( formatCommented' nameComments (line . formatInfixVar elmVersion) name
1076 , formatCommented' precedenceComments (line . literal . show) precedence
1077 )
1078 of
1079 (SingleLine name', SingleLine precedence') ->
1080 line $ row
1081 [ case assoc of
1082 L -> keyword "infixl"
1083 R -> keyword "infixr"
1084 N -> keyword "infix"
1085 , space
1086 , precedence'
1087 , space
1088 , name'
1089 ]
1090 _ ->
1091 pleaseReport "TODO" "multiline fixity declaration"
1092
1093 Fixity assoc precedence name value ->
1094 let
1095 formatAssoc a =
1096 case a of
1097 L -> keyword "left "
1098 R -> keyword "right"
1099 N -> keyword "non "
1100 in
1101 ElmStructure.spaceSepOrIndented
1102 (line $ keyword "infix")
1103 [ formatHeadCommented (line . formatAssoc) assoc
1104 , formatHeadCommented (line . literal . show) precedence
1105 , formatCommented (line . formatSymbolIdentifierInParens) name
1106 , line $ keyword "="
1107 , formatHeadCommented (line . identifier . formatVarName elmVersion) value
1108 ]
1109
1110
1111 formatNameWithArgs :: ElmVersion -> NameWithArgs UppercaseIdentifier LowercaseIdentifier -> Box
1112 formatNameWithArgs elmVersion (NameWithArgs name args) =
1113 case allSingles $ map (formatHeadCommented (line . formatLowercaseIdentifier elmVersion [])) args of
1114 Right args' ->
1115 line $ row $ List.intersperse space $ ((formatUppercaseIdentifier elmVersion name):args')
1116 Left args' ->
1117 stack1 $
1118 [ line $ formatUppercaseIdentifier elmVersion name ]
1119 ++ (map indent args')
1120
1121
1122 formatDefinition ::
1123 ElmVersion
1124 -> ImportInfo [UppercaseIdentifier]
1125 -> ASTNS Identity [UppercaseIdentifier] 'PatternNK
1126 -> [C1 before (ASTNS Identity [UppercaseIdentifier] 'PatternNK)]
1127 -> Comments
1128 -> ASTNS Identity [UppercaseIdentifier] 'ExpressionNK
1129 -> Box
1130 formatDefinition elmVersion importInfo name args comments expr =
1131 let
1132 body =
1133 stack1 $ concat
1134 [ map formatComment comments
1135 , [ formatExpression elmVersion importInfo SyntaxSeparated expr ]
1136 ]
1137 in
1138 ElmStructure.definition "=" True
1139 (formatPattern elmVersion True name)
1140 (map (\(C x y) -> formatCommented' x (formatPattern elmVersion True) y) args)
1141 body
1142
1143
1144 formatTypeAnnotation ::
1145 Coapplicative annf =>
1146 ElmVersion -> C1 after (Ref ()) -> C1 before (ASTNS annf [UppercaseIdentifier] 'TypeNK) -> Box
1147 formatTypeAnnotation elmVersion name typ =
1148 ElmStructure.definition ":" False
1149 (formatTailCommented (line . formatVar elmVersion . fmap (\() -> [])) name)
1150 []
1151 (formatHeadCommented (formatType elmVersion) typ)
1152
1153
1154 formatPattern ::
1155 Coapplicative annf =>
1156 ElmVersion -> Bool -> ASTNS annf [UppercaseIdentifier] 'PatternNK -> Box
1157 formatPattern elmVersion parensRequired apattern =
1158 case extract $ I.unFix apattern of
1159 Anything ->
1160 line $ keyword "_"
1161
1162 UnitPattern comments ->
1163 formatUnit '(' ')' comments
1164
1165 LiteralPattern lit ->
1166 formatLiteral elmVersion lit
1167
1168 VarPattern var ->
1169 line $ formatLowercaseIdentifier elmVersion [] var
1170
1171 OpPattern (SymbolIdentifier name) ->
1172 line $ identifier $ "(" ++ name ++ ")"
1173
1174 ConsPattern first rest ->
1175 let
1176 formatRight (C (preOp, postOp, eol) term) =
1177 ( False
1178 , preOp
1179 , line $ punc "::"
1180 , formatC2Eol $
1181 (fmap $ formatPattern elmVersion True)
1182 (C (postOp, [], eol) term)
1183 )
1184 in
1185 formatBinary False
1186 (formatEolCommented (formatPattern elmVersion True) first)
1187 (fmap formatRight $ toCommentedList rest)
1188 |> if parensRequired then parens else id
1189
1190 DataPattern (ns, tag) [] ->
1191 let
1192 ctor = ns ++ [tag]
1193 in
1194 line (formatQualifiedUppercaseIdentifier elmVersion ctor)
1195 |>
1196 case (elmVersion, ctor) of
1197 (Elm_0_16, [_]) ->
1198 id
1199 (Elm_0_16, _) ->
1200 if parensRequired then parens else id
1201 _ ->
1202 id
1203
1204 DataPattern (ns, tag) patterns ->
1205 let
1206 ctor = ns ++ [tag]
1207 in
1208 ElmStructure.application
1209 (FAJoinFirst JoinAll)
1210 (line $ formatQualifiedUppercaseIdentifier elmVersion ctor)
1211 (map (formatHeadCommented $ formatPattern elmVersion True) patterns)
1212 |> if parensRequired then parens else id
1213
1214 PatternParens pattern ->
1215 formatCommented (formatPattern elmVersion False) pattern
1216 |> parens
1217
1218 TuplePattern patterns ->
1219 ElmStructure.group True "(" "," ")" False $ map (formatCommented $ formatPattern elmVersion False) patterns
1220
1221 EmptyListPattern comments ->
1222 formatUnit '[' ']' comments
1223
1224 ListPattern patterns ->
1225 ElmStructure.group True "[" "," "]" False $ map (formatCommented $ formatPattern elmVersion False) patterns
1226
1227 EmptyRecordPattern comments ->
1228 formatUnit '{' '}' comments
1229
1230 RecordPattern fields ->
1231 ElmStructure.group True "{" "," "}" False $ map (formatCommented $ line . formatLowercaseIdentifier elmVersion []) fields
1232
1233 Alias pattern name ->
1234 case
1235 ( formatTailCommented (formatPattern elmVersion True) pattern
1236 , formatHeadCommented (line . formatLowercaseIdentifier elmVersion []) name
1237 )
1238 of
1239 (SingleLine pattern', SingleLine name') ->
1240 line $ row
1241 [ pattern'
1242 , space
1243 , keyword "as"
1244 , space
1245 , name'
1246 ]
1247
1248 (pattern', name') ->
1249 stack1
1250 [ pattern'
1251 , line $ keyword "as"
1252 , indent name'
1253 ]
1254
1255 |> (if parensRequired then parens else id)
1256
1257
1258 formatRecordPair :: ElmVersion -> String -> (v -> Box) -> (C2 before after LowercaseIdentifier, C2 before after v, Bool) -> Box
1259 formatRecordPair elmVersion delim formatValue (C (pre, postK) k, v, forceMultiline) =
1260 ElmStructure.equalsPair delim forceMultiline
1261 (formatCommented (line . formatLowercaseIdentifier elmVersion []) $ C ([], postK) k)
1262 (formatCommented formatValue v)
1263 |> C (pre, []) |> formatCommented id
1264
1265
1266 formatPair :: (a -> Line) -> String -> (b -> Box) -> Pair a b -> Box
1267 formatPair formatA delim formatB (Pair a b (ForceMultiline forceMultiline)) =
1268 ElmStructure.equalsPair delim forceMultiline
1269 (formatTailCommented (line . formatA) a)
1270 (formatHeadCommented formatB b)
1271
1272
1273 negativeCasePatternWorkaround ::
1274 Coapplicative annf =>
1275 ASTNS annf [UppercaseIdentifier] 'PatternNK -> Box -> Box
1276 negativeCasePatternWorkaround pattern =
1277 case extract $ I.unFix pattern of
1278 LiteralPattern (IntNum i _) | i < 0 -> parens
1279 LiteralPattern (FloatNum f _) | f < 0 -> parens
1280 _ -> id
1281
1282
1283 data ExpressionContext
1284 = SyntaxSeparated
1285 | InfixSeparated
1286 | SpaceSeparated
1287 | AmbiguousEnd
1288
1289
1290 expressionParens :: ExpressionContext -> ExpressionContext -> Box -> Box
1291 expressionParens inner outer =
1292 case (inner, outer) of
1293 (SpaceSeparated, SpaceSeparated) -> parens
1294 (InfixSeparated, SpaceSeparated) -> parens
1295 (InfixSeparated, InfixSeparated) -> parens
1296 (AmbiguousEnd, SpaceSeparated) -> parens
1297 (AmbiguousEnd, InfixSeparated) -> parens
1298 (InfixSeparated, AmbiguousEnd) -> parens
1299 _ -> id
1300
1301
1302 formatExpression ::
1303 ElmVersion -> ImportInfo [UppercaseIdentifier] -> ExpressionContext
1304 -> ASTNS Identity [UppercaseIdentifier] 'ExpressionNK
1305 -> Box
1306 formatExpression elmVersion importInfo context aexpr =
1307 case extract $ I.unFix aexpr of
1308 Literal lit ->
1309 formatLiteral elmVersion lit
1310
1311 VarExpr v ->
1312 line $ formatVar elmVersion v
1313
1314 Range left right multiline ->
1315 case elmVersion of
1316 Elm_0_16 -> formatRange_0_17 elmVersion importInfo left right multiline
1317 Elm_0_17 -> formatRange_0_17 elmVersion importInfo left right multiline
1318 Elm_0_18 -> formatRange_0_18 elmVersion importInfo context left right
1319 Elm_0_19 -> formatRange_0_18 elmVersion importInfo context left right
1320
1321 ExplicitList exprs trailing multiline ->
1322 formatSequence '[' ',' (Just ']')
1323 (formatExpression elmVersion importInfo SyntaxSeparated)
1324 multiline
1325 trailing
1326 exprs
1327
1328 Binops left ops multiline ->
1329 formatBinops elmVersion importInfo left ops multiline
1330 |> expressionParens InfixSeparated context
1331
1332 Lambda patterns bodyComments expr multiline ->
1333 case
1334 ( multiline
1335 , allSingles $ map (formatCommented (formatPattern elmVersion True) . (\(C c p) -> C (c, []) p)) patterns
1336 , bodyComments == []
1337 , formatExpression elmVersion importInfo SyntaxSeparated expr
1338 )
1339 of
1340 (False, Right patterns', True, SingleLine expr') ->
1341 line $ row
1342 [ punc "\\"
1343 , row $ List.intersperse space $ patterns'
1344 , space
1345 , punc "->"
1346 , space
1347 , expr'
1348 ]
1349 (_, Right patterns', _, expr') ->
1350 stack1
1351 [ line $ row
1352 [ punc "\\"
1353 , row $ List.intersperse space $ patterns'
1354 , space
1355 , punc "->"
1356 ]
1357 , indent $ stack1 $
1358 (map formatComment bodyComments)
1359 ++ [ expr' ]
1360 ]
1361 (_, Left [], _, _) ->
1362 pleaseReport "UNEXPECTED LAMBDA" "no patterns"
1363 (_, Left patterns', _, expr') ->
1364 stack1
1365 [ prefix (punc "\\") $ stack1 patterns'
1366 , line $ punc "->"
1367 , indent $ stack1 $
1368 (map formatComment bodyComments)
1369 ++ [ expr' ]
1370 ]
1371 |> expressionParens AmbiguousEnd context
1372
1373 Unary Negative e ->
1374 prefix (punc "-") $ formatExpression elmVersion importInfo SpaceSeparated e -- TODO: This might need something stronger than SpaceSeparated?
1375
1376 App left [] _ ->
1377 formatExpression elmVersion importInfo context left
1378
1379 App left args multiline ->
1380 ElmStructure.application
1381 multiline
1382 (formatExpression elmVersion importInfo InfixSeparated left)
1383 (fmap (formatPreCommentedExpression elmVersion importInfo SpaceSeparated) args)
1384 |> expressionParens SpaceSeparated context
1385
1386 If if' elseifs (C elsComments els) ->
1387 let
1388 opening key cond =
1389 case (key, cond) of
1390 (SingleLine key', SingleLine cond') ->
1391 line $ row
1392 [ key'
1393 , space
1394 , cond'
1395 , space
1396 , keyword "then"
1397 ]
1398 _ ->
1399 stack1
1400 [ key
1401 , cond |> indent
1402 , line $ keyword "then"
1403 ]
1404
1405 formatIf (IfClause cond body) =
1406 stack1
1407 [ opening (line $ keyword "if") $ formatCommentedExpression elmVersion importInfo SyntaxSeparated cond
1408 , indent $ formatCommented_ True (formatExpression elmVersion importInfo SyntaxSeparated) body
1409 ]
1410
1411 formatElseIf (C ifComments (IfClause cond body)) =
1412 let
1413 key =
1414 case formatHeadCommented id (C ifComments $ line $ keyword "if") of
1415 SingleLine key' ->
1416 line $ row [ keyword "else", space, key' ]
1417 key' ->
1418 stack1
1419 [ line $ keyword "else"
1420 , key'
1421 ]
1422 in
1423 stack1
1424 [ blankLine
1425 , opening key $ formatCommentedExpression elmVersion importInfo SyntaxSeparated cond
1426 , indent $ formatCommented_ True (formatExpression elmVersion importInfo SyntaxSeparated) body
1427 ]
1428 in
1429 formatIf if'
1430 |> andThen (fmap formatElseIf elseifs)
1431 |> andThen
1432 [ blankLine
1433 , line $ keyword "else"
1434 , indent $ formatCommented_ True (formatExpression elmVersion importInfo SyntaxSeparated) (C (elsComments, []) els)
1435 ]
1436 |> expressionParens AmbiguousEnd context
1437
1438 Let defs bodyComments expr ->
1439 let
1440 spacer :: AST typeRef ctorRef varRef (I.Fix Identity (AST typeRef ctorRef varRef)) 'LetDeclarationNK -> AST typeRef ctorRef varRef getType 'LetDeclarationNK -> [Box]
1441 spacer first _ =
1442 case first of
1443 LetCommonDeclaration (I.Fix (Identity (Definition _ _ _ _))) ->
1444 [ blankLine ]
1445 _ ->
1446 []
1447
1448 formatDefinition' def =
1449 case def of
1450 LetCommonDeclaration (I.Fix (Identity (Definition name args comments expr'))) ->
1451 formatDefinition elmVersion importInfo name args comments expr'
1452
1453 LetCommonDeclaration (I.Fix (Identity (TypeAnnotation name typ))) ->
1454 formatTypeAnnotation elmVersion name typ
1455
1456 LetComment comment ->
1457 formatComment comment
1458 in
1459 line (keyword "let")
1460 |> andThen
1461 (defs
1462 |> fmap (extract . I.unFix)
1463 |> intersperseMap spacer formatDefinition'
1464 |> map indent
1465 )
1466 |> andThen
1467 [ line $ keyword "in"
1468 , stack1 $
1469 (map formatComment bodyComments)
1470 ++ [formatExpression elmVersion importInfo SyntaxSeparated expr]
1471 ]
1472 |> expressionParens AmbiguousEnd context -- TODO: not tested
1473
1474 Case (subject,multiline) clauses ->
1475 let
1476 opening =
1477 case
1478 ( multiline
1479 , formatCommentedExpression elmVersion importInfo SyntaxSeparated subject
1480 )
1481 of
1482 (False, SingleLine subject') ->
1483 line $ row
1484 [ keyword "case"
1485 , space
1486 , subject'
1487 , space
1488 , keyword "of"
1489 ]
1490 (_, subject') ->
1491 stack1
1492 [ line $ keyword "case"
1493 , indent subject'
1494 , line $ keyword "of"
1495 ]
1496
1497 clause (CaseBranch prePat postPat preExpr pat expr) =
1498 case
1499 ( postPat
1500 , (formatPattern elmVersion False pat)
1501 |> negativeCasePatternWorkaround pat
1502 , formatCommentedStack (formatPattern elmVersion False) (C (prePat, postPat) pat)
1503 |> negativeCasePatternWorkaround pat
1504 , formatHeadCommentedStack (formatExpression elmVersion importInfo SyntaxSeparated) (C preExpr expr)
1505 )
1506 of
1507 (_, _, SingleLine pat', body') ->
1508 stack1
1509 [ line $ row [ pat', space, keyword "->"]
1510 , indent body'
1511 ]
1512 ([], SingleLine pat', _, body') ->
1513 stack1 $
1514 (map formatComment prePat)
1515 ++ [ line $ row [ pat', space, keyword "->"]
1516 , indent body'
1517 ]
1518 (_, _, pat', body') ->
1519 stack1 $
1520 [ pat'
1521 , line $ keyword "->"
1522 , indent body'
1523 ]
1524 in
1525 opening
1526 |> andThen
1527 (clauses
1528 |> fmap (clause . extract . I.unFix)
1529 |> List.intersperse blankLine
1530 |> map indent
1531 )
1532 |> expressionParens AmbiguousEnd context -- TODO: not tested
1533
1534 Tuple exprs multiline ->
1535 ElmStructure.group True "(" "," ")" multiline $ map (formatCommentedExpression elmVersion importInfo SyntaxSeparated) exprs
1536
1537 TupleFunction n ->
1538 line $ keyword $ "(" ++ (List.replicate (n-1) ',') ++ ")"
1539
1540 Access expr field ->
1541 formatExpression elmVersion importInfo SpaceSeparated expr -- TODO: does this need a different context than SpaceSeparated?
1542 |> addSuffix (row $ [punc ".", formatLowercaseIdentifier elmVersion [] field])
1543
1544 AccessFunction (LowercaseIdentifier field) ->
1545 line $ identifier $ "." ++ (formatVarName' elmVersion field)
1546
1547 Record base fields trailing multiline ->
1548 formatRecordLike
1549 (line . formatLowercaseIdentifier elmVersion [])
1550 (formatLowercaseIdentifier elmVersion [])
1551 "="
1552 (formatExpression elmVersion importInfo SyntaxSeparated)
1553 base fields trailing multiline
1554
1555 Parens expr ->
1556 case expr of
1557 C ([], []) expr' ->
1558 formatExpression elmVersion importInfo context expr'
1559
1560 _ ->
1561 formatCommentedExpression elmVersion importInfo SyntaxSeparated expr
1562 |> parens
1563
1564
1565 Unit comments ->
1566 formatUnit '(' ')' comments
1567
1568 GLShader src ->
1569 line $ row
1570 [ punc "[glsl|"
1571 , literal $ src
1572 , punc "|]"
1573 ]
1574
1575
1576 formatCommentedExpression ::
1577 ElmVersion -> ImportInfo [UppercaseIdentifier] -> ExpressionContext
1578 -> C2 before after (ASTNS Identity [UppercaseIdentifier] 'ExpressionNK)
1579 -> Box
1580 formatCommentedExpression elmVersion importInfo context (C (pre, post) e) =
1581 let
1582 commented' =
1583 case extract $ I.unFix e of
1584 Parens (C (pre'', post'') e'') ->
1585 C (pre ++ pre'', post'' ++ post) e''
1586 _ -> C (pre, post) e
1587 in
1588 formatCommented (formatExpression elmVersion importInfo context) commented'
1589
1590
1591 formatPreCommentedExpression ::
1592 Coapplicative annf =>
1593 ElmVersion -> ImportInfo [UppercaseIdentifier] -> ExpressionContext
1594 -> C1 before (ASTNS annf [UppercaseIdentifier] 'ExpressionNK)
1595 -> Box
1596 formatPreCommentedExpression elmVersion importInfo context (C pre e) =
1597 let
1598 (pre', e') =
1599 case extract $ I.unFix e of
1600 Parens (C (pre'', []) e'') ->
1601 (pre ++ pre'', e'')
1602 _ -> (pre, e)
1603 in
1604 formatCommented' pre' (formatExpression elmVersion importInfo context) (I.convert (Identity . extract) e')
1605
1606
1607 formatRecordLike ::
1608 (base -> Box) -> (key -> Line) -> String -> (value -> Box)
1609 -> Maybe (C2 before after base) -> Sequence (Pair key value)-> Comments -> ForceMultiline
1610 -> Box
1611 formatRecordLike formatBase formatKey fieldSep formatValue base' fields trailing multiline =
1612 case (base', fields) of
1613 ( Just base, pairs' ) ->
1614 ElmStructure.extensionGroup'
1615 ((\(ForceMultiline b) -> b) multiline)
1616 (formatCommented formatBase base)
1617 (formatSequence '|' ',' Nothing
1618 (formatPair formatKey fieldSep formatValue)
1619 multiline
1620 trailing
1621 pairs')
1622
1623 ( Nothing, pairs' ) ->
1624 formatSequence '{' ',' (Just '}')
1625 (formatPair formatKey fieldSep formatValue)
1626 multiline
1627 trailing
1628 pairs'
1629
1630
1631 formatSequence :: Char -> Char -> Maybe Char -> (a -> Box) -> ForceMultiline -> Comments -> Sequence a -> Box
1632 formatSequence left delim right formatA (ForceMultiline multiline) trailing (Sequence (first:rest)) =
1633 let
1634 formatItem delim_ (C (pre, post, eol) item) =
1635 maybe id (stack' . stack' blankLine) (formatComments pre) $
1636 prefix (row [ punc [delim_], space ]) $
1637 formatC2Eol $ C (post, [], eol) $ formatA item
1638 in
1639 ElmStructure.forceableSpaceSepOrStack multiline
1640 (ElmStructure.forceableRowOrStack multiline
1641 (formatItem left first)
1642 (map (formatItem delim) rest)
1643 )
1644 (maybe [] (flip (:) [] . stack' blankLine) (formatComments trailing) ++ (Maybe.maybeToList $ fmap (line . punc . flip (:) []) right))
1645 formatSequence left _ (Just right) _ _ trailing (Sequence []) =
1646 formatUnit left right trailing
1647 formatSequence left _ Nothing _ _ trailing (Sequence []) =
1648 formatUnit left ' ' trailing
1649
1650
1651 mapIsLast :: (Bool -> a -> b) -> [a] -> [b]
1652 mapIsLast _ [] = []
1653 mapIsLast f (last_:[]) = f True last_ : []
1654 mapIsLast f (next:rest) = f False next : mapIsLast f rest
1655
1656
1657 formatBinops ::
1658 ElmVersion
1659 -> ImportInfo [UppercaseIdentifier]
1660 -> ASTNS Identity [UppercaseIdentifier] 'ExpressionNK
1661 -> [BinopsClause (Ref [UppercaseIdentifier]) (ASTNS Identity [UppercaseIdentifier] 'ExpressionNK)]
1662 -> Bool
1663 -> Box
1664 formatBinops elmVersion importInfo left ops multiline =
1665 let
1666 formatPair_ isLast (BinopsClause po o pe e) =
1667 let
1668 isLeftPipe =
1669 o == OpRef (SymbolIdentifier "<|")
1670
1671 formatContext =
1672 if isLeftPipe && isLast
1673 then AmbiguousEnd
1674 else InfixSeparated
1675 in
1676 ( isLeftPipe
1677 , po
1678 , (line . formatInfixVar elmVersion) o
1679 , formatCommented' pe (formatExpression elmVersion importInfo formatContext) e
1680 )
1681 in
1682 formatBinary
1683 multiline
1684 (formatExpression elmVersion importInfo InfixSeparated left)
1685 (mapIsLast formatPair_ ops)
1686
1687
1688 formatRange_0_17 ::
1689 ElmVersion -> ImportInfo [UppercaseIdentifier]
1690 -> C2 before after (ASTNS Identity [UppercaseIdentifier] 'ExpressionNK)
1691 -> C2 before after (ASTNS Identity [UppercaseIdentifier] 'ExpressionNK)
1692 -> Bool
1693 -> Box
1694 formatRange_0_17 elmVersion importInfo left right multiline =
1695 case
1696 ( multiline
1697 , formatCommentedExpression elmVersion importInfo SyntaxSeparated left
1698 , formatCommentedExpression elmVersion importInfo SyntaxSeparated right
1699 )
1700 of
1701 (False, SingleLine left', SingleLine right') ->
1702 line $ row
1703 [ punc "["
1704 , left'
1705 , punc ".."
1706 , right'
1707 , punc "]"
1708 ]
1709 (_, left', right') ->
1710 stack1
1711 [ line $ punc "["
1712 , indent left'
1713 , line $ punc ".."
1714 , indent right'
1715 , line $ punc "]"
1716 ]
1717
1718 nowhere :: Region.Position
1719 nowhere =
1720 Region.Position 0 0
1721
1722
1723 noRegion :: a -> RA.Located a
1724 noRegion =
1725 RA.at nowhere nowhere
1726
1727 formatRange_0_18 ::
1728 Coapplicative annf =>
1729 ElmVersion -> ImportInfo [UppercaseIdentifier] -> ExpressionContext
1730 -> C2 before after (ASTNS annf [UppercaseIdentifier] 'ExpressionNK)
1731 -> C2 before after (ASTNS annf [UppercaseIdentifier] 'ExpressionNK)
1732 -> Box
1733 formatRange_0_18 elmVersion importInfo context left right =
1734 case (left, right) of
1735 (C (preLeft, []) left', C (preRight, []) right') ->
1736 App
1737 (I.Fix $ Identity $ VarExpr $ VarRef [UppercaseIdentifier "List"] $ LowercaseIdentifier "range")
1738 [ C preLeft $ I.convert (pure . extract) left'
1739 , C preRight $ I.convert (pure . extract) right'
1740 ]
1741 (FAJoinFirst JoinAll)
1742 |> (I.Fix . pure)
1743 |> formatExpression elmVersion importInfo context
1744
1745 _ ->
1746 App
1747 (I.Fix $ Identity $ VarExpr $ VarRef [UppercaseIdentifier "List"] $ LowercaseIdentifier "range")
1748 [ C [] $ I.Fix $ pure $ Parens $ fmap (I.convert (pure . extract)) left
1749 , C [] $ I.Fix $ pure $ Parens $ fmap (I.convert (pure . extract)) right
1750 ]
1751 (FAJoinFirst JoinAll)
1752 |> (I.Fix . pure)
1753 |> formatExpression elmVersion importInfo context
1754
1755
1756 formatUnit :: Char -> Char -> Comments -> Box
1757 formatUnit left right comments =
1758 case (left, comments) of
1759 (_, []) ->
1760 line $ punc (left : right : [])
1761
1762 ('{', (LineComment _):_) ->
1763 surround left right $ prefix space $ stack1 $ map formatComment comments
1764
1765 _ ->
1766 surround left right $
1767 case allSingles $ map formatComment comments of
1768 Right comments' ->
1769 line $ row $ List.intersperse space comments'
1770
1771 Left comments' ->
1772 stack1 comments'
1773
1774
1775 formatComments :: Comments -> Maybe Box
1776 formatComments comments =
1777 case fmap formatComment comments of
1778 [] ->
1779 Nothing
1780
1781 (first:rest) ->
1782 Just $ ElmStructure.spaceSepOrStack first rest
1783
1784
1785 formatCommented_ :: Bool -> (a -> Box) -> C2 before after a -> Box
1786 formatCommented_ forceMultiline format (C (pre, post) inner) =
1787 ElmStructure.forceableSpaceSepOrStack1 forceMultiline $
1788 concat
1789 [ Maybe.maybeToList $ formatComments pre
1790 , [format inner]
1791 , Maybe.maybeToList $ formatComments post
1792 ]
1793
1794
1795 formatCommented :: (a -> Box) -> C2 before after a -> Box
1796 formatCommented =
1797 formatCommented_ False
1798
1799
1800 -- TODO: rename to formatPreCommented
1801 formatHeadCommented :: (a -> Box) -> (C1 before a) -> Box
1802 formatHeadCommented format (C pre inner) =
1803 formatCommented' pre format inner
1804
1805
1806 formatCommented' :: Comments -> (a -> Box) -> a -> Box
1807 formatCommented' pre format inner =
1808 formatCommented format (C (pre, []) inner)
1809
1810
1811 formatTailCommented :: (a -> Box) -> C1 after a -> Box
1812 formatTailCommented format (C post inner) =
1813 formatCommented format (C ([], post) inner)
1814
1815
1816 formatC2Eol :: C2Eol before after Box -> Box
1817 formatC2Eol (C (pre, post, eol) a) =
1818 formatCommented id $ C (pre, post) $ formatEolCommented id $ C eol a
1819
1820
1821 formatEolCommented :: (a -> Box) -> C0Eol a -> Box
1822 formatEolCommented format (C post inner) =
1823 case (post, format inner) of
1824 (Nothing, box) -> box
1825 (Just eol, SingleLine result) ->
1826 mustBreak $ row [ result, space, punc "--", literal eol ]
1827 (Just eol, box) ->
1828 stack1 [ box, formatComment $ LineComment eol ]
1829
1830
1831 formatCommentedStack :: (a -> Box) -> C2 before after a -> Box
1832 formatCommentedStack format (C (pre, post) inner) =
1833 stack1 $
1834 (map formatComment pre)
1835 ++ [ format inner ]
1836 ++ (map formatComment post)
1837
1838
1839 formatHeadCommentedStack :: (a -> Box) -> (C1 before a) -> Box
1840 formatHeadCommentedStack format (C pre inner) =
1841 formatCommentedStack format (C (pre, []) inner)
1842
1843
1844 formatKeywordCommented :: String -> (a -> Box) -> C2 beforeKeyword afterKeyword a -> Box
1845 formatKeywordCommented word format (C (pre, post) value) =
1846 ElmStructure.spaceSepOrIndented
1847 (formatCommented (line . keyword) (C (pre, post) word))
1848 [ format value ]
1849
1850
1851 formatOpenCommentedList :: (a -> Box) -> OpenCommentedList a -> [Box]
1852 formatOpenCommentedList format (OpenCommentedList rest (C (preLst, eol) lst)) =
1853 (fmap (formatC2Eol . fmap format) rest)
1854 ++ [formatC2Eol $ fmap format $ C (preLst, [], eol) lst]
1855
1856
1857 formatComment :: Comment -> Box
1858 formatComment comment =
1859 case comment of
1860 BlockComment c ->
1861 case c of
1862 [] ->
1863 line $ punc "{- -}"
1864 [l] ->
1865 line $ row
1866 [ punc "{-"
1867 , space
1868 , literal l
1869 , space
1870 , punc "-}"
1871 ]
1872 ls ->
1873 stack1
1874 [ prefix
1875 (row [ punc "{-", space ])
1876 (stack1 $ map (line . literal) ls)
1877 , line $ punc "-}"
1878 ]
1879
1880 LineComment c ->
1881 mustBreak $ row [ punc "--", literal c ]
1882
1883 CommentTrickOpener ->
1884 mustBreak $ punc "{--}"
1885
1886 CommentTrickCloser ->
1887 mustBreak $ punc "--}"
1888
1889 CommentTrickBlock c ->
1890 mustBreak $ row [ punc "{--", literal c, punc "-}" ]
1891
1892
1893 formatLiteral :: ElmVersion -> LiteralValue -> Box
1894 formatLiteral elmVersion lit =
1895 case lit of
1896 IntNum i DecimalInt ->
1897 line $ literal $ show i
1898 IntNum i HexadecimalInt ->
1899 line $ literal $
1900 if i < -0xFFFFFFFF then
1901 printf "-0x%016X" (-i)
1902 else if i < -0xFFFF then
1903 printf "-0x%08X" (-i)
1904 else if i < -0xFF then
1905 printf "-0x%04X" (-i)
1906 else if i < 0 then
1907 printf "-0x%02X" (-i)
1908 else if i <= 0xFF then
1909 printf "0x%02X" i
1910 else if i <= 0xFFFF then
1911 printf "0x%04X" i
1912 else if i <= 0xFFFFFFFF then
1913 printf "0x%08X" i
1914 else
1915 printf "0x%016X" i
1916 FloatNum f DecimalFloat ->
1917 line $ literal $ printf "%f" f
1918 FloatNum f ExponentFloat ->
1919 line $ literal $ printf "%e" f
1920 Chr c ->
1921 formatString elmVersion SChar [c]
1922 Str s multi ->
1923 formatString elmVersion (SString multi) s
1924 Boolean b ->
1925 line $ literal $ show b
1926
1927
1928 data StringStyle
1929 = SChar
1930 | SString StringRepresentation
1931 deriving (Eq)
1932
1933
1934 formatString :: ElmVersion -> StringStyle -> String -> Box
1935 formatString elmVersion style s =
1936 case style of
1937 SChar ->
1938 stringBox "\'" id
1939 SString SingleQuotedString ->
1940 stringBox "\"" id
1941 SString TripleQuotedString ->
1942 stringBox "\"\"\"" escapeMultiQuote
1943 where
1944 stringBox quotes escaper =
1945 line $ row
1946 [ punc quotes
1947 , literal $ escaper $ concatMap fix s
1948 , punc quotes
1949 ]
1950
1951 fix c =
1952 if (style == SString TripleQuotedString) && c == '\n' then
1953 [c]
1954 else if c == '\n' then
1955 "\\n"
1956 else if c == '\t' then
1957 "\\t"
1958 else if c == '\\' then
1959 "\\\\"
1960 else if (style == SString SingleQuotedString) && c == '\"' then
1961 "\\\""
1962 else if (style == SChar) && c == '\'' then
1963 "\\\'"
1964 else if not $ Char.isPrint c then
1965 hex c
1966 else if c == ' ' then
1967 [c]
1968 else if ElmVersion.style_0_19_stringEscape elmVersion == False && c == '\xA0' then
1969 [c] -- Workaround for https://github.com/elm-lang/elm-compiler/issues/1279
1970 else if Char.isSpace c then
1971 hex c
1972 else
1973 [c]
1974
1975 hex char =
1976 case ElmVersion.style_0_19_stringEscape elmVersion of
1977 True ->
1978 "\\u{" ++ (printf "%04X" $ Char.ord char) ++ "}"
1979 False ->
1980 "\\x" ++ (printf fmt $ Char.ord char)
1981 where
1982 fmt =
1983 if Char.ord char <= 0xFF then
1984 "%02X"
1985 else
1986 "%04X"
1987
1988 escapeMultiQuote =
1989 let
1990 step okay quotes remaining =
1991 case remaining of
1992 [] ->
1993 reverse $ (concat $ replicate quotes "\"\\") ++ okay
1994
1995 next : rest ->
1996 if next == '"' then
1997 step okay (quotes + 1) rest
1998 else if quotes >= 3 then
1999 step (next : (concat $ replicate quotes "\"\\") ++ okay) 0 rest
2000 else if quotes > 0 then
2001 step (next : (replicate quotes '"') ++ okay) 0 rest
2002 else
2003 step (next : okay) 0 rest
2004 in
2005 step "" 0
2006
2007
2008
2009 data TypeParensRequired
2010 = ForLambda
2011 | ForCtor
2012 | NotRequired
2013 deriving (Eq)
2014
2015
2016 formatType ::
2017 Coapplicative annf =>
2018 ElmVersion -> ASTNS annf [UppercaseIdentifier] 'TypeNK -> Box
2019 formatType elmVersion =
2020 formatType' elmVersion NotRequired
2021
2022
2023 commaSpace :: Line
2024 commaSpace =
2025 row
2026 [ punc ","
2027 , space
2028 ]
2029
2030
2031 formatTypeConstructor :: ElmVersion -> TypeConstructor ([UppercaseIdentifier], UppercaseIdentifier) -> Box
2032 formatTypeConstructor elmVersion ctor =
2033 case ctor of
2034 NamedConstructor (namespace, name) ->
2035 line $ formatQualifiedUppercaseIdentifier elmVersion (namespace ++ [name])
2036
2037 TupleConstructor n ->
2038 line $ keyword $ "(" ++ (List.replicate (n-1) ',') ++ ")"
2039
2040
2041 formatType' ::
2042 Coapplicative annf =>
2043 ElmVersion -> TypeParensRequired -> ASTNS annf [UppercaseIdentifier] 'TypeNK -> Box
2044 formatType' elmVersion requireParens atype =
2045 case extract $ I.unFix atype of
2046 UnitType comments ->
2047 formatUnit '(' ')' comments
2048
2049 FunctionType first rest (ForceMultiline forceMultiline) ->
2050 let
2051 formatRight (C (preOp, postOp, eol) term) =
2052 ElmStructure.forceableSpaceSepOrStack1
2053 False
2054 $ concat
2055 [ Maybe.maybeToList $ formatComments preOp
2056 , [ ElmStructure.prefixOrIndented
2057 (line $ punc "->")
2058 (formatC2Eol $
2059 (fmap $ formatType' elmVersion ForLambda)
2060 (C (postOp, [], eol) term)
2061 )
2062 ]
2063 ]
2064 in
2065 ElmStructure.forceableSpaceSepOrStack
2066 forceMultiline
2067 (formatEolCommented (formatType' elmVersion ForLambda) first)
2068 (fmap formatRight $ toCommentedList rest)
2069 |> if requireParens /= NotRequired then parens else id
2070
2071 TypeVariable var ->
2072 line $ identifier $ formatVarName elmVersion var
2073
2074 TypeConstruction ctor args forceMultiline ->
2075 let
2076 join =
2077 case forceMultiline of
2078 ForceMultiline True -> FASplitFirst
2079 ForceMultiline False -> FAJoinFirst JoinAll
2080 in
2081 ElmStructure.application
2082 join
2083 (formatTypeConstructor elmVersion ctor)
2084 (map (formatHeadCommented $ formatType' elmVersion ForCtor) args)
2085 |> (if not (null args) && requireParens == ForCtor then parens else id)
2086
2087 TypeParens type' ->
2088 parens $ formatCommented (formatType elmVersion) type'
2089
2090 TupleType types (ForceMultiline forceMultiline) ->
2091 ElmStructure.group True "(" "," ")" forceMultiline (fmap (formatC2Eol . fmap (formatType elmVersion)) types)
2092
2093 RecordType base fields trailing multiline ->
2094 formatRecordLike
2095 (line . formatLowercaseIdentifier elmVersion [])
2096 (formatLowercaseIdentifier elmVersion [])
2097 ":"
2098 (formatType elmVersion)
2099 base fields trailing multiline
2100
2101
2102 formatVar :: ElmVersion -> Ref [UppercaseIdentifier] -> Line
2103 formatVar elmVersion var =
2104 case var of
2105 VarRef namespace name ->
2106 formatLowercaseIdentifier elmVersion namespace name
2107
2108 TagRef namespace name ->
2109 case namespace of
2110 [] -> identifier $ formatVarName'' elmVersion name
2111 _ ->
2112 row
2113 [ formatQualifiedUppercaseIdentifier elmVersion namespace
2114 , punc "."
2115 , identifier $ formatVarName'' elmVersion name
2116 ]
2117
2118 OpRef name ->
2119 formatSymbolIdentifierInParens name
2120
2121
2122 formatSymbolIdentifierInParens :: SymbolIdentifier -> Line
2123 formatSymbolIdentifierInParens (SymbolIdentifier name) =
2124 identifier $ "(" ++ name ++ ")"
2125
2126
2127 formatInfixVar :: ElmVersion -> Ref [UppercaseIdentifier] -> Line
2128 formatInfixVar elmVersion var =
2129 case var of
2130 VarRef _ _ ->
2131 row [ punc "`"
2132 , formatVar elmVersion var
2133 , punc "`"
2134 ]
2135 TagRef _ _ ->
2136 row [ punc "`"
2137 , formatVar elmVersion var
2138 , punc "`"
2139 ]
2140 OpRef (SymbolIdentifier name) ->
2141 identifier name
2142
2143
2144 formatLowercaseIdentifier :: ElmVersion -> [UppercaseIdentifier] -> LowercaseIdentifier -> Line
2145 formatLowercaseIdentifier elmVersion namespace (LowercaseIdentifier name) =
2146 case (elmVersion, namespace, name) of
2147 (_, [], _) -> identifier $ formatVarName' elmVersion name
2148 _ ->
2149 row
2150 [ formatQualifiedUppercaseIdentifier elmVersion namespace
2151 , punc "."
2152 , identifier $ formatVarName' elmVersion name
2153 ]
2154
2155
2156 formatUppercaseIdentifier :: ElmVersion -> UppercaseIdentifier -> Line
2157 formatUppercaseIdentifier elmVersion (UppercaseIdentifier name) =
2158 identifier $ formatVarName' elmVersion name
2159
2160
2161 formatQualifiedUppercaseIdentifier :: ElmVersion -> [UppercaseIdentifier] -> Line
2162 formatQualifiedUppercaseIdentifier elmVersion names =
2163 identifier $ List.intercalate "." $
2164 map (\(UppercaseIdentifier name) -> formatVarName' elmVersion name) names
2165
2166
2167 formatVarName :: ElmVersion -> LowercaseIdentifier -> String
2168 formatVarName elmVersion (LowercaseIdentifier name) =
2169 formatVarName' elmVersion name
2170
2171
2172 formatVarName' :: ElmVersion -> String -> String
2173 formatVarName' elmVersion name =
2174 case elmVersion of
2175 Elm_0_16 -> name
2176 Elm_0_17 -> name
2177 _ -> map (\x -> if x == '\'' then '_' else x) name
2178
2179
2180 formatVarName'' :: ElmVersion -> UppercaseIdentifier -> String
2181 formatVarName'' elmVersion (UppercaseIdentifier name) =
2182 formatVarName' elmVersion name