git.iko.soy/elk
on 501c607 help sign in
elk/src/Transform/Canonicalize/Variable.hs
243 lines 6.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Transform.Canonicalize.Variable where
4import Control.Monad.Error
5import qualified Data.Either as Either
6import Data.Function (on)
7import qualified Data.List as List
8import qualified Data.Map as Map
9import Data.Maybe (fromMaybe)
10import qualified Data.Set as Set
11import qualified Text.EditDistance as Dist
13import qualified AST.Helpers as Help
14import qualified AST.Module as Module
15import qualified AST.Type as Type
16import qualified AST.Variable as Var
17import Transform.Canonicalize.Environment as Env
18import Elm.Utils ((|>))
21variable :: Environment -> String -> Canonicalizer String Var.Canonical
22variable env var =
23 case splitName var of
24 Right (name, varName)
25 | Module.nameIsNative name ->
26 Env.using (Var.Canonical (Var.Module name) varName)
28 _ ->
29 case Map.lookup var (_values env) of
30 Just [v] -> Env.using v
31 Just vs -> preferLocals env "variable" vs var
32 Nothing -> notFound "variable" (Map.keys (_values env)) var
35tvar
36 :: Environment
37 -> String
38 -> Canonicalizer String (Either Var.Canonical (Var.Canonical, [String], Type.CanonicalType))
39tvar env var =
40 case adts ++ aliases of
41 [] -> notFound "type" (Map.keys (_adts env) ++ Map.keys (_aliases env)) var
42 [v] -> found extract v
43 vs -> preferLocals' env extract "type" vs var
44 where
45 adts =
46 map Left (fromMaybe [] (Map.lookup var (_adts env)))
48 aliases =
49 map Right (fromMaybe [] (Map.lookup var (_aliases env)))
51 extract value =
52 case value of
53 Left v -> v
54 Right (v,_,_) -> v
57pvar :: Environment -> String -> Canonicalizer String Var.Canonical
58pvar env var =
59 case Map.lookup var (_patterns env) of
60 Just [v] -> Env.using v
61 Just vs -> preferLocals env "pattern" vs var
62 Nothing -> notFound "pattern" (Map.keys (_patterns env)) var
65-- FOUND
67found :: (a -> Var.Canonical) -> a -> Canonicalizer String a
68found extract v =
69 do _ <- Env.using (extract v)
70 return v
73preferLocals
74 :: Environment
75 -> String
76 -> [Var.Canonical]
77 -> String
78 -> Canonicalizer String Var.Canonical
79preferLocals env =
80 preferLocals' env id
83preferLocals'
84 :: Environment
85 -> (a -> Var.Canonical)
86 -> String
87 -> [a]
88 -> String
89 -> Canonicalizer String a
90preferLocals' env extract kind possibilities var =
91 case filter (isLocal . extract) possibilities of
92 [] -> ambiguous possibilities
93 [v] -> found extract v
94 locals -> ambiguous locals
95 where
96 isLocal :: Var.Canonical -> Bool
97 isLocal (Var.Canonical home _) =
98 case home of
99 Var.Local -> True
100 Var.BuiltIn -> False
101 Var.Module name ->
102 name == Env._home env
104 ambiguous possibleVars =
105 throwError msg
106 where
107 vars = map (Var.toString . extract) possibleVars
108 msg = "Ambiguous usage of " ++ kind ++ " '" ++ var ++ "'.\n" ++
109 " Disambiguate between: " ++ List.intercalate ", " vars
112-- NOT FOUND HELPERS
114splitName :: String -> Either String ([String], String)
115splitName var =
116 case Help.splitDots var of
117 [x] -> Left x
118 xs -> Right (init xs, last xs)
121getName :: Either String ([String], String) -> String
122getName name =
123 case name of
124 Left x -> x
125 Right (_, x) -> x
128nameToString :: ([String], String) -> String
129nameToString (modul, name) =
130 Module.nameToString (modul ++ [name])
133isOp :: Either String ([String], String) -> Bool
134isOp name =
135 Help.isOp (getName name)
138distance :: String -> String -> Int
139distance x y =
140 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
143nearbyNames :: (a -> String) -> a -> [a] -> [a]
144nearbyNames format name names =
145 let editDistance =
146 if length (format name) < 3 then 1 else 2
147 in
148 names
149 |> map (\x -> (distance (format name) (format x), x))
150 |> List.sortBy (compare `on` fst)
151 |> filter ( (<= editDistance) . abs . fst )
152 |> map snd
155-- NOT FOUND
157notFound :: String -> [String] -> String -> Canonicalizer String a
158notFound kind possibilities var =
159 let possibleNames =
160 map splitName possibilities
162 name =
163 splitName var
165 closeNames =
166 possibleNames
167 |> filter (\n -> isOp name == isOp n)
168 |> nearbyNames getName name
170 (exposed, qualified) =
171 Either.partitionEithers closeNames
173 message =
174 case name of
175 Left _ ->
176 closeExposedMessage exposed ++ closeQualifiedMessage qualified
178 Right (modul, _) ->
179 qualifiedMessage modul (Either.rights possibleNames) qualified
181 in
182 throwError $ "Could not find " ++ kind ++ " '" ++ var ++ "'." ++ message
186closeExposedMessage :: [String] -> String
187closeExposedMessage exposed =
188 if null exposed
189 then ""
190 else
191 "\n\nClose matches include:" ++ concatMap ("\n " ++) exposed
194closeQualifiedMessage :: [([String], String)] -> String
195closeQualifiedMessage qualified =
196 if null qualified
197 then ""
198 else
199 "\n\nMaybe you forgot to say which module it came from?\n"
200 ++ "Close qualified names include:"
201 ++ concatMap (("\n " ++) . nameToString) qualified
202 ++ usingImportsMessage
205qualifiedMessage :: [String] -> [([String], String)] -> [([String], String)] -> String
206qualifiedMessage modul allQualified qualified =
207 let availableModules =
208 Set.fromList (map fst allQualified)
209 in
210 case Set.member modul availableModules of
211 True ->
212 let inSameModule =
213 filter ((==) modul . fst) qualified
214 in
215 if null inSameModule
216 then ""
217 else
218 "\n\nClose matches include:"
219 ++ concatMap (("\n " ++) . nameToString) inSameModule
221 False ->
222 let closeModules =
223 Set.toList availableModules
224 |> map Module.nameToString
225 |> nearbyNames id (Module.nameToString modul)
226 in
227 case closeModules of
228 [] ->
229 "\n\nLooks like the prefix '" ++ Module.nameToString modul
230 ++ "' is not in scope. Is it spelled correctly?"
231 ++ "\nIs it imported correctly?"
232 ++ usingImportsMessage
234 _ ->
235 "\n\nClose matches to '" ++ Module.nameToString modul ++ "' include:"
236 ++ concatMap ("\n " ++) closeModules
239usingImportsMessage :: String
240usingImportsMessage =
241 "\n\nYou can read about how imports work at the following address:"
242 ++ "\n<http://elm-lang.org/learn/Syntax.elm#modules>"