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