aed6d95 · elk · git.iko.soy

compiler/Generate/JavaScript.hs+2−2

compare with master

unifiedsplit

@@ -185,7 +185,7 @@ expression (L span expr) =

185 ctor = (prop "ctor", string (makeSafe name))

186 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]

187

188− Markdown doc -> return $ obj "Text.text" <| string (pad ++ md ++ pad)

188+ Markdown doc _ -> return $ obj "Text.text" <| string (pad ++ md ++ pad)

189 where pad = "<div style=\"height:0;width:0;\"> </div>"

190 md = Pan.writeHtmlString Pan.def doc

191

@@ -402,4 +402,4 @@ binop span op e1 e2 =

402 , specialOp "div" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)

403 ]

404

405− cmp op n a b = InfixExpr () op (obj "_N.cmp" `call` [a,b]) (IntLit () n)

405+ cmp op n a b = InfixExpr () op (obj "_N.cmp" `call` [a,b]) (IntLit () n)

compiler/Generate/Noscript.hs+1−1

@@ -49,7 +49,7 @@ instance Extract (Expr t v) where

49 Case e cases -> concatMap (f . snd) cases

50 Data _ es -> concatMap f es

51 MultiIf es -> concatMap (f . snd) es

52− Markdown doc -> [ Pan.writeHtmlString Pan.def doc ]

52+ Markdown doc _ -> [ Pan.writeHtmlString Pan.def doc ]

53 _ -> []

54

55extractLink src txt =

compiler/Parse/Expression.hs+23−9

@@ -1,5 +1,6 @@

1module Parse.Expression (def,term) where

2

3+import Control.Arrow ((***))

3import Control.Applicative ((<$>), (<*>))

4import Control.Applicative ((<$>), (<*>))

4import Data.List (foldl')

5import Data.List (foldl')

5import Text.Parsec hiding (newline,spaces)

6import Text.Parsec hiding (newline,spaces)

@@ -49,15 +50,28 @@ negative = do

49-------- Complex Terms --------

50-------- Complex Terms --------

50

51

51listTerm :: IParser (Expr t v)

52listTerm :: IParser (Expr t v)

52−listTerm =

53+listTerm = markdown <|> braces (range <|> ExplicitList <$> commaSep expr)

53− (do { try $ string "[markdown|"

54+ where

54− ; md <- filter (/='\r') <$> manyTill anyChar (try $ string "|]")

55+ range = try $ do lo <- expr

56+ whitespace >> string ".." >> whitespace

57+ Range lo <$> expr

58+

59+ markdown = try (string "[markdown|") >> closeMarkdown "" []

60+ where

61+ closeMarkdown md exprs =

62+ choice [ do try (string "|]")

63+ let toMD = Pan.readMarkdown Pan.def . filter (/='\r')

55− ; return . Markdown $ Pan.readMarkdown Pan.def md })

64+ return $ Markdown (toMD md) (reverse exprs)

56− <|> (braces $ choice

65+ , do try (string "{{")

57− [ try $ do { lo <- expr; whitespace; string ".." ; whitespace

66+ whitespace

58− ; Range lo <$> expr }

67+ e <- expr

59− , ExplicitList <$> commaSep expr

68+ whitespace

60− ])

69+ string "}}"

70+ let span = "<span id=\"md" ++ show (length exprs) ++ "\"></span>"

71+ closeMarkdown (md ++ span) (e:exprs)

72+ , do c <- anyChar

73+ closeMarkdown (md ++ [c]) exprs

74+ ]

61

75

62parensTerm :: IParser (LExpr t v)

76parensTerm :: IParser (LExpr t v)

63parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)

77parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)

compiler/SourceSyntax/Expression.hs+2−2

@@ -30,7 +30,7 @@ data Expr t v

30 | Insert (LExpr t v) String (LExpr t v)

31 | Modify (LExpr t v) [(String, LExpr t v)]

32 | Record [(String, LExpr t v)]

33− | Markdown Pandoc.Pandoc

33+ | Markdown Pandoc.Pandoc [LExpr t v]

34 deriving (Eq, Show, Data, Typeable)

35

36data Def tipe var

@@ -94,7 +94,7 @@ instance Pretty (Expr t v) where

94 where

95 field (x,e) = variable x <+> P.text "=" <+> pretty e

96

97− Markdown _ -> P.text "[markdown| ... |]"

97+ Markdown _ _ -> P.text "[markdown| ... |]"

98

99instance Pretty (Def t v) where

100 pretty def =

compiler/Transform/Canonicalize.hs+1−1

@@ -163,7 +163,7 @@ rename env lexpr@(L s expr) =

163 branch (pattern,e) = (,) `liftM` format (renamePattern env pattern)

164 `ap` rename (extend env pattern) e

165

166− Markdown _ -> return expr

166+ Markdown md es -> Markdown md `liftM` mapM rnm es

167

168

169renamePattern :: Env -> Pattern -> Either String Pattern

compiler/Transform/SortDefinitions.hs+1−1

@@ -97,7 +97,7 @@ reorder lexpr@(L s expr) =

97 Record fields ->

98 Record `liftM` mapM reorderField fields

99

100− Markdown _ -> return expr

100+ Markdown md es -> Markdown md <$> mapM reorder es

101

102 -- Actually do some reordering

103 Let defs body ->

compiler/Transform/Substitute.hs+1−1

@@ -27,4 +27,4 @@ subst old new expr =

27 Modify r fs -> Modify (f r) (map (second f) fs)

28 Record fs -> Record (map (second f) fs)

29 Literal _ -> expr

30− Markdown _ -> expr

30+ Markdown md es -> Markdown md (map f es)

compiler/Type/Constrain/Expression.hs+5−2

@@ -134,8 +134,11 @@ constrain env (L span expr) tipe =

134 recordType = record fields' (TermN EmptyRecord1)

135 return . ex vars . and $ tipe === recordType : cs

136

137− Markdown _ ->

137+ Markdown _ es ->

138+ do vars <- forM es $ \_ -> liftIO (var Flexible)

139+ let tvars = map VarN vars

140+ cs <- zipWithM (constrain env) es tvars

138− return ("Graphics.Element.markdown" <? tipe)

141+ return . ex vars $ and ("Graphics.Element.markdown" <? tipe : cs)

139

142

140 Let defs body ->

143 Let defs body ->

141 do c <- constrain env body tipe

144 do c <- constrain env body tipe