gdritter repos telml / e1f938e
Update docs accordingly Getty Ritter 6 years ago
2 changed file(s) with 128 addition(s) and 41 deletion(s). Collapse all Expand all
+29
-16
telml-markup/Data/TeLML/Markup.hs less more
44 {-# LANGUAGE FlexibleInstances #-}
55 {-# LANGUAGE TypeFamilies #-}
66
7 module Data.TeLML.Markup where
7 module Data.TeLML.Markup
8 ( renderWith
9 , render
10 , basicTags
11 , mkTag
12 , simpleTag
13 , listTag
14 , H(..)
15 , Hs(..)
16 , Str(..)
17 , TagDescription
18 ) where
819
920 import Control.Monad (void)
1021 import Data.TeLML
5869 taExec _ _ _ = Nothing
5970
6071 instance TagArguments r => TagArguments (Str -> r) where
61 toType _ = "_" : toType (undefined :: r)
72 toType _ = "str" : toType (undefined :: r)
6273 taExec f ([TextFrag t]:rs) go = taExec (f (Str t)) rs go
6374 taExec _ _ _ = Nothing
6475
6576 instance TagArguments r => TagArguments (Maybe Str -> r) where
66 toType _ = "_" : toType (undefined :: r)
77 toType _ = "str?" : toType (undefined :: r)
6778 taExec f ([TextFrag t]:rs) go = taExec (f (Just (Str t))) rs go
6879 taExec f [] go = taExec (f Nothing) [] go
6980 taExec _ _ _ = Nothing
7081
7182 instance TagArguments r => TagArguments (H -> r) where
72 toType _ = "_" : toType (undefined :: r)
83 toType _ = "frag" : toType (undefined :: r)
7384 taExec f (doc:rs) go =
7485 let h = fmap sequence_ (mapM go doc)
7586 in case h of
8091 instance (h ~ Html) => TagArguments (Hs -> h) where
8192 toType _ = ["..."]
8293 taExec f docs go =
83 let h = fmap sequence_ (mapM go (concat docs))
94 let h = mapM (fmap sequence_ . mapM go) docs
8495 in case h of
8596 Left err -> return (Left err)
86 Right h' -> return (Right (f (Hs h')))
97 Right hs -> return (Right (f (Hs hs)))
8798
88 data TagDescription = forall t. TagArguments t => TagDescription
89 { tgName :: T.Text
90 , tgFunc :: t
91 }
99 data TagDescription
100 = forall t. TagArguments t =>
101 TagDescription T.Text t
92102
93103 -- | The 'Str' newtype will match a literal chunk of non-formatted,
94104 -- non-structured text.
99109
100110 -- | The 'Hs' newtype will match a concatenated set of pre-rendered
101111 -- arguments
102 newtype Hs = Hs { fromHtmlList :: Html }
112 newtype Hs = Hs { fromHtmlList :: [Html] }
103113
104114 mkTag :: TagArguments t => T.Text -> t -> TagDescription
105115 mkTag = TagDescription
123133
124134 , listTag "ul" ul
125135 , listTag "ol" ol
136 , mkTag "list" (\ (Hs hs) -> ul $ mapM_ li hs)
126137 , listTag "center" (\ rs -> div ! class_ "center" $ rs)
127138
128139 , TagDescription "br" br
129140 , TagDescription "comment" ("" :: Html)
130141 , TagDescription "link" (\ (Str l) (H h) -> a ! href (toValue l) $ h)
131142 , TagDescription "img" $ \ (Str l) altText -> case altText of
132 Just (Str r) -> img ! src (toValue l) ! alt (toValue r)
133 Nothing -> img ! src (toValue l)
143 Just r -> img ! src (toValue l) ! alt (toValue (fromStr r))
144 Nothing -> img ! src (toValue l)
134145 ]
135146
136147 simpleTag :: T.Text -> (Markup -> Html) -> TagDescription
137148 simpleTag name tag = mkTag name (tag . fromHtml)
138149
139150 listTag :: T.Text -> (Markup -> Html) -> TagDescription
140 listTag name tag = mkTag name (\ (Hs hs) -> tag hs)
151 listTag name tag = mkTag name (tag . mconcat . fromHtmlList)
152
153 argsFor :: TagArguments t => t -> T.Text
154 argsFor func = T.cons '{' (T.snoc (T.intercalate "|" (toType func)) '}')
141155
142156 -- render a single paragraph
143157 renderPara :: [TagDescription] -> Document -> Either String Html
150164 [ "Tag"
151165 , T.unpack ('\\' `T.cons` name)
152166 , "expects argument structure"
153 , T.unpack ('\\' `T.cons` name `T.append`
154 T.intercalate "|" (toType func))
167 , T.unpack ('\\' `T.cons` name `T.append` argsFor func)
155168 ]
156169 Just x -> x
157170 exec name args (_:rs) = exec name args rs
+99
-25
telml-markup/README.md less more
8686 ## Extended Usage
8787
8888 The `renderWith` function takes a list of additional tags and their
89 denotations (in the form of functions from `telml` fragments to
90 `blaze-html` fragments.) This allows you to add new tags to the
91 markup for particular purposes.
92
93 For example, here we add a tag so that `\hello{...}` will render out to
89 denotations. This allows you to add new tags to the markup for
90 particular purposes.
91
92 In order to define the meaning of a new tag, you can use the `mkTag`
93 function, which takes the tag name as well as something which defines
94 the meaning: usually a function of the arguments you want with certain
95 redundant wrappers around the argument in order to guide the
96 type-checker that in turn returns an `Html` fragment using the
97 `blaze-html` library. For example, an argument-less tag like `br` can
98 be defined as simply `mkTag "br" Text.Blaze.Html5.br`.
99
100 For tags that take arguments, we can take advantage of the
101 `TagArguments` type class in order to avoid fiddly argument-handling
102 and manual errors. The `TagArguments` class will allow you to provide
103 a function so long as all the arguments to the function are types that
104 it knows about---mostly wrapper types defined by `telml-markup`. For
105 example, the `H` type simply wraps already-rendered HTML, so if we
106 want to write a tag like `em` that takes a single argument, we can
107 write it like this:
108
109 ```
110 import Data.TeLML.Markup
111 import Text.Blaze.Html5 (em)
112
113 -- \em{some argument}
114 emTag :: TagDescription
115 emTag = mkTag "em" (\ (H html) -> em html)
116 ```
117
118 The `Hs` wrapper type wraps a variadic function, and can only be used
119 as the final trailing argument, as it will match any number of
120 arguments in a tag, rendering them all as HTML. We can define a list
121 tag like this:
122
123 ```
124 import Data.TeLML.Markup
125 import Text.Blaze.Html5 (ul, li)
126
127 -- \list{one|two|three}
128 emTag :: TagDescription
129 emTag = mkTag "list" (\ (Hs hs) -> ul (mapM_ li hs))
130 ```
131
132 Sometimes we want a tag that has a concrete string value: for example,
133 if we want a tag that allows us to write HTML `span` tags to add
134 classes to elements, we would want the classes to be just strings and
135 not already-rendered HTML strings. We can use the `Str` wrapper to
136 make sure that an argument is treated as a raw string:
137
138 ```
139 import Data.TeLML.Markup
140 import Text.Blaze.Html5 (span, class_, toValue)
141
142 -- \span{arg|class}
143 spanTag :: TagDescription
144 spanTag = mkTag "span" $ \ (H arg) (Str cls) ->
145 span ! class (toValue cls) $ arg
146 ```
147
148 These tags have been straightforward, but arbitrary new tags with
149 different argument structures can be added, and the underlying
150 machinery will ensure that errors will be reported appropriately. The
151 tags can also produce arbitrarily complicated structures: they do,
152 after all, have the entirety of Haskell available to them! For
153 example, here we add a tag so that `\hello{...}` will render out to
94154 the HTML string `<strong>Hello, ...!</strong>`:
95155
96156 ~~~~{.haskell}
157 {-# LANGUAGE OverloadedStrings #-}
97158 module Main where
98159
99 import Control.Monad ((>=>))
100 import Data.TeLML (parse)
101 import Data.TeLML.Markup (Renderer, renderWith)
102 import System.Exit (exitFailure)
103 import Text.Blaze.Html5 (strong, toMarkup)
104 import Text.Blaze.Renderer.String (renderMarkup)
105
106 myTags :: [(String, Renderer)]
160 import Control.Monad ((>=>))
161 import qualified Data.TeLML as TeLML
162 import qualified Data.TeLML.Markup as TeLML
163 import qualified System.Exit as Sys
164 import qualified Text.Blaze.Html5 as Html
165 import qualified Text.Blaze.Renderer.String as Html
166
167 myTags :: [TeLML.TagDescription]
107168 myTags =
108 [ ("hello", \ c -> case c of
109 (render, [name]) -> do
110 rName <- mapM render name
111 return $ strong $ do
112 toMarkup "Hello, "
113 sequence_ rName
114 toMarkup "!"
115 (_, args) -> Left ("Did not match hello/" ++ show (length args))
116 )
169 [ TeLML.mkTag "hello" $ \(TeLML.H name) ->
170 Html.strong ("Hello, " >> name >> "!")
117171 ]
118172
119173 main :: IO ()
120174 main = do
121175 str <- getContents
122 case (parse >=> renderWith myTags) str of
123 Left err -> putStrLn err >> exitFailure
124 Right doc -> putStrLn (renderMarkup doc)
176 case (TeLML.parse >=> TeLML.renderWith myTags) str of
177 Left err -> putStrLn err >> Sys.exitFailure
178 Right doc -> putStrLn (Html.renderMarkup doc)
125179 ~~~~
126180
127181 We can execute this to test it:
133187 <p>Now we can do this: <strong>Hello, friend!</strong>.
134188 </p>
135189 ~~~~
190
191 Providing the wrong argument list will give us an arity error:
192
193 ~~~~
194 $ ./telml-markup-extended-test <<EOF
195 > This does not use hello correctly: \hello{this|that}.
196 > EOF
197 Tag \hello expects argument structure \hello{frag}
198 ~~~~
199
200 Additionally, for tags that specifically want strings intead of richer
201 structures, we will get type errors:
202
203 ~~~~
204 $ ./telml-markup-extended-test <<EOF
205 > This tries to use emphasis in the link portion:
206 > \link{\em{url}|\em{text}}.
207 > EOF
208 Tag \link expects argument structure \link{str|frag}
209 ~~~~