yogsototh/elm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge branch 'dev'

Browse source
This commit is contained in:
Evan Czaplicki 2014-01-20 22:12:54 +01:00
commit 4c27440fcb
22 changed files with 147 additions and 165 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
compiler/Build/File.hs
View file

@ -10,6 +10,7 @@ import System.FilePath
import System.IO
import qualified Data.Binary as Binary
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import qualified Data.Map as Map
import qualified Data.ByteString.Lazy as L
@ -34,17 +35,37 @@ type Build a = BuildT IO a
-- Interfaces, remembering if something was recompiled
type BInterfaces = Map.Map String (Bool, M.ModuleInterface)
evalBuild :: Flag.Flags -> M.Interfaces -> Build () -> IO (Maybe String)
evalBuild flags interfaces b = do
(_, s) <- evalRWST b flags (fmap notUpdated interfaces)
return . getLast $ s
evalBuild :: Flag.Flags -> M.Interfaces -> Build ()
-> IO (Map.Map String M.ModuleInterface, Maybe String)
evalBuild flags interfaces build =
do (ifaces, moduleNames) <- execRWST build flags (fmap notUpdated interfaces)
return (fmap snd ifaces, getLast moduleNames)
where
notUpdated i = (False, i)
notUpdated iface = (False, iface)
-- | Builds a list of files, returning the moduleName of the last one.
-- Returns \"\" if the list is empty
build :: Flag.Flags -> M.Interfaces -> [FilePath] -> IO String
build flags is = fmap (Maybe.fromMaybe "") . evalBuild flags is . buildAll
build flags interfaces files =
do (ifaces, topName) <- evalBuild flags interfaces (buildAll files)
let removeTopName = Maybe.maybe id Map.delete topName
mapM_ (checkPorts topName) (Map.toList $ removeTopName ifaces)
return $ Maybe.fromMaybe "" topName
where
checkPorts topName (name,iface)
| null ports = return ()
| otherwise = Print.failure msg
where
ports = M.iPorts iface
msg = concat
[ "Port Error: ports may only appear in the main module, but\n"
, " sub-module ", name, " declares the following port"
, if length ports == 1 then "" else "s", ": "
, List.intercalate ", " ports
, case topName of
Nothing -> ""
Just tname -> "\n All ports must appear in module " ++ tname
]
buildAll :: [FilePath] -> Build ()
buildAll fs = mapM_ (uncurry build1) (zip [1..] fs)
@ -152,5 +173,6 @@ compile number filePath =
L.hPut handle (Binary.encode (name, interfs))
update :: String -> M.ModuleInterface -> Bool -> Build ()
update name inter wasUpdated = modify (Map.insert name (wasUpdated, inter))
>> tell (Last . Just $ name)
update name inter wasUpdated =
do modify (Map.insert name (wasUpdated, inter))
tell (Last . Just $ name)

11
compiler/Build/Interface.hs
View file

@ -4,28 +4,23 @@ module Build.Interface (load,isValid) where
import qualified Data.ByteString.Lazy as L
import qualified Data.Binary as Binary
import qualified Build.Print as Print
import qualified Elm.Internal.Version as Version
import System.Directory (doesFileExist)
import System.Exit
import System.IO
import SourceSyntax.Module
load :: Binary.Binary a => FilePath -> IO a
load filePath =
do exists <- doesFileExist filePath
case exists of
False -> failure $ "Unable to find file " ++ filePath ++ " for deserialization!"
False -> Print.failure $ "Unable to find file " ++ filePath ++ " for deserialization!"
True -> do
bytes <- L.readFile filePath
case Binary.decodeOrFail bytes of
Right (_, _, binaryInfo) -> return binaryInfo
Left (_, offset, err) -> failure $ msg offset err
Left (_, offset, err) -> Print.failure $ msg offset err
where
failure err = do hPutStrLn stderr err
exitFailure
msg offset err = concat
[ "Error reading build artifact: ", filePath, "\n"
, " '", err, "' at offset ", show offset, "\n"

9
compiler/Build/Source.hs
View file

@ -35,8 +35,8 @@ build noPrelude interfaces source =
| null exs =
let get = Set.toList . Pattern.boundVars in
concat [ get pattern | Definition (Expr.Definition pattern _ _) <- decls ] ++
concat [ map fst ctors | Datatype _ _ ctors _ <- decls ] ++
[ name | TypeAlias name _ (Type.Record _ _) _ <- decls ]
concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
[ name | TypeAlias name _ (Type.Record _ _) <- decls ]
| otherwise = exs
metaModule <- Canonical.metadataModule interfaces $
@ -48,9 +48,10 @@ build noPrelude interfaces source =
-- reorder AST into strongly connected components
, program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls
, types = Map.empty
, datatypes = [ (name,vars,ctors,ds) | Datatype name vars ctors ds <- decls ]
, datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ]
, fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ]
, aliases = [ (name,tvs,tipe,ds) | TypeAlias name tvs tipe ds <- decls ]
, aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ]
, ports = [ portName port | Port port <- decls ]
}
types <- TI.infer interfaces metaModule

12
compiler/Docs.hs
View file

@ -134,14 +134,13 @@ collect infixes types aliases adts things =
collect (Map.insert name (assoc,prec) infixes) types aliases adts rest
D.Definition (E.TypeAnnotation name tipe) ->
collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest
D.TypeAlias name vars tipe derivations ->
let fields = ["typeVariables" .= vars, "type" .= tipe, "deriving" .= derivations ]
D.TypeAlias name vars tipe ->
let fields = ["typeVariables" .= vars, "type" .= tipe ]
in collect infixes types (insert name fields aliases) adts rest
D.Datatype name vars ctors derivations ->
D.Datatype name vars ctors ->
let tipe = Data name (map Var vars)
fields = ["typeVariables" .= vars
, "constructors" .= map (ctorToJson tipe) ctors
, "deriving" .= derivations ]
, "constructors" .= map (ctorToJson tipe) ctors ]
in collect infixes types aliases (insert name fields adts) rest
where
insert name fields dict = Map.insert name (obj name fields) dict
@ -162,6 +161,3 @@ instance ToJSON Type where
ctorToJson tipe (ctor, tipes) =
object [ "name" .= ctor
, "type" .= foldr Lambda tipe tipes ]
instance ToJSON D.Derivation where
toJSON = toJSON . show

10
compiler/Parse/Declaration.hs
View file

@ -24,11 +24,7 @@ alias = do
args <- spacePrefix lowVar
padded equals
tipe <- Type.expr
json <- option [] $ do
try $ padded (reserved "deriving")
string "Json"
return [D.Json]
return (D.TypeAlias name args tipe json)
return (D.TypeAlias name args tipe)
datatype :: IParser D.ParseDeclaration
datatype = do
@ -38,7 +34,7 @@ datatype = do
args <- spacePrefix lowVar
padded equals
tcs <- pipeSep1 Type.constructor
return $ D.Datatype name args tcs []
return $ D.Datatype name args tcs
infixDecl :: IParser D.ParseDeclaration
@ -60,4 +56,4 @@ port =
whitespace
let port' op ctor expr = do { try op ; whitespace ; ctor name <$> expr }
D.Port <$> choice [ port' hasType D.PPAnnotation Type.expr
, port' equals D.PPDef Expr.expr ]
, port' equals D.PPDef Expr.expr ]

0
compiler/Paths_Elm.h → compiler/Paths_Elm
View file

47
compiler/SourceSyntax/Declaration.hs
View file

@ -9,8 +9,8 @@ import Text.PrettyPrint as P
data Declaration' port def
= Definition def
| Datatype String [String] [(String,[T.Type])] [Derivation]
| TypeAlias String [String] T.Type [Derivation]
| Datatype String [String] [(String,[T.Type])]
| TypeAlias String [String] T.Type
| Port port
| Fixity Assoc Int String
deriving (Show)
@ -18,9 +18,6 @@ data Declaration' port def
data Assoc = L | N | R
deriving (Eq)
data Derivation = Json | JS | Binary | New
deriving (Eq, Show)
data ParsePort
= PPAnnotation String T.Type
| PPDef String Expr.LParseExpr
@ -31,26 +28,15 @@ data Port
| In String T.Type
deriving (Show)
portName :: Port -> String
portName port =
case port of
Out name _ _ -> name
In name _ -> name
type ParseDeclaration = Declaration' ParsePort Expr.ParseDef
type Declaration = Declaration' Port Expr.Def
instance Binary Derivation where
get = do n <- getWord8
return $ case n of
0 -> Json
1 -> JS
2 -> Binary
3 -> New
_ -> error "Unable to decode Derivation. You may have corrupted binary files,\n\
\so please report an issue at <https://github.com/evancz/Elm/issues>"
put derivation =
putWord8 $ case derivation of
Json -> 0
JS -> 1
Binary -> 2
New -> 3
instance Show Assoc where
show assoc =
case assoc of
@ -73,19 +59,18 @@ instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where
case decl of
Definition def -> pretty def
Datatype tipe tvars ctors deriveables ->
Datatype tipe tvars ctors ->
P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4
(P.sep $ zipWith join ("=" : repeat "|") ctors) <+> prettyDeriving deriveables
(P.sep $ zipWith join ("=" : repeat "|") ctors)
where
join c ctor = P.text c <+> prettyCtor ctor
prettyCtor (name, tipes) =
P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))
TypeAlias name tvars tipe deriveables ->
alias <+> prettyDeriving deriveables
TypeAlias name tvars tipe ->
P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
where
name' = P.text name <+> P.hsep (map P.text tvars)
alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)
Port port -> pretty port
@ -112,11 +97,3 @@ instance Pretty Port where
prettyPort :: (Pretty a) => String -> String -> a -> Doc
prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e
prettyDeriving :: [Derivation] -> Doc
prettyDeriving deriveables =
case deriveables of
[] -> P.empty
[d] -> P.text "deriving" <+> P.text (show d)
ds -> P.text "deriving" <+>
P.parens (P.hsep $ P.punctuate P.comma $ map (P.text . show) ds)

27
compiler/SourceSyntax/Module.hs
View file

@ -47,20 +47,23 @@ data MetadataModule =
, fixities :: [(Assoc, Int, String)]
, aliases :: [Alias]
, datatypes :: [ADT]
, ports :: [String]
} deriving Show
type Interfaces = Map.Map String ModuleInterface
type ADT = (String, [String], [(String,[Type])], [Derivation])
type Alias = (String, [String], Type, [Derivation])
type ADT = (String, [String], [(String,[Type])])
type Alias = (String, [String], Type)
data ModuleInterface = ModuleInterface {
iVersion :: Version.Version,
iTypes :: Map.Map String Type,
iImports :: [(String, ImportMethod)],
iAdts :: [ADT],
iAliases :: [Alias],
iFixities :: [(Assoc, Int, String)]
} deriving Show
data ModuleInterface =
ModuleInterface
{ iVersion :: Version.Version
, iTypes :: Map.Map String Type
, iImports :: [(String, ImportMethod)]
, iAdts :: [ADT]
, iAliases :: [Alias]
, iFixities :: [(Assoc, Int, String)]
, iPorts :: [String]
} deriving Show
metaToInterface :: MetadataModule -> ModuleInterface
metaToInterface metaModule =
@ -71,10 +74,11 @@ metaToInterface metaModule =
, iAdts = datatypes metaModule
, iAliases = aliases metaModule
, iFixities = fixities metaModule
, iPorts = ports metaModule
}
instance Binary ModuleInterface where
get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get <*> get
put modul = do
put (iVersion modul)
put (iTypes modul)
@ -82,3 +86,4 @@ instance Binary ModuleInterface where
put (iAdts modul)
put (iAliases modul)
put (iFixities modul)
put (iPorts modul)

15
compiler/Transform/Canonicalize.hs
View file

@ -25,13 +25,14 @@ interface moduleName iface =
, iAdts = map (both prefix renameCtors) (iAdts iface)
, iAliases = map (both prefix renameType') (iAliases iface)
, iFixities = iFixities iface -- cannot have canonicalized operators while parsing
, iPorts = iPorts iface
}
where
both f g (a,b,c,d) = (f a, b, g c, d)
both f g (a,b,c) = (f a, b, g c)
prefix name = moduleName ++ "." ++ name
pair name = (name, moduleName ++ "." ++ name)
canon (name,_,_,_) = pair name
canon (name,_,_) = pair name
canons = Map.fromList $ concat
[ map canon (iAdts iface), map canon (iAliases iface) ]
@ -56,24 +57,24 @@ metadataModule ifaces modul =
[] -> Right ()
missings -> Left [ P.text $ "The following imports were not found: " ++ List.intercalate ", " missings ]
program' <- rename initialEnv (program modul)
aliases' <- mapM (three4 renameType') (aliases modul)
datatypes' <- mapM (three4 (mapM (two2 (mapM renameType')))) (datatypes modul)
aliases' <- mapM (three3 renameType') (aliases modul)
datatypes' <- mapM (three3 (mapM (two2 (mapM renameType')))) (datatypes modul)
return $ modul { program = program'
, aliases = aliases'
, datatypes = datatypes' }
where
two2 f (a,b) = (,) a <$> f b
three4 f (a,b,c,d) = (,,,) a b <$> f c <*> return d
three3 f (a,b,c) = (,,) a b <$> f c
renameType' =
Either.either (\err -> Left [P.text err]) return . renameType (replace "type" initialEnv)
get1 (a,_,_,_) = a
get1 (a,_,_) = a
canon (name, importMethod) =
let pair pre var = (pre ++ drop (length name + 1) var, var)
iface = ifaces Map.! name
allNames = concat [ Map.keys (iTypes iface)
, map get1 (iAliases iface)
, concat [ n : map fst ctors | (n,_,ctors,_) <- iAdts iface ] ]
, concat [ n : map fst ctors | (n,_,ctors) <- iAdts iface ] ]
in case importMethod of
As alias -> map (pair (alias ++ ".")) allNames
Hiding vars -> map (pair "") $ filter (flip Set.notMember vs) allNames

42
compiler/Transform/Check.hs
View file

@ -21,8 +21,7 @@ mistakes decls =
concat [ infiniteTypeAliases decls
, illFormedTypes decls
, map P.text (duplicateConstructors decls)
, map P.text (duplicates decls)
, badDerivations decls ]
, map P.text (duplicates decls) ]
dups :: Ord a => [a] -> [a]
dups = map head . filter ((>1) . length) . List.group . List.sort
@ -67,35 +66,14 @@ duplicateConstructors decls =
map (dupErr "definition of type constructor") (dups typeCtors) ++
map (dupErr "definition of data constructor") (dups dataCtors)
where
typeCtors = [ name | D.Datatype name _ _ _ <- decls ]
dataCtors = concat [ map fst patterns | D.Datatype _ _ patterns _ <- decls ]
badDerivations :: [D.Declaration] -> [Doc]
badDerivations decls = concatMap badDerivation derivations
where
derivations =
[ (decl, tvars, derives) | decl@(D.TypeAlias _ tvars _ derives) <- decls ] ++
[ (decl, tvars, derives) | decl@(D.Datatype _ tvars _ derives) <- decls ]
badDerivation (decl, tvars, derives) =
case (tvars, derives) of
(_:_, _)
| D.Json `elem` derives -> [report decl D.Json]
| D.Binary `elem` derives -> [report decl D.Binary]
_ -> []
report decl derive =
P.vcat [ P.text $ "Error: cannot derive '" ++ show derive ++ "' from this type alias."
, P.text "Make sure all type variables are replaced with concrete types:"
, P.text "\n"
, nest 4 (pretty decl)
]
typeCtors = [ name | D.Datatype name _ _ <- decls ]
dataCtors = concat [ map fst patterns | D.Datatype _ _ patterns <- decls ]
illFormedTypes :: [D.Declaration] -> [Doc]
illFormedTypes decls = map report (Maybe.mapMaybe isIllFormed (aliases ++ adts))
where
aliases = [ (decl, tvars, [tipe]) | decl@(D.TypeAlias _ tvars tipe _) <- decls ]
adts = [ (decl, tvars, concatMap snd ctors) | decl@(D.Datatype _ tvars ctors _) <- decls ]
aliases = [ (decl, tvars, [tipe]) | decl@(D.TypeAlias _ tvars tipe) <- decls ]
adts = [ (decl, tvars, concatMap snd ctors) | decl@(D.Datatype _ tvars ctors) <- decls ]
freeVars tipe =
case tipe of
@ -138,8 +116,8 @@ illFormedTypes decls = map report (Maybe.mapMaybe isIllFormed (aliases ++ adts))
infiniteTypeAliases :: [D.Declaration] -> [Doc]
infiniteTypeAliases decls =
[ report name tvars tipe ds | D.TypeAlias name tvars tipe ds <- decls
, infiniteType name tipe ]
[ report name tvars tipe | D.TypeAlias name tvars tipe <- decls
, infiniteType name tipe ]
where
infiniteType name tipe =
let infinite = infiniteType name in
@ -152,11 +130,11 @@ infiniteTypeAliases decls =
indented :: D.Declaration -> Doc
indented decl = P.text "\n " <> pretty decl <> P.text "\n"
report name args tipe derivations =
report name args tipe =
P.vcat [ P.text $ eightyCharLines 0 msg1
, indented $ D.TypeAlias name args tipe derivations
, indented $ D.TypeAlias name args tipe
, P.text $ eightyCharLines 0 msg2
, indented $ D.Datatype name args [(name,[tipe])] derivations
, indented $ D.Datatype name args [(name,[tipe])]
, P.text $ eightyCharLines 0 msg3 ++ "\n"
]
where

8
compiler/Transform/Declaration.hs
View file

@ -23,11 +23,11 @@ combineAnnotations = go
-- simple cases, pass them through with no changes
[] -> return []
Datatype name tvars ctors ds : rest ->
(:) (Datatype name tvars ctors ds) <$> go rest
Datatype name tvars ctors : rest ->
(:) (Datatype name tvars ctors) <$> go rest
TypeAlias name tvars alias ds : rest ->
(:) (TypeAlias name tvars alias ds) <$> go rest
TypeAlias name tvars alias : rest ->
(:) (TypeAlias name tvars alias) <$> go rest
Fixity assoc prec op : rest ->
(:) (Fixity assoc prec op) <$> go rest

6
compiler/Transform/SafeNames.hs
View file

@ -64,9 +64,9 @@ metadataModule modul =
, imports = map (first var) (imports modul)
, program = expression (program modul)
, aliases =
let makeSafe (name,tvars,tipe,ds) = (var name, tvars, tipe, ds)
let makeSafe (name,tvars,tipe) = (var name, tvars, tipe)
in map makeSafe (aliases modul)
, datatypes =
let makeSafe (name,tvars,ctors,ds) = (var name, tvars, map (first var) ctors, ds)
let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)
in map makeSafe (datatypes modul)
}
}

6
compiler/Type/Alias.hs
View file

@ -21,7 +21,7 @@ collect interfaces moduleAliases =
rawAliases =
moduleAliases ++ concatMap iAliases (Map.elems interfaces)
isPrimitive (_,_,tipe,_) =
isPrimitive (_,_,tipe) =
case tipe of
Data _ [] -> True
_ -> False
@ -68,7 +68,7 @@ canonicalRealias aliases tipe =
[] -> if tipe == tipe' then tipe else f tipe'
tipes -> f (bestType tipes)
where
tryRealias (name, args, aliasTipe, _) =
tryRealias (name, args, aliasTipe) =
case diff aliasTipe tipe of
Nothing -> []
Just kvs ->
@ -136,4 +136,4 @@ collectFields fields =
foldr (\(f,t) fs -> Map.insertWith (++) f [t] fs) Map.empty fields
flattenFields fields =
concatMap (\(f,ts) -> map ((,) f) ts) (Map.toList fields)
concatMap (\(f,ts) -> map ((,) f) ts) (Map.toList fields)

9
compiler/Type/Constrain/Declaration.hs
View file

@ -15,7 +15,7 @@ toDefs decl =
case decl of
Definition def -> [def]
Datatype name tvars constructors _ -> concatMap toDefs' constructors
Datatype name tvars constructors -> concatMap toDefs' constructors
where
toDefs' (ctor, tipes) =
let vars = take (length tipes) arguments
@ -23,7 +23,7 @@ toDefs decl =
body = L.none . E.Data ctor $ map (L.none . E.Var) vars
in [ definition ctor (buildFunction body vars) (foldr T.Lambda tbody tipes) ]
TypeAlias name _ tipe@(T.Record fields ext) _ ->
TypeAlias name _ tipe@(T.Record fields ext) ->
[ definition name (buildFunction record vars) (foldr T.Lambda tipe args) ]
where
args = map snd fields ++ maybe [] (\x -> [T.Var x]) ext
@ -38,8 +38,7 @@ toDefs decl =
-- Type aliases must be added to an extended equality dictionary,
-- but they do not require any basic constraints.
-- TODO: with the ability to derive code, you may need to generate stuff!
TypeAlias _ _ _ _ -> []
TypeAlias _ _ _ -> []
Port port ->
case port of
@ -60,4 +59,4 @@ buildFunction body@(L.L s _) vars =
foldr (\p e -> L.L s (E.Lambda p e)) body (map P.PVar vars)
definition :: String -> E.LExpr -> T.Type -> E.Def
definition name expr tipe = E.Definition (P.PVar name) expr (Just tipe)
definition name expr tipe = E.Definition (P.PVar name) expr (Just tipe)

8
compiler/Type/Environment.hs
View file

@ -29,7 +29,7 @@ data Environment = Environment {
initialEnvironment :: [ADT] -> [Alias] -> IO Environment
initialEnvironment datatypes aliases = do
types <- makeTypes datatypes
let aliases' = Map.fromList $ map (\(a,b,c,_) -> (a,(b,c))) aliases
let aliases' = Map.fromList $ map (\(a,b,c) -> (a,(b,c))) aliases
env = Environment {
constructor = Map.empty,
value = Map.empty,
@ -42,7 +42,7 @@ makeTypes :: [ADT] -> IO TypeDict
makeTypes datatypes =
Map.fromList <$> mapM makeCtor (builtins ++ map nameAndKind datatypes)
where
nameAndKind (name, tvars, _, _) = (name, length tvars)
nameAndKind (name, tvars, _) = (name, length tvars)
makeCtor (name, _) = do
ctor <- VarN <$> namedVar Constant name
@ -84,7 +84,7 @@ makeConstructors env datatypes = Map.fromList builtins
ctorToType :: Environment -> ADT -> [ (String, IO (Int, [Variable], [Type], Type)) ]
ctorToType env (name, tvars, ctors, _) =
ctorToType env (name, tvars, ctors) =
zip (map fst ctors) (map inst ctors)
where
inst :: (String, [Src.Type]) -> IO (Int, [Variable], [Type], Type)
@ -167,4 +167,4 @@ instantiator env sourceType = go sourceType
ext' <- case ext of
Nothing -> return $ TermN EmptyRecord1
Just x -> go (Src.Var x)
return $ TermN (Record1 fields' ext')
return $ TermN (Record1 fields' ext')

6
libraries/Native/List.js
View file

@ -55,7 +55,7 @@ Elm.Native.List.make = function(elm) {
function append(xs,ys) {
// append Text
if (xs.text || ys.text) {
return Utils.txt(Utils.makeText('',xs) + Utils.makeText('',ys));
return Utils.txt(Utils.makeText(xs) + Utils.makeText(ys));
}
// append Strings
@ -270,10 +270,10 @@ Elm.Native.List.make = function(elm) {
function join(sep, xss) {
if (sep.text) {
sep = Utils.makeText('',sep);
sep = Utils.makeText(sep);
xss = toArray(xss);
for (var i = xss.length; i--; ) {
xss[i] = Utils.makeText('',xss[i]);
xss[i] = Utils.makeText(xss[i]);
}
return Utils.txt(xss.join(sep));
}

12
libraries/Native/Text.js
View file

@ -91,10 +91,11 @@ Elm.Native.Text.make = function(elm) {
function position(align) {
function create(text) {
var raw = {
ctor:'RawHtml',
html: Utils.makeText('text-align:' + align + ';', text),
guid: null,
args: [],
ctor :'RawHtml',
html : Utils.makeText(text),
align: align,
guid : null,
args : [],
};
var pos = A2(Utils.htmlHeight, 0, raw);
return A3(Element.newElement, pos._0, pos._1, raw);
@ -106,6 +107,7 @@ Elm.Native.Text.make = function(elm) {
var raw = {
ctor:'RawHtml',
html: text,
align: null,
guid: guid,
args: [],
};
@ -145,4 +147,4 @@ Elm.Native.Text.make = function(elm) {
asText : asText,
};
};
};

4
libraries/Native/Utils.js
View file

@ -74,8 +74,8 @@ Elm.Native.Utils.make = function(elm) {
return t;
}
function makeText(style, text) {
var style = style;
function makeText(text) {
var style = '';
var line = '';
var href = '';
while (true) {

21
libraries/Signal.elm
View file

@ -106,13 +106,13 @@ countIf = Native.Signal.countIf
{-| Keep only events that satisfy the given predicate. Elm does not allow
undefined signals, so a base case must be provided in case the predicate is
never satisfied. -}
not satisfied initially. -}
keepIf : (a -> Bool) -> a -> Signal a -> Signal a
keepIf = Native.Signal.keepIf
{-| Drop events that satisfy the given predicate. Elm does not allow undefined
signals, so a base case must be provided in case the predicate is never
satisfied. -}
signals, so a base case must be provided in case the predicate is satisfied
initially. -}
dropIf : (a -> Bool) -> a -> Signal a -> Signal a
dropIf = Native.Signal.dropIf
@ -120,21 +120,24 @@ dropIf = Native.Signal.dropIf
becomes true, the most recent value of the second signal will be propagated.
Until the first signal becomes false again, all events will be propagated. Elm
does not allow undefined signals, so a base case must be provided in case the
first signal is never true. -}
first signal is not true initially. -}
keepWhen : Signal Bool -> a -> Signal a -> Signal a
keepWhen = Native.Signal.keepWhen
{-| Drop events when the first signal is true. When the first signal becomes
false, the most recent value of the second signal will be propagated. Until the
first signal becomes true again, all events will be propagated. Elm does not
allow undefined signals, so a base case must be provided in case the first
signal is always true. -}
allow undefined signals, s oa base case must be provided in case the first
signal is true initially. -}
dropWhen : Signal Bool -> a -> Signal a -> Signal a
dropWhen = Native.Signal.dropWhen
{-| Drop sequential repeated values. For example, if a signal produces the
sequence `[1,1,2,2,1]`, it becomes `[1,2,1]` by dropping the values that are the
same as the previous value. -}
{-| Drop updates that repeat the current value of the signal.
Imagine a signal `numbers` has initial value
0 and then updates with values 0, 0, 1, 1, and 2. `dropRepeats numbers`
is a signal that has initial value 0 and updates as follows: ignore 0,
ignore 0, update to 1, ignore 1, update to 2. -}
dropRepeats : Signal a -> Signal a
dropRepeats = Native.Signal.dropRepeats

10
libraries/Time.elm
View file

@ -81,9 +81,13 @@ each mouse click and false otherwise.
since : Time -> Signal a -> Signal Bool
since = Native.Time.since
{-| Add a timestamp to any signal. Timestamps increase monotonically. Each
timestamp is related to a specfic event, so `Mouse.x` and `Mouse.y` will always
have the same timestamp because they both rely on the same underlying event.
{-| Add a timestamp to any signal. Timestamps increase monotonically. When you
create `(timestamp Mouse.x)`, an initial timestamp is produced. The timestamp
updates whenever `Mouse.x` updates.
Timestamp updates are tied to individual events, so
`(timestamp Mouse.x)` and `(timestamp Mouse.y)` will always have the same
timestamp because they rely on the same underlying event (`Mouse.position`).
-}
timestamp : Signal a -> Signal (Time, a)
timestamp = Native.Time.timestamp

9
runtime/Init.js
View file

@ -220,14 +220,15 @@ function initGraphics(elm, Module) {
elm.node.appendChild(Render.render(currentScene));
// set up updates so that the DOM is adjusted as necessary.
function domUpdate(newScene, currentScene) {
var savedScene = currentScene;
function domUpdate(newScene) {
ElmRuntime.draw(function(_) {
Render.update(elm.node.firstChild, currentScene, newScene);
Render.update(elm.node.firstChild, savedScene, newScene);
if (elm.Native.Window) elm.Native.Window.values.resizeIfNeeded();
savedScene = newScene;
});
return newScene;
}
var renderer = A3(Signal.foldp, F2(domUpdate), currentScene, signalGraph);
var renderer = A2(Signal.lift, domUpdate, signalGraph);
// must check for resize after 'renderer' is created so
// that changes show up.

2
runtime/Render/Element.js
View file

@ -158,10 +158,12 @@ function rawHtml(elem) {
var html = elem.html;
var args = elem.args;
var guid = elem.guid;
var align = elem.align;
var div = newElement('div');
div.innerHTML = html;
div.style.visibility = "hidden";
if (align) div.style.textAlign = align;
document.body.appendChild(div);
for (var i = args.length; i--; ) {