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

module Check.AST.Pattern.NotOrd where

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

import Types

-- check if not (a op b) construct
checkNotOrd :: Expression a -> Int -> CSM ()
checkNotOrd e _ =
  case e of
    (Apply sI
      (Variable _ _
        (QualIdent _ _
          (Ident _ "not" _)))
      (Paren _
        (InfixApply
          _
          _
          (InfixOp _
            (QualIdent _ _
              (Ident _ op _)))
          _ )))
      -> checkNotOrd' sI op warnNotOrd
    (Apply sI
      (Variable _ _
        (QualIdent _ _
          (Ident _ "not" _)))
      (Paren _
        (Apply _
          (Apply _
            (Variable _ _
              (QualIdent _ _
                (Ident _ op _)
              )
            )
          _)
        _)))
      ->  checkNotOrd' sI op warnNotOrd'
    _ -> return ()

-- case compareoperations are used, warn with corrections
checkNotOrd' :: SpanInfo -> String -> (String -> String -> SpanInfo -> CSM()) -> CSM ()
checkNotOrd' sI s f = case s of
  "<"  -> f s ">=" sI
  "<=" -> f s ">" sI
  ">"  -> f s "<=" sI
  ">=" -> f s "<" sI
  _    -> return ()

-- report for infix
warnNotOrd :: String -> String -> SpanInfo -> CSM ()
warnNotOrd s1 s2 sI = report (Message
                               (getSpan sI)
                               (text "Do not use" <+> colorizeKey ("not (a "++s1++" b)"))
                               (text "Use" <+> colorizeKey ("a "++s2++" b") <+> text "instead"))

-- report for apply
warnNotOrd' :: String -> String -> SpanInfo -> CSM ()
warnNotOrd' s1 s2 sI = report (Message
                                (getSpan sI)
                                (text "Do not use" <+> colorizeKey ("not (("++s1++") a b)"))
                                (text "Use" <+> colorizeKey ("("++s2++") a b") <+> text "instead"))