gdritter repos telml-markup / af37a3e
Added basic hspec tests and brought tags up-to-date Getty Ritter 8 years ago
4 changed file(s) with 96 addition(s) and 38 deletion(s). Collapse all Expand all
+37
-13
Data/TeLML/Markup.hs less more
11 {-# LANGUAGE LambdaCase #-}
2 {-# LANGUAGE OverloadedStrings #-}
23
34 module Data.TeLML.Markup where
45
67 import Data.TeLML
78 import Text.Blaze.Html
89 import Text.Blaze.Html5 hiding (map, head, html)
9 import Text.Blaze.Html5.Attributes hiding (name)
10 import Text.Blaze.Html5.Attributes hiding (name, span)
11
12 import Prelude hiding (div, span)
1013
1114 -- | Render a TeLML document with an extra set of possible tags.
1215 renderWith :: [(String, Renderer)] -> Document -> Either String Html
4649 -- The built-in set of tags (subject to change)
4750 basicTags :: [(String, Renderer)]
4851 basicTags =
49 [ ("em"
50 , \case (f,[rs]) -> fmap (em . sequence_) (mapM f rs)
51 _ -> Left "wrong arity for em/1"
52 )
53 , ("strong"
54 , \case (f,[rs]) -> fmap (strong . sequence_) (mapM f rs)
55 _ -> Left "wrong arity for strong/1"
56 )
57 , ("code"
58 , \case (f,[rs]) -> fmap (code . sequence_) (mapM f rs)
59 _ -> Left "wrong arity for code/1"
60 )
52 [ simpleTag "em" em
53 , simpleTag "strong" strong
54 , simpleTag "li" li
55 , simpleTag "h1" h1
56 , simpleTag "h2" h2
57 , simpleTag "p" (\ rs -> span ! class_ "para" $ rs)
58 , simpleTag "blockquote" blockquote
59 , simpleTag "tt" code
60 , simpleTag "code" (pre . code)
61 , simpleTag "ttcom" (\ rs -> span ! class_ "comment" $ rs)
62 , simpleTag "ttkw" (\ rs -> span ! class_ "keyword" $ rs)
63 , simpleTag "ttcn" (\ rs -> span ! class_ "constr" $ rs)
64 , simpleTag "ttstr" (\ rs -> span ! class_ "string" $ rs)
65 , listTag "ul" ul
66 , listTag "ol" ol
67 , listTag "center" (\ rs -> div ! class_ "center" $ rs)
68 , ("br", \_ -> return br)
69 , ("comment", \_ -> return "")
6170 , ("link"
6271 , \case (f,[[Text l],r]) -> let go h = a ! href (stringValue l) $ h
6372 in fmap (go . sequence_) (mapM f r)
6473 (_,[_,_]) -> Left "link target should be string"
6574 _ -> Left "wrong arity for link/1"
6675 )
76 , ("img"
77 , \case (_, [[Text l]]) -> return (img ! src (stringValue l))
78 (_,[_]) -> Left "image target should be string"
79 _ -> Left "wrong arity for img/1"
80 )
6781 ]
82 where simpleTag :: String -> (Html -> Html) -> (String, Renderer)
83 simpleTag name tag =
84 ( name
85 , \case (f,[rs]) -> fmap (tag . sequence_) (mapM f rs)
86 _ -> Left ("wrong arity for " ++ name ++ "/1")
87 )
88 listTag name tag =
89 ( name
90 , \case (f,rs) -> fmap (tag . sequence_) (mapM f (concat rs))
91 )
6892
6993 -- render a single paragraph
7094 renderPara :: [(String, Renderer)] -> Document -> Either String Html
+31
-25
telml-markup.cabal less more
1 Name: telml-markup
2 Version: 0.0.0
3 Author: Getty Ritter <gettylefou@gmail.com>
4 Maintainer: Getty Ritter <gettylefou@gmail.com>
5 License: BSD3
6 License-File: LICENSE
1 name: telml-markup
2 version: 0.1.0.0
3 author: Getty Ritter <gettylefou@gmail.com>
4 maintainer: Getty Ritter <gettylefou@gmail.com>
5 license: BSD3
6 license-file: LICENSE
77 -- Synopsis:
88 -- Description:
9 Cabal-Version: >= 1.10
10 Build-Type: Simple
11 Extra-Source-Files: README.md, ChangeLog.md
9 cabal-version: >= 1.10
10 build-type: Simple
11 extra-source-files: README.md, ChangeLog.md
1212
13 Library
14 Default-Language: Haskell2010
15 GHC-Options: -Wall
16 Exposed-Modules: Data.TeLML.Markup
17 Build-Depends: base >= 4 && < 5, telml, blaze-markup, blaze-html, mtl
13 library
14 default-language: Haskell2010
15 ghc-options: -Wall
16 exposed-modules: Data.TeLML.Markup
17 build-depends: base >= 4 && < 5,
18 telml,
19 blaze-markup,
20 blaze-html,
21 mtl
1822
19 -- Test-Suite spec
20 -- Type: exitcode-stdio-1.0
21 -- Default-Language: Haskell2010
22 -- Hs-Source-Dirs: test
23 -- Ghc-Options: -Wall
24 -- Main-Is: Spec.hs
25 -- Build-Depends: base
26 -- , hspec
23 test-suite spec
24 type: exitcode-stdio-1.0
25 ghc-options: -Wall
26 hs-source-dirs: test
27 main-is: Spec.hs
28 build-depends: base == 4.*
29 , telml
30 , telml-markup
31 , hspec == 2.*
32 , blaze-markup
2733
28 Source-Repository head
29 Type: git
30 -- Location:
34 source-repository head
35 type: git
36 location: https://github.com/aisamanra/telml-markup
+1
-0
test/Spec.hs less more
1 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+27
-0
test/Telml/MarkupSpec.hs less more
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Telml.MarkupSpec (main, spec) where
4
5 import Control.Monad ((>=>))
6 import Data.TeLML
7 import Data.TeLML.Markup
8 import Text.Blaze.Renderer.String (renderMarkup)
9
10 import Test.Hspec
11
12 main :: IO ()
13 main = hspec spec
14
15 doRender :: String -> Either String String
16 doRender = parse >=> render >=> return . renderMarkup
17
18 spec :: Spec
19 spec = do
20 describe "render" $ do
21 it "should emphasize" $ do
22 doRender "\\em{foo}" `shouldBe` Right "<p><em>foo</em></p>"
23 it "should embolden" $ do
24 doRender "\\strong{foo}" `shouldBe` Right "<p><strong>foo</strong></p>"
25 it "should lis" $ do
26 doRender "\\ul{\\li{one}\\li{two}}" `shouldBe`
27 Right "<p><ul><li>one</li><li>two</li></ul></p>"