9b659dd · elk · git.iko.soy

git.iko.soy/elk

Add error messages for errors due to untyped native functions. Hopefully untyped native functions can be eliminated soon!

commit9b659ddb3577392ba3084609ac48246c4f8a399e authorevancz <info@elm-lang.org> dateSat 11 Aug 2012, 12:44 (14 years ago) parent8810898

7 files changed+27−23

compare with master

unifiedsplit

elm/src/Compiler.hs+4−4 elm/src/Gen/CompileToJS.hs+9−7 elm/src/Gen/GenerateHtml.hs+5−4 elm/src/Initialize.hs+2−2 elm/src/Language/Elm.hs+1−1 elm/src/Types/Constrain.hs+3−3 elm/src/Types/Unify.hs+3−2

elm/src/Compiler.hs+4−4

@@ -68,12 +68,12 @@ fileTo get what jsFiles noscript rtLoc file = do

6868 writeFile html . renderHtml $ linkedHtml rtLoc js ms

6969 writeFile js $ jss ++ concatMap jsModule ms

7070

71−getModules :: [String] -> FilePath -> IO (Either String [Module])

71+getModules :: [String] -> FilePath -> IO (Either String [([String],Module)])

7272getModules uses file = do

7373 code <- readFile file

7474 case initialize code of

7575 Left err -> return . Left $ "Error in " ++ file ++ ":\n" ++ err

76− Right modul@(Module _ _ imports _) ->

76+ Right (escs, modul@(Module _ _ imports _)) ->

7777 let imps = filter (`notElem` builtInModules) $ map fst imports in

7878 case intersect uses imps of

7979 x:_ -> return . Left $ "Error: Cyclic dependency. Module " ++

@@ -81,10 +81,10 @@ getModules uses file = do

8181 [] -> do

8282 ems <- mapM (getModules (uses ++ imps) . toFilePath) imps

8383 return $ case lefts ems of

84− [] -> Right $ concat (rights ems) ++ [modul]

84+ [] -> Right $ concat (rights ems) ++ [(escs,modul)]

8585 errs -> Left $ intercalate "\n" errs

8686

87−getModule :: FilePath -> IO (Either String [Module])

87+getModule :: FilePath -> IO (Either String [([String],Module)])

8888getModule file = do

8989 code <- readFile file

9090 return . fmap (:[]) $ initialize code

elm/src/Gen/CompileToJS.hs+9−7

@@ -27,21 +27,23 @@ iff a b c = a ++ "?" ++ b ++ ":" ++ c

2727mainEquals s = globalAssign "ElmCode.main" (jsFunc "" (ret s))

2828globalAssign m s = "\n" ++ m ++ "=" ++ s ++ ";"

2929

30−tryBlock names e =

30+tryBlock escapees names e =

3131 concat [ "\ntry{\n" ++ e ++ "\n\n} catch (e) {"

3232 , "ElmCode.main=function() {"

33− , "var msg = ('<br><h2>Your browser may not be supported. " ++

33+ , "var msg = ('<br/><h2>Your browser may not be supported. " ++

3434 "Are you using a modern browser?</h2>' +" ++

35− " '<br><span style=\"color:grey\">Runtime Error in " ++

36− intercalate "." names ++ " module:<br>' + e + '</span>');"

35+ " '<br/><span style=\"color:grey\">Runtime Error in " ++

36+ intercalate "." names ++ " module:<br/>' + e + '" ++ msg ++ "</span>');"

3737 , "document.body.innerHTML = Text.monospace(msg);"

3838 , "throw e;"

3939 , "};}"

4040 ]

41+ where msg | escapees /= [] = concat [ "<br/><br/>The problem may stem from an improper usage of:<br/>"

42+ , intercalate ", " escapees ]

43+ | otherwise = ""

4144

42−

43−jsModule (Module names exports imports stmts) =

44− tryBlock (tail modNames) $ concat

45+jsModule (escapees, Module names exports imports stmts) =

46+ tryBlock escapees (tail modNames) $ concat

4547 [ concatMap (\n -> globalAssign n $ n ++ " || {}") .

4648 map (intercalate ".") . drop 2 . inits $

4749 take (length modNames - 1) modNames

elm/src/Gen/GenerateHtml.hs+5−4

@@ -46,11 +46,12 @@ generateHtml :: String -- ^ Location of elm-min.js as expected by the browser

4646generateHtml libLoc title source =

4747 case initialize source of

4848 Left err -> createHtml libLoc title (Right $ showErr err) (H.noscript "")

49− Right modul -> modulesToHtml title libLoc [] False [modul]

49+ Right (escs, modul) -> modulesToHtml title libLoc [] True [(escs,modul)]

5050

5151

52−modulesToHtml title libLoc jss nscrpt modules = createHtml libLoc title' js noscript

53− where js = Right $ jss ++ concatMap jsModule modules

52+modulesToHtml title libLoc jss nscrpt pairs = createHtml libLoc title' js noscript

53+ where modules = map snd pairs

54+ js = Right $ jss ++ concatMap jsModule pairs

5455 noscript = if nscrpt then extract $ last modules else ""

5556 title' = if null title then altTitle else title

5657 altTitle = (\(Module names _ _ _) -> intercalate "." names) $

@@ -60,7 +61,7 @@ modulesToHtml title libLoc jss nscrpt modules = createHtml libLoc title' js nosc

6061linkedHtml rtLoc jsLoc modules =

6162 createHtml rtLoc title (Left jsLoc) (H.noscript "")

6263 where title = (\(Module names _ _ _) -> intercalate "." names) $

63− last modules

64+ snd (last modules)

6465

6566

6667createHtml libLoc title js noscript =

elm/src/Initialize.hs+2−2

@@ -16,8 +16,8 @@ import Optimize

1616initialize str =

1717 let nameOf (Definition n _ _) = n in

1818 do modul@(Module name ex im stmts) <- parseProgram str

19− subs <- unify hints modul

19+ (escapees, subs) <- unify hints modul

2020 let modul' = optimize . rename $ Module name ex im' stmts

2121 where im' | any ((=="Prelude") . fst) im = im

2222 | otherwise = ("Prelude", Importing []) : im

23− subs `seq` return modul'

23+ subs `seq` return (escapees, modul')

elm/src/Language/Elm.hs+1−1

@@ -71,4 +71,4 @@ toPartsHelper :: String -> (Html, Html, String)

7171toPartsHelper source = (html, css, js)

7272 where modul = initialize source

7373 js = either showErr jsModule modul

74− html = widgetBody $ either id extract modul

74+ html = widgetBody $ either id (extract . snd) modul

elm/src/Types/Constrain.hs+3−3

@@ -12,7 +12,7 @@ import Control.Monad.State (evalState)

1212import Guid

1313import Types.Substitutions

1414

15−import System.IO.Unsafe

15+--import System.IO.Unsafe

1616

1717prints xs v = v --} unsafePerformIO (putStrLn "~~~~~~~~~~" >> mapM print xs) `seq` v

1818

@@ -27,8 +27,8 @@ constrain hints (Module _ _ _ stmts) = do

2727 assumptions <- foldM insert (unionsA ass) $ map fst (concat schemess)

2828 let cs = let f k s vs = map (\v -> Context k $ v :<<: s) vs in

2929 concat . Map.elems $ Map.intersectionWithKey f allHints assumptions

30− let p = unsafePerformIO (mapM print . Map.toList $ Map.difference assumptions allHints)

31− seq p . return $ cs ++ Set.toList (Set.unions css)

30+ let escapees = Map.keys $ Map.difference assumptions allHints

31+ return . (,) escapees $ cs ++ Set.toList (Set.unions css)

3232

3333gen :: Expr -> GuidCounter (Map.Map String [X], Set.Set (Context String Constraint), Type)

3434

elm/src/Types/Unify.hs+3−2

@@ -16,8 +16,9 @@ import Types.Substitutions

1616prints xs v = v --} unsafePerformIO (putStrLn "----------" >> mapM print xs) `seq` v

1717

1818unify hints modul = run $ do

19− cs <- constrain hints modul

20− prints cs $ solver cs Map.empty

19+ (escapees, cs) <- constrain hints modul

20+ subs <- solver cs Map.empty

21+ prints cs $ return ((,) escapees `liftM` subs)

2122

2223eq ctx t1 t2 = Context ctx (t1 :=: t2)

2324