on d7948ad help sign in
elk/compiler/Model/Libraries.hs
58 lines 2.2 kB history raw
1module Libraries (libraries, addPrelude, prelude) where
3import Ast
4import qualified Data.Map as Map
5import Data.List (inits)
6import Text.JSON
7import LoadLibraries (docs)
10addPrelude (Module name exs ims stmts) = Module name exs (customIms ++ ims) stmts
11 where customIms = concatMap addModule prelude
13 addModule (n, method) = case lookup n ims of
14 Nothing -> [(n, method)]
15 Just _ -> []
17prelude = text : map (\n -> (n, Hiding [])) modules
18 where
19 text = ("Graphics.Text", Hiding ["link", "color", "height"])
20 modules = [ "Prelude", "Signal", "List", "Maybe", "Time"
21 , "Graphics.Element", "Graphics.Color"
22 , "Graphics.Collage", "Graphics.Geometry" ]
24libraries :: Map.Map String (Map.Map String String)
25libraries = case getLibs of
26 Error err -> error err
27 Ok libs -> Map.unionWith Map.union libs nilAndTuples
28 where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)
29 pairs = ("Nil", "List a") : map makeTuple (inits ['a'..'i'])
30 makeTuple cs =
31 let name = "Tuple" ++ show (length cs)
32 in (name, concatMap (\c -> c : " -> ") cs ++
33 name ++ concatMap (\c -> [' ',c]) cs)
35getLibs :: Result (Map.Map String (Map.Map String String))
36getLibs = do
37 obj <- decodeStrict docs :: Result (JSObject JSValue)
38 modules <- valFromObj "modules" obj :: Result [JSObject JSValue]
39 Map.fromList `fmap` mapM getValues modules
42getName :: JSObject JSValue -> Result String
43getName obj = valFromObj "name" obj
45getType :: JSObject JSValue -> Result String
46getType obj = valFromObj "type" obj
48getValue :: JSObject JSValue -> Result (String,String)
49getValue obj = do n <- getName obj
50 t <- getType obj
51 return (n,t)
53getValues :: JSObject JSValue -> Result (String, Map.Map String String)
54getValues obj = do
55 name <- getName obj
56 vs <- valFromObj "values" obj
57 vals <- mapM getValue vs
58 return (name, Map.fromList vals)