First commit
This commit is contained in:
81
app/Main.hs
Normal file
81
app/Main.hs
Normal file
@@ -0,0 +1,81 @@
|
||||
module Main where
|
||||
|
||||
import Text.ParserCombinators.ReadP
|
||||
import Control.Monad
|
||||
import Control.Applicative
|
||||
|
||||
type HeaderLevel = Int
|
||||
|
||||
newtype URL = URL {getUrl :: String}
|
||||
newtype ImgPath = ImgPath {getPath :: String}
|
||||
|
||||
data MdToken = Header HeaderLevel MdToken
|
||||
| Para [MdToken]
|
||||
| Linebreak
|
||||
| HorizontalRule
|
||||
| Blockquote MdToken
|
||||
| UnordList [MdToken]
|
||||
| OrdList [MdToken]
|
||||
| Code String
|
||||
| Codeblock String
|
||||
| Link [MdToken] URL
|
||||
| Image [MdToken] ImgPath
|
||||
| Bold [MdToken]
|
||||
| Italic [MdToken]
|
||||
| Strikethrough [MdToken]
|
||||
| Unit String
|
||||
|
||||
-- Deriving Show for MdToken
|
||||
instance Show MdToken where
|
||||
show (Header level token) = "<h" ++ show level ++ ">" ++ show token ++ "</h" ++ show level ++ ">"
|
||||
show (Para tokens) = concat(map show tokens)
|
||||
show Linebreak = "\n"
|
||||
show HorizontalRule = "---------"
|
||||
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
|
||||
|
||||
|
||||
|
||||
-- ---------------
|
||||
-- Helpers
|
||||
mustBeHash :: ReadP Char
|
||||
mustBeHash = satisfy (\x -> x == '#')
|
||||
|
||||
|
||||
|
||||
|
||||
-- ---------------
|
||||
|
||||
parseHeader :: ReadP MdToken
|
||||
parseHeader = do
|
||||
headers <- many1 mustBeHash
|
||||
when ((length headers) > 6)
|
||||
pfail
|
||||
_ <- string " "
|
||||
text <- munch1 (const True) -- Parse until EOL
|
||||
return (Header (length headers) text)
|
||||
|
||||
parseBold :: ReadP MdToken
|
||||
parseBold = do
|
||||
_ <- string "__" <|> string "**"
|
||||
text <- munch1 (\x -> x /= '_' && x /= '*') -- Parse until first asterisk/underscore
|
||||
_ <- char '_' <|> char '*' -- Throw away the second asterisk/underscore
|
||||
return (Bold text)
|
||||
|
||||
|
||||
parseMain :: String -> []MdToken
|
||||
|
||||
parseMain
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = putStrLn "Hello, Haskell!"
|
Reference in New Issue
Block a user