git.iko.soy/elk
on ea5c662 help sign in
elk/src/Nitpick/Pattern.hs
110 lines 2.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Nitpick.Pattern
4 ( Pattern(..)
5 , fromCanonicalPattern
6 , toText
7 )
8 where
10import qualified Data.List as List
11import Data.Monoid ((<>))
12import Data.Text (Text)
13import qualified Data.Text.Lazy as LazyText
14import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
16import qualified AST.Literal as L
17import qualified AST.Pattern as P
18import qualified AST.Variable as Var
19import qualified Reporting.Annotation as A
23-- PATTERN
26data Pattern
27 = Ctor Var.Canonical [Pattern]
28 | Anything
29 | Literal L.Literal
30 deriving (Eq)
33fromCanonicalPattern :: P.Canonical -> Pattern
34fromCanonicalPattern (A.A _ pattern) =
35 case pattern of
36 P.Ctor name patterns ->
37 Ctor name (map fromCanonicalPattern patterns)
39 P.Record _ ->
40 Anything
42 P.Alias _ subPattern ->
43 fromCanonicalPattern subPattern
45 P.Var _ ->
46 Anything
48 P.Anything ->
49 Anything
51 P.Literal (L.Boolean True) ->
52 Ctor Var.true []
54 P.Literal (L.Boolean False) ->
55 Ctor Var.false []
57 P.Literal literal ->
58 Literal literal
62-- TO STRING
65toText :: Pattern -> Text
66toText pattern =
67 LazyText.toStrict (toLazyText (toBuilder False pattern))
70toBuilder :: Bool -> Pattern -> Builder
71toBuilder needsParens pattern =
72 case pattern of
73 Ctor tag [first,rest] | Var.isCons tag ->
74 toBuilder (isCons first) first <> " :: " <> toBuilder False rest
76 Ctor tag args ->
77 if Var.isTuple tag then
78 if null args then "()" else
79 "( "
80 <> mconcat (List.intersperse ", " (map (toBuilder False) args))
81 <> " )"
83 else
84 addParensIf (needsParens && not (null args)) $
85 mconcat (List.intersperse " " (fromText (Var.toText tag) : map (toBuilder True) args))
87 Anything ->
88 "_"
90 Literal literal ->
91 L.toBuilder literal
94addParensIf :: Bool -> Builder -> Builder
95addParensIf needsParens str =
96 if needsParens then
97 "(" <> str <> ")"
99 else
100 str
103isCons :: Pattern -> Bool
104isCons pattern =
105 case pattern of
106 Ctor tag [_,_] ->
107 Var.isCons tag
109 _ ->
110 False