Added Markup module with basic understanding of markup
Getty Ritter
7 years ago
| 14 | 14 |
executable inf-dict
|
| 15 | 15 |
hs-source-dirs: src
|
| 16 | 16 |
main-is: Main.hs
|
| 17 | |
other-modules: Types, Render |
| 17 |
other-modules: Types, Render, Markup
|
| 18 | 18 |
default-extensions: OverloadedStrings,
|
| 19 | 19 |
ScopedTypeVariables
|
| 20 | 20 |
ghc-options: -Wall
|
|
| 27 | 27 |
aeson,
|
| 28 | 28 |
transformers,
|
| 29 | 29 |
http-types,
|
| 30 | |
wai-middleware-static |
| 30 |
wai-middleware-static,
|
| 31 |
megaparsec
|
| 31 | 32 |
default-language: Haskell2010
|
| 1 |
module Markup where
|
| 2 |
|
| 3 |
import Data.Text (Text)
|
| 4 |
import qualified Data.Text as T
|
| 5 |
import Lucid
|
| 6 |
import Text.Megaparsec
|
| 7 |
import Text.Megaparsec.Text
|
| 8 |
|
| 9 |
data Chunk
|
| 10 |
= Bold Text
|
| 11 |
| Italic Text
|
| 12 |
| Code Text
|
| 13 |
| Strike Text
|
| 14 |
| Chunk Text
|
| 15 |
deriving (Eq, Show)
|
| 16 |
|
| 17 |
-- | Understands a very limited form of markup, and does not understand
|
| 18 |
-- nested markup yet.
|
| 19 |
markup :: Text -> Html ()
|
| 20 |
markup = div_ . sequence_ . map (build . format) . T.lines
|
| 21 |
|
| 22 |
format :: Text -> [Chunk]
|
| 23 |
format t = case runParser parseF "[]" t of
|
| 24 |
Left _ -> [Chunk t]
|
| 25 |
Right cs -> cs
|
| 26 |
|
| 27 |
parseF :: Parser [Chunk]
|
| 28 |
parseF = many go
|
| 29 |
where go = Bold <$> delim '*'
|
| 30 |
<|> Italic <$> delim '_'
|
| 31 |
<|> Code <$> delim '`'
|
| 32 |
<|> Strike <$> delim '~'
|
| 33 |
<|> (Chunk . T.pack) <$> pChunk
|
| 34 |
delim :: Char -> Parser Text
|
| 35 |
delim c = T.pack <$> (char c *> manyTill anyChar (try (char c >> space)))
|
| 36 |
pChunk = some (noneOf ("*_`~" :: String))
|
| 37 |
|
| 38 |
build :: [Chunk] -> Html ()
|
| 39 |
build = mapM_ go
|
| 40 |
where go (Chunk t) = toHtml t
|
| 41 |
go (Bold t) = strong_ $ toHtml t
|
| 42 |
go (Italic t) = em_ $ toHtml t
|
| 43 |
go (Strike t) = span_ [ class_ "strike" ] $ toHtml t
|
| 44 |
go (Code t) = pre_ $ toHtml t
|
| 5 | 5 |
import Data.Text.Lazy (toStrict)
|
| 6 | 6 |
import Lucid
|
| 7 | 7 |
|
| 8 |
import Markup
|
| 8 | 9 |
import Types
|
| 9 | 10 |
|
| 10 | 11 |
rPage :: Html () -> Text
|
|
| 42 | 43 |
rEntry e = div_ [ class_ "entry" ] $ do
|
| 43 | 44 |
div_ [ class_ "word" ] $ toHtml (eWord e)
|
| 44 | 45 |
div_ [ class_ "translit" ] $ toHtml (eTranslit e)
|
| 45 | |
div_ [ class_ "meaning" ] $ toHtml (eMeaning e)
|
| 46 |
div_ [ class_ "meaning" ] $ markup (eMeaning e)
|
| 46 | 47 |
when (eNotes e /= "") $
|
| 47 | |
div_ [ class_ "notes" ] $ toHtml (eNotes e)
|
| 48 |
div_ [ class_ "notes" ] $ markup (eNotes e)
|
| 48 | 49 |
ul_ [ class_ "links" ] $ do
|
| 49 | 50 |
li_ $ a_ [ href_ (pack ("/word/" ++ show (eID e) ++ "/edit")) ] "edit"
|
| 50 | 51 |
li_ $ a_ [ href_ (pack ("/word/" ++ show (eID e))) ] "link"
|