git.iko.soy/elk
on master help sign in
Start reworking the Metadata modules
4c02f6bEvan Czaplicki
compiler/Metadata/Libraries.hs+2−35
compare with master
unifiedsplit
@@ -4,7 +4,7 @@ import Control.Applicative ((<$>),(<*>))
4import qualified Data.Map as Map
4import qualified Data.Map as Map
5import Data.List (inits)
5import Data.List (inits)
6import Text.JSON
6import Text.JSON
7−import Metadata.LoadLibraries as Libs
7+import Metadata.Load as Load
8import SourceSyntax.Module
8import SourceSyntax.Module
9
9
10addPrelude :: Module t v -> Module t v
10addPrelude :: Module t v -> Module t v
@@ -23,37 +23,4 @@ prelude = text : map (\n -> (n, Hiding [])) modules
23 , "Graphics.Element", "Color", "Graphics.Collage" ]
23 , "Graphics.Element", "Color", "Graphics.Collage" ]
24
24
25libraries :: Map.Map String (Map.Map String String)
25libraries :: Map.Map String (Map.Map String String)
26−libraries =
26+libraries = Map.empty
27− case getLibs of
28− Error err -> error err
29− Ok libs -> Map.unionWith Map.union libs nilAndTuples
30− where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)
31− pairs =
32− [ ("::", "a -> [a] -> [a]")
33− , ("[]", "[a]")
34− ] ++ map makeTuple (inits ['a'..'i'])
35−
36− makeTuple cs =
37− let name = "_Tuple" ++ show (length cs)
38− in (name, concatMap (\c -> c : " -> ") cs ++
39− name ++ concatMap (\c -> [' ',c]) cs)
40−
41−getLibs :: Result (Map.Map String (Map.Map String String))
42−getLibs = do
43− obj <- decodeStrict Libs.docs :: Result (JSObject JSValue)
44− modules <- valFromObj "modules" obj :: Result [JSObject JSValue]
45− Map.fromList `fmap` mapM getValues modules
46−
47−
48−get :: String -> JSObject JSValue -> Result String
49−get = valFromObj
50−
51−getValue :: JSObject JSValue -> Result (String,String)
52−getValue obj = (,) <$> get "name" obj <*> get "type" obj
53−
54−getValues :: JSObject JSValue -> Result (String, Map.Map String String)
55−getValues obj = do
56− name <- get "name" obj
57− vs <- valFromObj "values" obj
58− vals <- mapM getValue vs
59− return (name, Map.fromList vals)
compiler/Metadata/LoadLibraries.hs+21−18
@@ -1,11 +1,13 @@
1−module Metadata.LoadLibraries (docs) where
1+module Metadata.Load (interfaces) where
2
2
3−import Control.DeepSeq (force)
4import qualified Control.Exception as E
3import qualified Control.Exception as E
5import Paths_Elm
4import Paths_Elm
6import System.Directory
5import System.Directory
6+import System.Exit
7import System.FilePath
7import System.FilePath
8import System.IO.Unsafe (unsafePerformIO)
8import System.IO.Unsafe (unsafePerformIO)
9+import SourceSyntax.Module
10+import Data.Binary
9
11
10-- See stackoverflow discussion for trade-off between using unsafeIO or TemplateHaskell:
12-- See stackoverflow discussion for trade-off between using unsafeIO or TemplateHaskell:
11-- http://stackoverflow.com/questions/12716215/load-pure-global-variable-from-file
13-- http://stackoverflow.com/questions/12716215/load-pure-global-variable-from-file
@@ -13,22 +15,23 @@ import System.IO.Unsafe (unsafePerformIO)
13-- Given the awkwardness of including a compile-time generated file
15-- Given the awkwardness of including a compile-time generated file
14-- vs loading static data, then the unsafeIO seems better.
16-- vs loading static data, then the unsafeIO seems better.
15
17
16−{-# NOINLINE docs #-}
18+{-# NOINLINE interfaces #-}
17−docs :: String
19+interfaces :: [ModuleInterface]
18−docs = force $ unsafePerformIO (safeReadDocs =<< getDataFileName "docs.json")
20+interfaces = unsafePerformIO (safeReadDocs =<< getDataFileName "interfaces.data")
19−
21+
20−safeReadDocs :: FilePath -> IO String
22+safeReadDocs :: FilePath -> IO [ModuleInterface]
23+safeReadDocs name =
21−safeReadDocs name = E.catch (readDocs name) (emitError name)
24+ E.catch (readDocs name) $ \err -> do
22−
25+ putStrLn $ unlines [ "Error reading types for standard library!"
26+ , " The file should be located here: " ++ name
27+ , " If you are using a stable version of Elm,"
28+ , " please report an issue at github.com/evancz/Elm"
29+ , " and specify your versions of Elm and your OS" ]
30+ print (err :: IOError)
31+ exitFailure
32+
23−readDocs :: FilePath -> IO String
33+readDocs :: FilePath -> IO [ModuleInterface]
24readDocs name = do
34readDocs name = do
25 exists <- doesFileExist name
35 exists <- doesFileExist name
26− if exists then readFile name
36+ if exists then decodeFile name
27 else ioError . userError $ "File Not Found"
37 else ioError . userError $ "File Not Found"
28−
29−
30−emitError :: FilePath -> IOError -> IO String
31−emitError name err = do
32− putStrLn $ "Error! Types for standard library not loaded properly!\n File should be here:" ++ name ++ "\n The file is created and copied by command: cabal install"
33− putStrLn (show err)
34− return "{\"modules\":[]}"