git.iko.soy/elk
on b09bb00 help sign in
elk/src/Nitpick/Pattern.hs
109 lines 2.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Nitpick.Pattern
4 ( Pattern(..)
5 , fromCanonicalPattern
6 , toString
7 )
8 where
10import qualified Data.List as List
11import Data.Monoid ((<>))
12import qualified Data.Text.Lazy as LazyText
13import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
15import qualified AST.Literal as L
16import qualified AST.Pattern as P
17import qualified AST.Variable as Var
18import qualified Reporting.Annotation as A
22-- PATTERN
25data Pattern
26 = Ctor Var.Canonical [Pattern]
27 | Anything
28 | Literal L.Literal
29 deriving (Eq)
32fromCanonicalPattern :: P.Canonical -> Pattern
33fromCanonicalPattern (A.A _ pattern) =
34 case pattern of
35 P.Ctor name patterns ->
36 Ctor name (map fromCanonicalPattern patterns)
38 P.Record _ ->
39 Anything
41 P.Alias _ subPattern ->
42 fromCanonicalPattern subPattern
44 P.Var _ ->
45 Anything
47 P.Anything ->
48 Anything
50 P.Literal (L.Boolean True) ->
51 Ctor (Var.builtin "True") []
53 P.Literal (L.Boolean False) ->
54 Ctor (Var.builtin "False") []
56 P.Literal literal ->
57 Literal literal
61-- TO STRING
64toString :: Pattern -> String
65toString pattern =
66 LazyText.unpack (toLazyText (toBuilder False pattern))
69toBuilder :: Bool -> Pattern -> Builder
70toBuilder needsParens pattern =
71 case pattern of
72 Ctor tag [first,rest] | Var.toText tag == "::" ->
73 toBuilder (isCons first) first <> " :: " <> toBuilder False rest
75 Ctor tag args ->
76 if Var.isTuple tag then
77 if null args then "()" else
78 "( "
79 <> mconcat (List.intersperse ", " (map (toBuilder False) args))
80 <> " )"
82 else
83 addParensIf (needsParens && not (null args)) $
84 mconcat (List.intersperse " " (fromText (Var.toText tag) : map (toBuilder True) args))
86 Anything ->
87 "_"
89 Literal literal ->
90 L.toBuilder literal
93addParensIf :: Bool -> Builder -> Builder
94addParensIf needsParens str =
95 if needsParens then
96 "(" <> str <> ")"
98 else
99 str
102isCons :: Pattern -> Bool
103isCons pattern =
104 case pattern of
105 Ctor tag [_,_] ->
106 Var.toText tag == "::"
108 _ ->
109 False