Add markdown support. Add minification support.
This commit is contained in:
evancz
parent
38d0e8f2e6
commit
0391c1ce9a
6 changed files with 78 additions and 32 deletions
|
|
@ -68,7 +68,9 @@ Library
|
|||
text,
|
||||
template-haskell,
|
||||
shakespeare,
|
||||
pandoc
|
||||
pandoc,
|
||||
bytestring,
|
||||
hjsmin
|
||||
|
||||
Executable elm
|
||||
Main-is: Compiler.hs
|
||||
|
|
@ -106,4 +108,6 @@ Executable elm
|
|||
blaze-markup == 0.5.1.*,
|
||||
deepseq,
|
||||
cmdargs,
|
||||
pandoc
|
||||
pandoc,
|
||||
bytestring,
|
||||
hjsmin
|
||||
|
|
|
|||
|
|
@ -1,4 +1,25 @@
|
|||
|
||||
Release 0.4.0
|
||||
=============
|
||||
|
||||
This version is all about graphics: nicer API with more features and major
|
||||
efficiency improvements. I am really excited about this release!
|
||||
|
||||
* Add native Markdown support. You can now embed markdown directly in .elm files
|
||||
and it is used as an `Element`. Syntax is `[markdown| ... |]` where `...` is
|
||||
formatted as described [here](http://daringfireball.net/projects/markdown/).
|
||||
Content can span multiple lines too.
|
||||
|
||||
* Drastically improve the `collage` interface. You can now move, rotate, and scale
|
||||
the following forms:
|
||||
- Lines
|
||||
- Shapes (shapes can be textured now too)
|
||||
- Images
|
||||
- Elements (any Element you want can be turned into a Form with `toForm`)
|
||||
This will make it way easier to make games in Elm.
|
||||
|
||||
* Add `--minify` flag, to minify JS code.
|
||||
|
||||
Release 0.3.6
|
||||
=============
|
||||
|
||||
|
|
|
|||
|
|
@ -7,6 +7,9 @@ import Data.Maybe (fromMaybe)
|
|||
import System.Console.CmdArgs
|
||||
import Text.Blaze.Html.Renderer.String (renderHtml)
|
||||
|
||||
import qualified Text.Jasmine as JS
|
||||
import qualified Data.ByteString.Lazy.Char8 as BS
|
||||
|
||||
import Ast
|
||||
import Initialize
|
||||
import CompileToJS
|
||||
|
|
@ -22,6 +25,7 @@ data ELM =
|
|||
, only_js :: Bool
|
||||
, import_js :: [FilePath]
|
||||
, generate_noscript :: Bool
|
||||
, minify :: Bool
|
||||
}
|
||||
deriving (Data,Typeable,Show,Eq)
|
||||
|
||||
|
|
@ -33,26 +37,29 @@ elm = ELM { make = False &= help "automatically compile dependencies."
|
|||
, only_js = False &= help "Compile only to JavaScript."
|
||||
, import_js = [] &= typFile &= help "Include a JavaScript file before the body of the Elm program. Can be used many times. Files will be included in the given order."
|
||||
, generate_noscript = True &= help "Add generated <noscript> tag to HTML output."
|
||||
, minify = False &= help "Minify generated JavaScript"
|
||||
} &=
|
||||
help "Compile Elm programs to HTML, CSS, and JavaScript." &=
|
||||
summary "The Elm Compiler v0.3.6.2, (c) Evan Czaplicki"
|
||||
summary "The Elm Compiler v0.4.0, (c) Evan Czaplicki"
|
||||
|
||||
main = do
|
||||
args <- cmdArgs elm
|
||||
mini <- getDataFileName "elm-runtime-0.3.6.2.js"
|
||||
mini <- getDataFileName "elm-runtime-0.4.0.js"
|
||||
compileArgs mini args
|
||||
|
||||
compileArgs mini (ELM _ [] _ _ _ _ _) =
|
||||
compileArgs mini (ELM _ [] _ _ _ _ _ _) =
|
||||
putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
|
||||
compileArgs mini (ELM make files rtLoc split only js nscrpt) =
|
||||
mapM_ (fileTo get what js nscrpt $ fromMaybe mini rtLoc) files
|
||||
compileArgs mini (ELM make files rtLoc split only js nscrpt isMini) =
|
||||
mapM_ (fileTo isMini get what js nscrpt $ fromMaybe mini rtLoc) files
|
||||
where get = if make then getModules [] else getModule
|
||||
what = if only then JS else
|
||||
if split then Split else HTML
|
||||
|
||||
data What = JS | HTML | Split
|
||||
|
||||
fileTo get what jsFiles noscript rtLoc file = do
|
||||
fileTo isMini get what jsFiles noscript rtLoc file = do
|
||||
let jsStyle = if isMini then Minified else Readable
|
||||
let formatJS = if isMini then BS.unpack . JS.minify . BS.pack else id
|
||||
ems <- get file
|
||||
jss <- concat `fmap` mapM readFile jsFiles
|
||||
case ems of
|
||||
|
|
@ -62,11 +69,11 @@ fileTo get what jsFiles noscript rtLoc file = do
|
|||
js = name ++ ".js"
|
||||
html = name ++ ".html"
|
||||
in case what of
|
||||
JS -> writeFile js $ jss ++ concatMap jsModule ms
|
||||
HTML -> writeFile html . renderHtml $ modulesToHtml "" rtLoc jss noscript ms
|
||||
JS -> writeFile js . formatJS $ jss ++ concatMap jsModule ms
|
||||
HTML -> writeFile html . renderHtml $ modulesToHtml jsStyle "" rtLoc jss noscript ms
|
||||
Split -> do
|
||||
writeFile html . renderHtml $ linkedHtml rtLoc js ms
|
||||
writeFile js $ jss ++ concatMap jsModule ms
|
||||
writeFile js . formatJS $ jss ++ concatMap jsModule ms
|
||||
|
||||
getModules :: [String] -> FilePath -> IO (Either String [([String],Module)])
|
||||
getModules uses file = do
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@ import Ast
|
|||
import Control.Arrow (first)
|
||||
import Control.Monad (liftM,(<=<),join,ap)
|
||||
import Data.Char (isAlpha,isDigit)
|
||||
import Data.List (intercalate,sortBy,inits)
|
||||
import Data.List (intercalate,sortBy,inits,foldl')
|
||||
import Data.Map (toList)
|
||||
import Data.Maybe (mapMaybe)
|
||||
import qualified Text.Pandoc as Pan
|
||||
|
|
@ -84,8 +84,8 @@ jsImport' (modul, Importing []) = jsImport' (modul, Hiding [])
|
|||
jsImport' (modul, Importing vs) =
|
||||
concatMap (\v -> assign v $ modul ++ "." ++ v) vs
|
||||
jsImport' (modul, Hiding vs) =
|
||||
concat [ "\nfor(var i in " ++ modul ++ "){"
|
||||
, assign "hiddenVars" . jsList $ map (\v -> "'" ++ v ++ "'") vs
|
||||
concat [ assign "hiddenVars" . jsList $ map (\v -> "'" ++ v ++ "'") vs
|
||||
, "\nfor(var i in " ++ modul ++ "){"
|
||||
, "\nif (hiddenVars.indexOf(i) >= 0) continue;"
|
||||
, globalAssign "this[i]" $ modul ++ "[i]"
|
||||
, "}" ]
|
||||
|
|
@ -142,10 +142,15 @@ toJS' expr =
|
|||
Let defs e -> jsLet defs e
|
||||
Case e cases -> caseToJS e cases
|
||||
Data name es -> (\ss -> jsList $ show name : ss) `liftM` mapM toJS' es
|
||||
Markdown doc ->
|
||||
return $ concat [ "text('<div style=\"height:0;width:0;\"> </div>"
|
||||
, filter (/='\n') $ Pan.writeHtmlString Pan.defaultWriterOptions doc
|
||||
, "<div style=\"height:0;width:0;\"> </div>')" ]
|
||||
Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"
|
||||
where md = formatMarkdown $ Pan.writeHtmlString Pan.defaultWriterOptions doc
|
||||
pad = "<div style=\"height:0;width:0;\"> </div>"
|
||||
|
||||
formatMarkdown = concatMap f
|
||||
where f '\'' = "\\'"
|
||||
f '\n' = ""
|
||||
f '"' = "\""
|
||||
f c = [c]
|
||||
|
||||
jsLet defs e' = do
|
||||
body <- (++) `liftM` jsDefs defs `ap` (ret `liftM` toJS' e')
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module GenerateHtml (generateHtml,
|
||||
body, css, widgetBody,
|
||||
modulesToHtml, linkedHtml
|
||||
modulesToHtml, linkedHtml,
|
||||
JSStyle (..)
|
||||
) where
|
||||
|
||||
import Data.List (intercalate)
|
||||
|
|
@ -11,6 +12,9 @@ import qualified Text.Blaze.Html5 as H
|
|||
import Text.Blaze.Html5 ((!))
|
||||
import qualified Text.Blaze.Html5.Attributes as A
|
||||
|
||||
import Text.Jasmine (minify)
|
||||
import qualified Data.ByteString.Lazy.Char8 as BS
|
||||
|
||||
import Ast
|
||||
import Initialize
|
||||
import CompileToJS
|
||||
|
|
@ -28,11 +32,15 @@ css = H.style ! A.type_ "text/css" $ preEscapedToMarkup
|
|||
\ -webkit-hyphens: auto; -ms-hyphens: auto; }\
|
||||
--}
|
||||
|
||||
makeScript :: Either String String -> H.Html
|
||||
makeScript (Left s) =
|
||||
data JSStyle = Minified | Readable
|
||||
|
||||
makeScript :: JSStyle -> Either String String -> H.Html
|
||||
makeScript _ (Left s) =
|
||||
H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""
|
||||
makeScript (Right s) =
|
||||
H.script ! A.type_ "text/javascript" $ preEscapedToMarkup s
|
||||
makeScript jsStyle (Right s) = H.script ! A.type_ "text/javascript" $ preEscapedToMarkup content
|
||||
where content = case jsStyle of
|
||||
Minified -> BS.unpack . minify . BS.pack $ s
|
||||
Readable -> s
|
||||
|
||||
-- |This function compiles Elm code into simple HTML.
|
||||
--
|
||||
|
|
@ -45,11 +53,11 @@ generateHtml :: String -- ^ Location of elm-min.js as expected by the browser
|
|||
-> Html
|
||||
generateHtml libLoc title source =
|
||||
case initialize source of
|
||||
Left err -> createHtml libLoc title (Right $ showErr err) (H.noscript "")
|
||||
Right (escs, modul) -> modulesToHtml title libLoc [] True [(escs,modul)]
|
||||
Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "")
|
||||
Right (escs, modul) -> modulesToHtml Readable title libLoc [] True [(escs,modul)]
|
||||
|
||||
|
||||
modulesToHtml title libLoc jss nscrpt pairs = createHtml libLoc title' js noscript
|
||||
modulesToHtml jsStyle title libLoc jss nscrpt pairs = createHtml jsStyle libLoc title' js noscript
|
||||
where modules = map snd pairs
|
||||
js = Right $ jss ++ concatMap jsModule pairs
|
||||
noscript = if nscrpt then extract $ last modules else ""
|
||||
|
|
@ -59,20 +67,21 @@ modulesToHtml title libLoc jss nscrpt pairs = createHtml libLoc title' js noscri
|
|||
|
||||
|
||||
linkedHtml rtLoc jsLoc modules =
|
||||
createHtml rtLoc title (Left jsLoc) (H.noscript "")
|
||||
createHtml Readable rtLoc title (Left jsLoc) (H.noscript "")
|
||||
where title = (\(Module names _ _ _) -> intercalate "." names) $
|
||||
snd (last modules)
|
||||
|
||||
|
||||
createHtml libLoc title js noscript =
|
||||
createHtml jsStyle libLoc title js noscript =
|
||||
H.docTypeHtml $ do
|
||||
H.head $ do
|
||||
H.meta ! A.charset "UTF-8"
|
||||
H.title . H.toHtml $ title
|
||||
makeScript (Left libLoc)
|
||||
makeScript js
|
||||
css
|
||||
H.body $ body noscript
|
||||
H.body $ do
|
||||
makeScript Readable (Left libLoc)
|
||||
makeScript jsStyle js
|
||||
body noscript
|
||||
|
||||
body noscript = do
|
||||
H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ textToText = [ "header", "italic", "bold", "underline"
|
|||
, "overline", "strikeThrough", "monospace" ]
|
||||
|
||||
textAttrs = [ "toText" -: string ==> text
|
||||
, "link" -: string ==> text ==> text
|
||||
--, "link" -: string ==> text ==> text
|
||||
, numScheme (\t -> t ==> text ==> text) "Text.height"
|
||||
] ++ hasType (text ==> text) textToText
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue