git.iko.soy/elk
on c5b225d help sign in
elk/src/Nitpick/Pattern.hs
99 lines 1.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Nitpick.Pattern
3 ( Pattern(..)
4 , fromCanonicalPattern
5 , toString
6 )
7 where
9import qualified Data.List as List
11import qualified AST.Literal as L
12import qualified AST.Pattern as P
13import qualified AST.Variable as Var
14import qualified Reporting.Annotation as A
18-- PATTERN
21data Pattern
22 = Ctor Var.Canonical [Pattern]
23 | Anything
24 | Literal L.Literal
25 deriving (Eq)
28fromCanonicalPattern :: P.Canonical -> Pattern
29fromCanonicalPattern (A.A _ pattern) =
30 case pattern of
31 P.Data name patterns ->
32 Ctor name (map fromCanonicalPattern patterns)
34 P.Record _ ->
35 Anything
37 P.Alias _ subPattern ->
38 fromCanonicalPattern subPattern
40 P.Var _ ->
41 Anything
43 P.Anything ->
44 Anything
46 P.Literal (L.Boolean True) ->
47 Ctor (Var.builtin "True") []
49 P.Literal (L.Boolean False) ->
50 Ctor (Var.builtin "False") []
52 P.Literal literal ->
53 Literal literal
57-- TO STRING
60toString :: Bool -> Pattern -> String
61toString needsParens pattern =
62 case pattern of
63 Ctor tag [first,rest] | Var.toString tag == "::" ->
64 toString (isCons first) first
65 ++ " :: "
66 ++ toString False rest
68 Ctor tag args ->
69 if Var.isTuple tag then
70 "(" ++ List.intercalate ", " (map (toString False) args) ++ ")"
72 else
73 addParensIf (needsParens && not (null args)) $
74 List.intercalate " " (Var.toString tag : map (toString True) args)
76 Anything ->
77 "_"
79 Literal literal ->
80 L.toString literal
83addParensIf :: Bool -> String -> String
84addParensIf needsParens str =
85 if needsParens then
86 "(" ++ str ++ ")"
88 else
89 str
92isCons :: Pattern -> Bool
93isCons pattern =
94 case pattern of
95 Ctor tag [_,_] ->
96 Var.toString tag == "::"
98 _ ->
99 False