git.iko.soy/elk
on 9b0c310 help sign in
elk/src/Canonicalize/Variable.hs
226 lines 5.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Variable where
4import qualified Data.Either as Either
5import qualified Data.Map as Map
6import qualified Data.Set as Set
8import qualified AST.Helpers as Help
9import qualified AST.Module as Module
10import qualified AST.Type as Type
11import qualified AST.Variable as Var
12import qualified Reporting.Annotation as A
13import qualified Reporting.Error.Canonicalize as Error
14import qualified Reporting.Region as R
15import qualified Canonicalize.Environment as Env
16import qualified Canonicalize.Result as Result
17import Elm.Utils ((|>))
20variable :: R.Region -> Env.Environment -> String -> Result.ResultErr Var.Canonical
21variable region env var =
22 case toVarName var of
23 Right (name, varName)
24 | Module.nameIsNative name ->
25 Result.var (Var.Canonical (Var.Module name) varName)
27 _ ->
28 case Set.toList `fmap` Map.lookup var (Env._values env) of
29 Just [v] ->
30 Result.var v
32 Just vs ->
33 preferLocals region env "variable" vs var
35 Nothing ->
36 notFound region "variable" (Map.keys (Env._values env)) var
39tvar
40 :: R.Region
41 -> Env.Environment
42 -> String
43 -> Result.ResultErr
44 (Either
45 Var.Canonical
46 (Var.Canonical, [String], Type.Canonical)
47 )
48tvar region env var =
49 case adts ++ aliases of
50 [] -> notFound region "type" (Map.keys (Env._adts env) ++ Map.keys (Env._aliases env)) var
51 [v] -> Result.var' extract v
52 vs -> preferLocals' region env extract "type" vs var
53 where
54 adts =
55 map Left (maybe [] Set.toList (Map.lookup var (Env._adts env)))
57 aliases =
58 map Right (maybe [] Set.toList (Map.lookup var (Env._aliases env)))
60 extract value =
61 case value of
62 Left v -> v
63 Right (v,_,_) -> v
66pvar
67 :: R.Region
68 -> Env.Environment
69 -> String
70 -> Int
71 -> Result.ResultErr Var.Canonical
72pvar region env var actualArgs =
73 case Set.toList `fmap` Map.lookup var (Env._patterns env) of
74 Just [value] ->
75 foundArgCheck value
77 Just values ->
78 preferLocals' region env fst "pattern" values var
79 `Result.andThen` foundArgCheck
81 Nothing ->
82 notFound region "pattern" (Map.keys (Env._patterns env)) var
83 where
84 foundArgCheck (name, expectedArgs) =
85 if actualArgs == expectedArgs
86 then Result.var name
87 else Result.err (A.A region (Error.argMismatch name expectedArgs actualArgs))
90-- FOUND
92preferLocals
93 :: R.Region
94 -> Env.Environment
95 -> String
96 -> [Var.Canonical]
97 -> String
98 -> Result.ResultErr Var.Canonical
99preferLocals region env =
100 preferLocals' region env id
103preferLocals'
104 :: R.Region
105 -> Env.Environment
106 -> (a -> Var.Canonical)
107 -> String
108 -> [a]
109 -> String
110 -> Result.ResultErr a
111preferLocals' region env extract kind possibilities var =
112 case filter (isLocal . extract) possibilities of
113 [] ->
114 ambiguous possibilities
116 [v] ->
117 Result.var' extract v
119 locals ->
120 ambiguous locals
121 where
122 isLocal :: Var.Canonical -> Bool
123 isLocal (Var.Canonical home _) =
124 case home of
125 Var.Local -> True
126 Var.BuiltIn -> False
127 Var.Module name ->
128 name == Env._home env
130 ambiguous possibleVars =
131 Result.err (A.A region (Error.variable kind var Error.Ambiguous vars))
132 where
133 vars = map (Var.toString . extract) possibleVars
136-- NOT FOUND HELPERS
138type VarName =
139 Either String (Module.Name, String)
142toVarName :: String -> VarName
143toVarName var =
144 case Help.splitDots var of
145 [x] -> Left x
146 xs -> Right (init xs, last xs)
149noQualifier :: VarName -> String
150noQualifier name =
151 case name of
152 Left x -> x
153 Right (_, x) -> x
156qualifiedToString :: (Module.Name, String) -> String
157qualifiedToString (modul, name) =
158 Module.nameToString (modul ++ [name])
161isOp :: VarName -> Bool
162isOp name =
163 Help.isOp (noQualifier name)
166-- NOT FOUND
168notFound :: R.Region -> String -> [String] -> String -> Result.ResultErr a
169notFound region kind possibilities var =
170 let name =
171 toVarName var
173 possibleNames =
174 map toVarName possibilities
176 (problem, suggestions) =
177 case name of
178 Left _ ->
179 exposedProblem name possibleNames
181 Right (modul, varName) ->
182 qualifiedProblem modul varName (Either.rights possibleNames)
183 in
184 Result.err (A.A region (Error.variable kind var problem suggestions))
187exposedProblem :: VarName -> [VarName] -> (Error.VarProblem, [String])
188exposedProblem name possibleNames =
189 let (exposed, qualified) =
190 possibleNames
191 |> filter (\n -> isOp name == isOp n)
192 |> Error.nearbyNames noQualifier name
193 |> Either.partitionEithers
194 in
195 ( Error.ExposedUnknown
196 , exposed ++ map qualifiedToString qualified
197 )
200qualifiedProblem
201 :: Module.Name
202 -> String
203 -> [(Module.Name, String)]
204 -> (Error.VarProblem, [String])
205qualifiedProblem moduleName name allQualified =
206 let availableModules =
207 Set.fromList (map fst allQualified)
209 moduleNameString =
210 Module.nameToString moduleName
211 in
212 case Set.member moduleName availableModules of
213 True ->
214 ( Error.QualifiedUnknown moduleNameString
215 , allQualified
216 |> filter ((==) moduleName . fst)
217 |> map snd
218 |> Error.nearbyNames id name
219 )
221 False ->
222 ( Error.UnknownQualifier moduleNameString
223 , Set.toList availableModules
224 |> map Module.nameToString
225 |> Error.nearbyNames id moduleNameString
226 )