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
138
139
140
141
142
143
144
145
146
147
148
149

module Check.AST.Indent.Deriving where

import List (last)

import Curry.SpanInfo
import Curry.Span
import Curry.Position
import Curry.Types
import Curry.Ident
import Text.Pretty

import Types

-- applies actual check on Data constructs
checkDeriving :: Decl a -> Int -> CSM ()
checkDeriving e _ =
  case e of
    (DataDecl sI _ _ constr@(l:ls) derivs@(d:ds)) -> checkDeriving' sI constr derivs
    _                                             -> return ()

-- check according to type
checkDeriving' :: SpanInfo -> [ConstrDecl] -> [QualIdent] -> CSM ()
checkDeriving' sI (l:ls) d = case l of
  (ConstrDecl _ _ _)  -> checkDerivingC sI (l:ls) d
  (RecordDecl _ _ _)  -> checkRecord sI (l:ls) d
  _                   -> return ()

-- check formatting
checkDerivingC :: SpanInfo -> [ConstrDecl] -> [QualIdent]-> CSM ()
checkDerivingC (SpanInfo (Span (Position ls cs) (Position le ce)) ks) cons derivs@(deriv:_) = do
  let derivSpan = (ks !! ((length cons) + 1))
      firstKeySpan = (ks !! ((length cons) + 2))
  unlessM (ls == le) --one line
    (if ((getSpanCol (ks !! 1) == getSpanCol derivSpan) || (cs+2 == getSpanCol derivSpan)) -- alignment 'deriving'
       then
         (unlessM (le == getSpanLi derivSpan) --deriving one line
           (if (spanAlign (drop ((length cons) + 2) ks)) -- alignment symbols in deriving body
              then
                (if (checkAlign getCol (getCol (getSpanInfo deriv)) derivs) -- aligment classes
                  then
                    -- indentation
                    (unlessM ((getSpanCol firstKeySpan == (getSpanCol derivSpan) + 2) || (getSpanLi firstKeySpan == getSpanLi derivSpan))
                                (report (Message (Span (Position (getSpanLi derivSpan) (getSpanCol derivSpan)) (Position le ce))
                                          (colorizeKey "classes" <+> text "wrong indention")
                                          ( text "indent by 2 from"
                                          <+> colorizeKey "deriving"
                                          <+> text "write first class in same line as"
                                          <+> colorizeKey "deriving"
                                          )
                                  )
                          )
                    )
                  else
                    (report (Message (Span (Position (getSpanLi derivSpan) (getSpanCol derivSpan)) (Position le ce))
                              (colorizeKey "classes" <+> text "not aligned")
                              ( text "align derived"
                              <+> colorizeKey "classes"
                              )
                            )
                    )
                )
              else
                (report (Message (Span (Position (getSpanLi derivSpan) (getSpanCol derivSpan)) (Position le ce))
                          (colorizeKey "symbols" <+> text "in deriving body not aligned")
                          ( text "align"
                          <+> colorizeKey "("
                          <+> text ","
                          <+> colorizeKey ")"
                          <+> text "and"
                          <+> colorizeKey ","
                          )
                        )
                )
           )
        )
       else
         (report (Message (Span (Position ls cs) (Position le ce))
                                (colorizeKey "deriving" <+> text "wrong formatting")
                                ( text "align"
                                <+> colorizeKey "deriving"
                                <+> text "with"
                                <+> colorizeKey "="
                                <+> text "or indent by 2 from"
                                <+> colorizeKey "data"
                                )
                 )
         )
    )

-- check formatting for records
checkRecord :: SpanInfo -> [ConstrDecl] -> [QualIdent] -> CSM ()
checkRecord (SpanInfo (Span (Position ls cs) (Position le ce))
            (_:_:(Span (Position l1d c1d) _):
              symbs@((Span (Position l1s c1s) (Position _ _)):_)))
            ((RecordDecl (SpanInfo _ spans ) ident fs):_)
            (deriv:derivs) =
              unlessM (ls == le) --one line
                (if (getSpanLi (last spans) == l1d) -- 'deriving' position
                  then
                    (unlessM (le == l1d) --deriving one line
                      (if (spanAlign symbs) -- alignment symbols of deriving
                          then
                            (if (checkAlign getCol (getCol (getSpanInfo deriv)) derivs) -- aligment classes
                              then
                                (unlessM ((c1s == c1d + 2) || (l1s == l1d)) -- indentation
                                            (report (Message (Span (Position l1d c1d) (Position le ce))
                                                      (colorizeKey "classes" <+> text "wrong indention")
                                                      ( text "indent by 2 from"
                                                      <+> colorizeKey "deriving"
                                                      <+> text "write first class in same line as"
                                                      <+> colorizeKey "deriving"
                                                      )
                                              )
                                      )
                                )
                              else
                                (report (Message (Span (Position l1d c1d) (Position le ce))
                                          (colorizeKey "classes" <+> text "not aligned")
                                          ( text "align derived"
                                          <+> colorizeKey "classes"
                                          )
                                        )
                                )
                            )
                          else
                            (report (Message (Span (Position l1d c1d) (Position le ce))
                                      (colorizeKey "symbols" <+> text "in deriving body not aligned")
                                      ( text "align"
                                      <+> colorizeKey "("
                                      <+> text ","
                                      <+> colorizeKey ")"
                                      <+> text "and"
                                      <+> colorizeKey ","
                                      )
                                    )
                            )
                      )
                    )
                  else
                    (report (Message (Span (Position ls cs) (Position le ce))
                                            (colorizeKey "deriving" <+> text "wrong formatting")
                                            ( text "write"
                                            <+> colorizeKey "deriving"
                                            <+> text "right of"
                                            <+> colorizeKey "}"
                                            )
                            )
                    )
                )