I wrote a parser for a small part of the mermaid diagram language. This came up while working in a project that uses mermaid to flesh out a design for some process. Since the devs would already write down mermaid specifications for visualising the diagram of these processes, I figured it would be useful if I could leverage the existing specification programatically, in Haskell.
In general, mermaid is a widely used diagram specification language with pretty good rendering tools, and I think being able to further use these specifications from Haskell can be powerful…!
More specifically, I implemented the parser for the entity-relationship diagram subset of mermaid, as it was the only I needed for my project.
Even though I started the ball rolling with the ER parser, I don’t intend to pursue a complete implementation of mermaid parsing in Haskell. However, this is where anyone interested in another part of mermaid is more than welcome to come in and contribute. This is a great newcomer friendly project, and I’d be happy to advise you here.
I haven’t uploaded to hackage, but I could (as v0.1) if anyone thinks that would be useful. LMK.
While experimenting with these tools I thought of a something like Pandoc but for ER diagrams. This could save people who wanted to try different tools some time, and also could be helpful if one wanted to switch to another tool. The internal representation of the data could also be a useful data structure by itself, and could be used to output DDL statements in different SQL dialects.
Ok, I took your code and was able to quickly modify it to parse that kind of graph. It’s very specific, but maybe it can be generalized to support other kinds of mermaid graphs. It’s not the most elegant but I’ll leave it here in case anyone finds it useful:
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module MermaidDiagram
( parseDiagram
, Diagram(..)
) where
import Control.Monad.Except
import Data.Functor.Identity
import Data.Text (Text)
import qualified Data.Text as T
import Data.Void
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
parseDiagram :: MonadError String m => Text -> m Diagram
parseDiagram txt = case parse (spaces *> pDiagram) "<input>" txt of
Left e -> throwError (errorBundlePretty e)
Right x -> pure x
data Diagram = Diagram
{ diagramName :: Text
, diagramTransitions :: [(Int, Int, Int)]
}
deriving (Show, Eq)
type Parser = ParsecT Void Text Identity
pDiagram :: Parser Diagram
pDiagram = do
string "graph" <* spaces
name <- T.pack <$> manyTill alphaNumChar (char ';')
newline
transitions <- many pTransition
pure $ Diagram name transitions
pTransition :: Parser (Int, Int, Int)
pTransition = do
spaces
stateFrom <- many digitChar
string "-->|"
edge <- many digitChar
char '|'
stateTo <- many digitChar
char ';'
newline
return (read stateFrom, read edge, read stateTo)
-- space consumer
spaces :: Parser ()
spaces = L.space space1 empty empty