@@ -4,20 +4,23 @@ import Prelude
44
55import Control.Lazy (defer)
66import Data.Foldable (foldMap)
7−import Data.Maybe (Maybe(..))
8−import Data.Monoid (power)
97import Debug (spy)
108import PureScript.CST.Print as Print
11−import PureScript.CST.Print as Print
12−import PureScript.CST.Range (tokensOf)
9+import PureScript.CST.Range (rangeOf, tokensOf, class RangeOf)
1310import PureScript.CST.Range.TokenList as TokenList
1411import PureScript.CST.Types as CST
12+import Data.Tuple.Nested ((/\), type (/\))
13+
14+data Lines = SingleLine | MultiLine
1515
16−-- StringBuilder material
17−type Indentation = Int
16+singleOrMultiline :: forall a. RangeOf a => a -> Lines
17+singleOrMultiline value = lines
18+ where
19+ { start, end } = rangeOf value
20+ lines = if start.line == end.line then SingleLine else MultiLine
1821
1922format :: CST.Module Void -> String
20−format = formatModule 0
23+format = formatModule "" -- 0
2124
2225formatModule :: Indentation -> CST.Module Void -> String
2326formatModule indentation (CST.Module { header, body }) =
@@ -33,7 +36,32 @@ printModuleHeader (CST.ModuleHeader header) =
3336 <> defer (\_ -> foldMap tokensOf header.exports)
3437 <> TokenList.singleton header.where
3538 <> defer (\_ -> foldMap tokensOf header.imports))
36−
39+
40+formatModuleBody :: Indentation -> CST.ModuleBody Void -> String
41+formatModuleBody indentation (CST.ModuleBody {decls, trailingComments}) =
42+ formatDeclarations indentation decls
43+ -- foldMap (formatDeclaration indentation) decls
44+ <> printTrailingComments trailingComments
45+
46+formatDeclarations
47+ :: Indentation
48+ -> Array (CST.Declaration Void)
49+ -> String
50+formatDeclarations indentation =
51+ foldMap (pure newline <> formatDeclaration indentation blank)
52+
53+formatDeclaration :: Indentation -> Indent -> CST.Declaration Void -> String
54+formatDeclaration indentation indent = case _ of
55+ CST.DeclData head rest -> do
56+ let
57+ indented = indent <> indentation
58+ _ = spy "head" head
59+ _ = spy "rest" rest
60+ formatDataHead indentation indented head
61+ <> newline
62+ _ -> "???"
63+
64+
3765-- Language.PureScript.CST.Types.DeclData span dataHead' dataCtors' -> do
3866-- let indent' = indent'' <> indentation
3967-- debug log "DeclData" declaration' span
@@ -41,7 +69,7 @@ printModuleHeader (CST.ModuleHeader header) =
4169-- <> foldMap
4270-- ( \(equals, dataCtors) ->
4371-- pure (newline <> indent')
44−-- <> sourceToken log indent' blank equals
72+-- <> formatSourceToken log indent' blank equals
4573-- <> separated
4674-- log
4775-- Span.MultipleLines
@@ -53,72 +81,213 @@ printModuleHeader (CST.ModuleHeader header) =
5381-- dataCtors'
5482-- <> pure newline
5583
56−-- dataHead ::
57−-- Log.Handle ->
58−-- Indentation ->
59−-- Indent ->
60−-- Language.PureScript.CST.Types.DataHead Span.Span ->
61−-- IO Utf8Builder
62−-- dataHead log indentation indent dataHead' = case dataHead' of
63−-- Language.PureScript.CST.Types.DataHead data' name' typeVarBindings -> do
64−-- debug log "DataHead" dataHead' Span.SingleLine
65−-- sourceToken log indent blank data'
66−-- <> name log indent space name'
67−-- <> foldMap
68−-- ( \typeVarBinding' ->
69−-- pure space
70−-- <> typeVarBinding log indentation indent typeVarBinding'
71−-- )
72−-- typeVarBindings
84+-- | Formats the `data Maybe a` part of `data Maybe a = Just a | Nothing`
85+formatDataHead :: Indentation -> Indent -> CST.DataHead Void -> String
86+formatDataHead indentation indent { keyword, name, vars } =
87+ formatSourceToken indent blank keyword
88+ <> formatName indent space name
89+ <> formatTypeVarBindings indentation indent vars
7390
74−formatDataHead :: Indentation -> String -> CST.DataHead Void -> String
75−formatDataHead indentation indent { keyword, name: CST.Name { token: nameToken }, vars } = do
76− Print.printToken keyword.value <> " "
77− <> Print.printSourceToken nameToken
78− <> ?help vars
91+formatTypeVarBindings
92+ :: Indentation
93+ -> Indent
94+ -> Array (CST.TypeVarBinding Void)
95+ -> String
96+formatTypeVarBindings indentation indent =
97+ foldMap (pure space <> formatTypeVarBinding indentation indent)
98+
99+formatTypeVarBinding :: Indentation -> Indent -> CST.TypeVarBinding Void -> String
100+formatTypeVarBinding indentation indent x = case spy "formatTypeVarBinding" x of
101+ CST.TypeVarName name ->
102+ formatName indent blank name
103+ CST.TypeVarKinded wrapped ->
104+ formatWrapped indent (formatLabeledNameKind indentation indent) wrapped
79105
106+formatLabeledNameKind
107+ :: forall n t
108+ . RangeOf (CST.Name n)
109+ => RangeOf t
110+ => Indentation
111+ -> Indent
112+ -> CST.Labeled (CST.Name n) (CST.Type t)
113+ -> String
114+formatLabeledNameKind indentation indent =
115+ formatLabeled
116+ indentation
117+ indent
118+ (formatName indent blank)
119+ (formatType indentation)
80120
81−formatModuleBody :: Indentation -> CST.ModuleBody Void -> String
82−formatModuleBody indentation (CST.ModuleBody {decls, trailingComments}) =
83− foldMap (formatDeclaration indentation) decls
84− <> printTrailingComments trailingComments
121+-- data Type e
122+-- = TypeVar (Name Ident)
123+-- | TypeConstructor (QualifiedName Proper)
124+-- | TypeWildcard SourceToken
125+-- | TypeHole (Name Ident)
126+-- | TypeString SourceToken String
127+-- | TypeRow (Wrapped (Row e))
128+-- | TypeRecord (Wrapped (Row e))
129+-- | TypeForall SourceToken (NonEmptyArray (TypeVarBinding e)) SourceToken (Type e)
130+-- | TypeKinded (Type e) SourceToken (Type e)
131+-- | TypeApp (Type e) (NonEmptyArray (Type e))
132+-- | TypeOp (Type e) (NonEmptyArray (Tuple (QualifiedName Operator) (Type e)))
133+-- | TypeOpName (QualifiedName Operator)
134+-- | TypeArrow (Type e) SourceToken (Type e)
135+-- | TypeArrowName SourceToken
136+-- | TypeConstrained (Type e) SourceToken (Type e)
137+-- | TypeParens (Wrapped (Type e))
138+-- | TypeUnaryRow SourceToken (Type e)
139+-- | TypeError e
140+formatType
141+ :: forall a
142+ . RangeOf a
143+ => Indentation
144+ -> Indent
145+ -> CST.Type a
146+ -> String
147+formatType indentation indent t = case t of
148+ CST.TypeVar name ->
149+ formatName indent blank name
150+ CST.TypeArrow t1 arrow t2 -> do
151+ let
152+ prefix = case lines of
153+ MultiLine -> newline <> indent
154+ SingleLine -> space
155+ formatType indentation indent t1
156+ <> space
157+ <> formatSourceToken indent blank arrow
158+ <> prefix
159+ <> formatType indentation indent t2
160+ _ -> "formatType:???"
161+ where
162+ lines = singleOrMultiline t
163+
164+formatLabeled
165+ :: forall a b
166+ . RangeOf a
167+ => RangeOf b
168+ => Indentation
169+ -> Indent
170+ -> (a -> String)
171+ -> (Indent -> b -> String)
172+ -> CST.Labeled a b
173+ -> String
174+formatLabeled indentation indent' formatLabel formatValue labeled =
175+ formatLabel label
176+ <> formatSourceToken indent space separator
177+ <> prefix
178+ <> formatValue indent value
179+ where
180+ CST.Labeled { label, separator, value } = labeled
181+ (indent /\ prefix) = case singleOrMultiline labeled of
182+ MultiLine -> (indent' <> indentation) /\ (newline <> indent') -- indent' <> indentation
183+ SingleLine -> indent' /\ space
184+
185+-- Ident? Proper?
186+formatName :: forall a. Indent -> Prefix -> CST.Name a -> String
187+formatName indent prefix (CST.Name { token }) =
188+ formatSourceToken indent prefix token
189+
190+formatSourceToken
191+ :: Indent
192+ -> Prefix
193+ -> CST.SourceToken
194+ -> String
195+formatSourceToken indent prefix { leadingComments, trailingComments, value } =
196+ formatLeadingComments indent prefix leadingComments
197+ <> prefix <> Print.printToken value
198+ <> formatTrailingComments prefix trailingComments
199+
200+formatLeadingComments
201+ :: Indent
202+ -> Prefix
203+ -> Array (CST.Comment CST.LineFeed)
204+ -> String
205+formatLeadingComments indent prefix = foldMap (formatLeadingComment indent prefix)
206+
207+formatLeadingComment
208+ :: Indent
209+ -> Prefix
210+ -> CST.Comment CST.LineFeed
211+ -> String
212+formatLeadingComment indent prefix = case _ of
213+ CST.Comment comment -> prefix <> comment <> newline <> indent
214+ CST.Line _ _ -> blank
215+ CST.Space _ -> blank
216+
217+formatTrailingComments :: Prefix -> Array (CST.Comment Void) -> String
218+formatTrailingComments prefix = foldMap (formatTrailingComment prefix)
219+
220+formatTrailingComment :: Prefix -> CST.Comment Void -> String
221+formatTrailingComment prefix = case _ of
222+ CST.Comment comment -> prefix <> space <> comment
223+ CST.Line _ _ -> blank
224+ CST.Space _ -> blank
225+
226+formatWrapped
227+ :: forall a
228+ . Indent
229+ -> (a -> String)
230+ -> CST.Wrapped a
231+ -> String
232+formatWrapped indent formatValue wrapped@(CST.Wrapped { open, value, close }) =
233+ formatSourceToken indent blank open
234+ <> before
235+ <> formatValue value
236+ <> after
237+ <> formatSourceToken indent blank close
238+ where
239+ { before, after } = case singleOrMultiline wrapped of
240+ MultiLine -> { before: space, after: newline <> indent }
241+ SingleLine -> { before: blank, after: blank }
242+
243+type Indentation = String -- [TODO] Use Numbers
244+type Indent = String
245+type Prefix = String
85246
86247printTrailingComments :: Array (CST.Comment CST.LineFeed) -> String
87248printTrailingComments = foldMap (Print.printComment Print.printLineFeed)
88249
89−-- head: {
90−-- keyword: {
91−-- range: { start: { line: 2, column: 0 }, end: { line: 2, column: 4 } },
92−-- leadingComments: [ Line { value0: LF {}, value1: 2 } ],
93−-- trailingComments: [ Space { value0: 1 } ],
94−-- value: TokLowerName { value0: Nothing {}, value1: 'data' }
95−-- },
96−-- name: {
97−-- token: {
98−-- range: { start: { line: 2, column: 5 }, end: { line: 2, column: 9 } },
99−-- leadingComments: [],
100−-- trailingComments: [],
101−-- value: TokUpperName { value0: Nothing {}, value1: 'Zero' }
102−-- },
103−-- name: 'Zero'
104−-- },
105−-- vars: []
106−-- }
107−-- resr: Nothing {}
108−formatDeclaration :: Indentation -> CST.Declaration Void -> String
109−formatDeclaration indentation = case _ of
110− -- CST.DeclData (CST.DataHead Void) (Maybe (Tuple CST.SourceToken (CST.Separated (CST.DataCtor Void)))) ->
111− CST.DeclData (head@{ keyword, name, vars }) rest -> do
112− let
113− _ = spy "head" head
114− _ = spy "resr" rest
115− (formatDataHead indentation blank head)
116− _ -> "???"
117−
250+formatLeadingCommentsOld :: Array (CST.Comment CST.LineFeed)-> String
251+formatLeadingCommentsOld = foldMap (Print.printComment Print.printLineFeed <<< squashNewlines)
252+ where
253+ -- | There shouldn't be more then one empty line!
254+ squashNewlines (CST.Line l n) = (CST.Line l (min n 2))
255+ squashNewlines others = others
256+
257+-- | Squashes spaces to one space
258+formatInnerTrailingComments :: Array (CST.Comment Void) -> String
259+formatInnerTrailingComments = formatTrailingComments space
260+
261+-- | Squashes trailing spaces to blank
262+formatEndTrailingComments :: Array (CST.Comment Void) -> String
263+formatEndTrailingComments = formatTrailingComments blank
264+
265+-- formatTrailingComments :: String -> Array (CST.Comment Void) -> String
266+-- formatTrailingComments defaultSeparator comments =
267+-- if Array.any isComment comments
268+-- then interComments
269+-- else defaultSeparator
270+-- where
271+
272+-- isComment :: forall l. CST.Comment l -> Boolean
273+-- isComment = case _ of
274+-- CST.Comment _ -> true
275+-- _ -> false
276+
277+-- interComments = Array.fold do
278+-- comment <- Array.filter isComment comments
279+-- [ space, Print.printComment absurd comment ]
280+
281+newline :: String
118282newline = "\n"
119283
284+blank :: String
120285blank = ""
121286
287+space :: String
288+space = " "
289+
290+-- | [TODO] Use numbers
122291-- | Default: two spaces
123−indent :: Indentation -> String
124−indent = power " "
292+-- indent :: Indentation -> String
293+-- indent = power " "