git.iko.soy/elk
on c2fc03c help sign in
elk/compiler/Model/Libraries.hs
69 lines 2.4 kB history raw
1module Libraries (libraries, addPrelude) where
3import Ast
4import qualified Data.Map as Map
5import Data.List (inits)
6import Text.JSON
7import LoadLibraries (docs)
9import System.IO.Unsafe
11addPrelude :: Module -> Module
12addPrelude (Module name exs ims stmts) =
13 unsafePerformIO $ do
14 mapM print $ customIms ++ ims
15 return $ Module name exs (customIms ++ ims) stmts
16 where customIms = concatMap addModule prelude
18 addModule (n, method) = case lookup n ims of
19 Nothing -> [(n, method)]
20 Just (As m) -> [(n, method)]
21 Just _ -> []
23prelude = text : map (\n -> (n, Hiding [])) modules
24 where
25 text = ("Graphics.Text", Hiding ["link", "color", "height"])
26 modules = [ "Prelude", "Signal", "List", "Maybe", "Time"
27 , "Graphics.Element", "Graphics.Color"
28 , "Graphics.Collage", "Graphics.Geometry" ]
30libraries :: Map.Map String (Map.Map String String)
31libraries =
32 case getLibs of
33 Error err -> error err
34 Ok libs -> Map.unionWith Map.union libs nilAndTuples
35 where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)
36 pairs =
37 [ ("Cons", "a -> [a] -> [a]")
38 , ("Nil", "[a]")
39 ] ++ map makeTuple (inits ['a'..'i'])
41 makeTuple cs =
42 let name = "Tuple" ++ show (length cs)
43 in (name, concatMap (\c -> c : " -> ") cs ++
44 name ++ concatMap (\c -> [' ',c]) cs)
46getLibs :: Result (Map.Map String (Map.Map String String))
47getLibs = do
48 obj <- decodeStrict docs :: Result (JSObject JSValue)
49 modules <- valFromObj "modules" obj :: Result [JSObject JSValue]
50 Map.fromList `fmap` mapM getValues modules
53getName :: JSObject JSValue -> Result String
54getName obj = valFromObj "name" obj
56getType :: JSObject JSValue -> Result String
57getType obj = valFromObj "type" obj
59getValue :: JSObject JSValue -> Result (String,String)
60getValue obj = do n <- getName obj
61 t <- getType obj
62 return (n,t)
64getValues :: JSObject JSValue -> Result (String, Map.Map String String)
65getValues obj = do
66 name <- getName obj
67 vs <- valFromObj "values" obj
68 vals <- mapM getValue vs
69 return (name, Map.fromList vals)