git.iko.soy/elk
on ea2a61e help sign in
elk/src/Nitpick/Pattern.hs
100 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 if null args then "()" else
71 "( " ++ List.intercalate ", " (map (toString False) args) ++ " )"
73 else
74 addParensIf (needsParens && not (null args)) $
75 List.intercalate " " (Var.toString tag : map (toString True) args)
77 Anything ->
78 "_"
80 Literal literal ->
81 L.toString literal
84addParensIf :: Bool -> String -> String
85addParensIf needsParens str =
86 if needsParens then
87 "(" ++ str ++ ")"
89 else
90 str
93isCons :: Pattern -> Bool
94isCons pattern =
95 case pattern of
96 Ctor tag [_,_] ->
97 Var.toString tag == "::"
99 _ ->
100 False