-
Notifications
You must be signed in to change notification settings - Fork 5
/
Utils.purs
137 lines (108 loc) · 5.26 KB
/
Utils.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
module Language.PS.CST.Printers.Utils where
import Prelude
import Data.Array.NonEmpty (NonEmptyArray)
import Data.Foldable (class Foldable)
import Data.List (List(..), (:))
import Data.List (fromFoldable) as List
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, unwrap)
import Data.String.Regex (Regex)
import Data.String.Regex (test) as Regex
import Data.String.Regex.Unsafe (unsafeRegex) as Regex
import Data.String.Regex.Flags as RegexFlags
import Dodo (Doc, bothNotEmpty, break, enclose, encloseEmptyAlt, flexAlt, flexGroup, foldWithSeparator, indent, softBreak, space, spaceBreak, text, (<+>))
import Language.PS.CST.ReservedNames (appendUnderscoreIfReserved, isReservedName)
import Language.PS.CST.Types.Declaration (Declaration(..), Expr(..), InstanceBinding(..), LetBinding(..))
import Language.PS.CST.Types.Leafs (Label(..), ModuleName(..), ProperName, ProperNameType_ConstructorName)
-- | >>> dquotes "·"
-- "·"
dquotes :: forall a. Doc a -> Doc a
dquotes = enclose dquote dquote
dquotesIf :: forall a. Boolean -> Doc a -> Doc a
dquotesIf true = dquotes
dquotesIf false = identity
dquote :: forall a. Doc a
dquote = text "\""
-- | >>> parens "·"
-- (·)
parens :: forall a. Doc a -> Doc a
parens = enclose lparen rparen
-- | >>> lparen
-- (
lparen :: forall a. Doc a
lparen = text "("
-- | >>> rparen
-- )
rparen :: forall a. Doc a
rparen = text ")"
dot :: forall a. Doc a
dot = text "."
pursParensWithoutGroup :: forall a. Doc a -> Doc a
pursParensWithoutGroup = encloseEmptyAlt open close (text "()")
where
open = flexAlt (text "(") (text "( ")
close = flexAlt (text ")") (break <> text ")")
printModuleName :: ModuleName -> Doc Void
printModuleName (ModuleName nonEmptyArray) = foldWithSeparator dot $ map (unwrap >>> text) nonEmptyArray
printConstructors :: Array (ProperName ProperNameType_ConstructorName) -> Doc Void
printConstructors = foldWithSeparator (text ", ") <<< map (text <<< unwrap)
foldWithPrev :: ∀ a b . (b -> Maybe a -> a -> b) -> b -> List a -> b
foldWithPrev _ default' Nil = default'
foldWithPrev fun default' list = foo default' Nothing list
where foo acc _ Nil = acc
foo acc prev (x : xs) = foo (fun acc prev x) (Just x) xs
maybeWrapInParentheses :: Boolean -> Doc Void -> Doc Void
maybeWrapInParentheses b = if b then parens else identity
printAndConditionallyAddNewlinesBetween :: ∀ a f . Foldable f => (a -> a -> Boolean) -> (a -> Doc Void) -> f a -> Doc Void
printAndConditionallyAddNewlinesBetween shouldBeNoNewlines print =
let
foldDeclaration :: Doc Void -> Maybe a -> a -> Doc Void
foldDeclaration accum Nothing current = print current
foldDeclaration accum (Just prev) current = if shouldBeNoNewlines prev current
then accum <> softBreak <> print current
else accum <> softBreak <> break <> (print current)
in
foldWithPrev foldDeclaration mempty <<< List.fromFoldable
shouldBeNoNewlineBetweenDeclarations :: Declaration -> Declaration -> Boolean
shouldBeNoNewlineBetweenDeclarations (DeclSignature { ident }) (DeclValue { valueBindingFields: { name } }) = ident == name
shouldBeNoNewlineBetweenDeclarations (DeclValue { valueBindingFields: { name } }) (DeclValue { valueBindingFields: { name: nameNext } }) = name == nameNext
shouldBeNoNewlineBetweenDeclarations _ _ = false
shouldBeNoNewlineBetweenLetBindings :: LetBinding -> LetBinding -> Boolean
shouldBeNoNewlineBetweenLetBindings (LetBindingSignature { ident }) (LetBindingName { name }) = ident == name
shouldBeNoNewlineBetweenLetBindings (LetBindingName { name }) (LetBindingName { name: nameNext }) = name == nameNext
shouldBeNoNewlineBetweenLetBindings _ _ = false
shouldBeNoNewlineBetweenInstanceBindings :: InstanceBinding -> InstanceBinding -> Boolean
shouldBeNoNewlineBetweenInstanceBindings (InstanceBindingSignature { ident }) (InstanceBindingName { name }) = ident == name
shouldBeNoNewlineBetweenInstanceBindings (InstanceBindingName { name }) (InstanceBindingName { name: nameNext }) = name == nameNext
shouldBeNoNewlineBetweenInstanceBindings _ _ = false
exprShouldBeOnNextLine :: Expr -> Boolean
exprShouldBeOnNextLine (ExprLet _) = true
exprShouldBeOnNextLine (ExprCase _) = true
exprShouldBeOnNextLine (ExprIf _) = true
exprShouldBeOnNextLine _ = false
labelNeedsQuotes :: Label -> Boolean
labelNeedsQuotes (Label name) =
isReservedName name || not (Regex.test unquotedLabelRegex name)
unquotedLabelRegex :: Regex
unquotedLabelRegex =
Regex.unsafeRegex "^[a-z][A-Za-z0-9_]*$" RegexFlags.noFlags
unwrapText :: forall a. Newtype a String => a -> Doc Void
unwrapText = text <<< appendUnderscoreIfReserved <<< unwrap
softSpace :: forall a. Doc a
softSpace =
flexAlt mempty space
printSpaceSeparated :: NonEmptyArray (Doc Void) -> Doc Void
printSpaceSeparated apps =
foldWithSeparator sep apps
where
sep = flexAlt space (break <> text " ")
printLabelled :: Doc Void -> Doc Void -> Doc Void
printLabelled lbl ann =
lbl <> spaceBreak <> indent (text "::" <+> ann)
printLabelledGroup :: Doc Void -> Doc Void -> Doc Void
printLabelledGroup lbl ann =
flexGroup $ printLabelled lbl ann
appendSpaceBreakNoGroup :: forall a. Doc a -> Doc a -> Doc a
appendSpaceBreakNoGroup =
bothNotEmpty \a b -> a <> spaceBreak <> b
infixr 2 appendSpaceBreakNoGroup as <%%>