2013-04-04 08:09:35 +00:00
|
|
|
module Libraries (libraries, prelude) where
|
2013-03-17 05:24:18 +00:00
|
|
|
|
2013-04-04 08:09:35 +00:00
|
|
|
import Ast
|
2013-03-17 05:24:18 +00:00
|
|
|
import qualified Data.Map as Map
|
2013-04-04 08:09:35 +00:00
|
|
|
import Data.List (inits)
|
2013-03-17 05:24:18 +00:00
|
|
|
import Text.JSON
|
2013-03-22 15:52:40 +00:00
|
|
|
import LoadLibraries (docs)
|
2013-03-17 05:24:18 +00:00
|
|
|
|
2013-04-04 08:09:35 +00:00
|
|
|
prelude = text : map (\n -> (n, Hiding [])) modules
|
|
|
|
where
|
|
|
|
text = ("Graphics.Text", Hiding ["link", "color"])
|
|
|
|
modules = [ "Prelude", "Signal", "List", "Maybe", "Time"
|
|
|
|
, "Graphics.Element", "Graphics.Color"
|
|
|
|
, "Graphics.Collage", "Graphics.Geometry" ]
|
|
|
|
|
2013-03-17 05:24:18 +00:00
|
|
|
libraries :: Map.Map String (Map.Map String String)
|
|
|
|
libraries = case getLibs of
|
|
|
|
Error err -> error err
|
2013-04-04 08:09:35 +00:00
|
|
|
Ok libs -> Map.unionWith Map.union libs nilAndTuples
|
|
|
|
where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)
|
|
|
|
pairs = ("Nil", "List a") : map makeTuple (inits ['a'..'i'])
|
|
|
|
makeTuple cs =
|
|
|
|
let name = "Tuple" ++ show (length cs)
|
|
|
|
in (name, concatMap (\c -> c : " -> ") cs ++
|
|
|
|
name ++ concatMap (\c -> [' ',c]) cs)
|
2013-03-17 05:24:18 +00:00
|
|
|
|
|
|
|
getLibs :: Result (Map.Map String (Map.Map String String))
|
|
|
|
getLibs = do
|
2013-03-22 15:52:40 +00:00
|
|
|
obj <- decodeStrict docs :: Result (JSObject JSValue)
|
2013-03-17 05:24:18 +00:00
|
|
|
modules <- valFromObj "modules" obj :: Result [JSObject JSValue]
|
|
|
|
Map.fromList `fmap` mapM getValues modules
|
|
|
|
|
|
|
|
|
|
|
|
getName :: JSObject JSValue -> Result String
|
|
|
|
getName obj = valFromObj "name" obj
|
|
|
|
|
|
|
|
getType :: JSObject JSValue -> Result String
|
|
|
|
getType obj = valFromObj "type" obj
|
|
|
|
|
|
|
|
getValue :: JSObject JSValue -> Result (String,String)
|
|
|
|
getValue obj = do n <- getName obj
|
|
|
|
t <- getType obj
|
|
|
|
return (n,t)
|
|
|
|
|
|
|
|
getValues :: JSObject JSValue -> Result (String, Map.Map String String)
|
|
|
|
getValues obj = do
|
|
|
|
name <- getName obj
|
|
|
|
vs <- valFromObj "values" obj
|
|
|
|
vals <- mapM getValue vs
|
|
|
|
return (name, Map.fromList vals)
|