|
|
|
@ -3,12 +3,17 @@ module Main where
|
|
|
|
|
import Text.ParserCombinators.ReadP
|
|
|
|
|
import Control.Monad
|
|
|
|
|
import Control.Applicative
|
|
|
|
|
import Text.Printf
|
|
|
|
|
import Debug.Trace
|
|
|
|
|
|
|
|
|
|
type HeaderLevel = Int
|
|
|
|
|
|
|
|
|
|
newtype URL = URL {getUrl :: String}
|
|
|
|
|
newtype ImgPath = ImgPath {getPath :: String}
|
|
|
|
|
|
|
|
|
|
parseMany :: ReadP a -> ReadP [a]
|
|
|
|
|
parseMany = Text.ParserCombinators.ReadP.many
|
|
|
|
|
|
|
|
|
|
data MdToken = Header HeaderLevel MdToken
|
|
|
|
|
| Para [MdToken]
|
|
|
|
|
| Linebreak
|
|
|
|
@ -18,11 +23,11 @@ data MdToken = Header HeaderLevel MdToken
|
|
|
|
|
| OrdList [MdToken]
|
|
|
|
|
| Code String
|
|
|
|
|
| Codeblock String
|
|
|
|
|
| Link [MdToken] URL
|
|
|
|
|
| Image [MdToken] ImgPath
|
|
|
|
|
| Bold [MdToken]
|
|
|
|
|
| Italic [MdToken]
|
|
|
|
|
| Strikethrough [MdToken]
|
|
|
|
|
| Link MdToken URL
|
|
|
|
|
| Image MdToken ImgPath
|
|
|
|
|
| Bold MdToken
|
|
|
|
|
| Italic MdToken
|
|
|
|
|
| Strikethrough MdToken
|
|
|
|
|
| Unit String
|
|
|
|
|
|
|
|
|
|
-- Deriving Show for MdToken
|
|
|
|
@ -34,14 +39,14 @@ instance Show MdToken where
|
|
|
|
|
show (Blockquote token) = "BLOCK" ++ show token
|
|
|
|
|
show (UnordList tokens) = "UNORD" ++ concat(map show tokens)
|
|
|
|
|
show (OrdList tokens) = "ORD" ++ concat(map show tokens)
|
|
|
|
|
show (Code code) = concat(map show code)
|
|
|
|
|
show (Codeblock code) = concat(map show code)
|
|
|
|
|
show (Link txt url) = "<a href=" ++ (getUrl url) ++ ">" ++ concat(map show txt) ++ "</a>"
|
|
|
|
|
show (Image txt path) = "<img src=" ++ (getPath path) ++ ">" ++ concat(map show txt) ++ "</img>"
|
|
|
|
|
show (Bold tokens) = "<b>" ++ concat(map show tokens) ++ "</b>"
|
|
|
|
|
show (Italic tokens) = "<i>" ++ concat(map show tokens) ++ "</i>"
|
|
|
|
|
show (Strikethrough tokens) = "<s>" ++ concat (map show tokens) ++ "</s>"
|
|
|
|
|
show (Unit unit) = show unit
|
|
|
|
|
show (Code code) = show code
|
|
|
|
|
show (Codeblock code) = show code
|
|
|
|
|
show (Link txt url) = "<a href=" ++ (getUrl url) ++ ">" ++ show txt ++ "</a>"
|
|
|
|
|
show (Image txt path) = "<img src=" ++ (getPath path) ++ ">" ++ show txt ++ "</img>"
|
|
|
|
|
show (Bold token) = "<b>" ++ show token ++ "</b>"
|
|
|
|
|
show (Italic token) = "<i>" ++ show token ++ "</i>"
|
|
|
|
|
show (Strikethrough token) = "<s>" ++ show token ++ "</s>"
|
|
|
|
|
show (Unit unit) = printf "%s" unit
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -61,21 +66,38 @@ parseHeader = do
|
|
|
|
|
when ((length headers) > 6)
|
|
|
|
|
pfail
|
|
|
|
|
_ <- string " "
|
|
|
|
|
text <- munch1 (const True) -- Parse until EOL
|
|
|
|
|
return (Header (length headers) text)
|
|
|
|
|
text <- munch1 (\x -> x /= '\n') -- Parse until EOL
|
|
|
|
|
-- traceM text
|
|
|
|
|
let allParsedText = readP_to_S parsePara text
|
|
|
|
|
let parsedText = fst . last $ allParsedText
|
|
|
|
|
return (Header (length headers) parsedText)
|
|
|
|
|
|
|
|
|
|
parseBold :: ReadP MdToken
|
|
|
|
|
parseBold = do
|
|
|
|
|
_ <- string "__" <|> string "**"
|
|
|
|
|
text <- munch1 (\x -> x /= '_' && x /= '*') -- Parse until first asterisk/underscore
|
|
|
|
|
-- traceM text
|
|
|
|
|
_ <- char '_' <|> char '*' -- Throw away the second asterisk/underscore
|
|
|
|
|
return (Bold text)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
parseMain :: String -> []MdToken
|
|
|
|
|
|
|
|
|
|
parseMain
|
|
|
|
|
let parsedText = fst . last $ readP_to_S parsePara text
|
|
|
|
|
return (Bold parsedText)
|
|
|
|
|
|
|
|
|
|
parseString :: ReadP MdToken
|
|
|
|
|
parseString = do
|
|
|
|
|
text <- munch1 (\x -> not (elem x "#*_["))
|
|
|
|
|
-- traceM text
|
|
|
|
|
return (Unit text)
|
|
|
|
|
|
|
|
|
|
parseLine :: ReadP MdToken
|
|
|
|
|
parseLine = choice [parseHeader,parseBold,parseString]
|
|
|
|
|
|
|
|
|
|
parsePara :: ReadP MdToken
|
|
|
|
|
parsePara = do
|
|
|
|
|
parsed <- parseMany parseLine
|
|
|
|
|
-- traceM $ show parsed
|
|
|
|
|
return (Para parsed)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
|
main = putStrLn "Hello, Haskell!"
|
|
|
|
|
main = do
|
|
|
|
|
let res = readP_to_S parsePara "## Hello **world**"
|
|
|
|
|
putStrLn (show res)
|
|
|
|
|