ogma-core 1.11.0 → 1.12.0
raw patch · 3 files changed
+109/−19 lines, 3 filesdep ~ogma-extradep ~ogma-language-cdep ~ogma-language-copilotPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ogma-extra, ogma-language-c, ogma-language-copilot, ogma-language-csv, ogma-language-jsonspec, ogma-language-lustre, ogma-language-smv, ogma-language-xlsx, ogma-language-xmlspec, ogma-spec
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- ogma-core.cabal +11/−11
- src/Command/Diagram.hs +92/−8
CHANGELOG.md view
@@ -1,5 +1,11 @@ # Revision history for ogma-core +## [1.12.0] - 2026-01-21++* Version bump 1.12.0 (#336).+* Add support for state machine mermaid diagrams (#328).+* Add support for sequence diagrams in Mermaid (#330).+ ## [1.11.0] - 2025-11-21 * Version bump 1.11.0 (#325).
ogma-core.cabal view
@@ -19,7 +19,7 @@ build-type: Simple name: ogma-core-version: 1.11.0+version: 1.12.0 homepage: https://github.com/nasa/ogma bug-reports: https://github.com/nasa/ogma/issues license: Apache-2.0@@ -139,16 +139,16 @@ , process >= 1.6 && < 1.7 , text >= 1.2.3.1 && < 2.2 - , ogma-extra >= 1.11.0 && < 1.12- , ogma-language-c >= 1.11.0 && < 1.12- , ogma-language-copilot >= 1.11.0 && < 1.12- , ogma-language-csv >= 1.11.0 && < 1.12- , ogma-language-jsonspec >= 1.11.0 && < 1.12- , ogma-language-lustre >= 1.11.0 && < 1.12- , ogma-language-smv >= 1.11.0 && < 1.12- , ogma-language-xlsx >= 1.11.0 && < 1.12- , ogma-language-xmlspec >= 1.11.0 && < 1.12- , ogma-spec >= 1.11.0 && < 1.12+ , ogma-extra >= 1.12.0 && < 1.13+ , ogma-language-c >= 1.12.0 && < 1.13+ , ogma-language-copilot >= 1.12.0 && < 1.13+ , ogma-language-csv >= 1.12.0 && < 1.13+ , ogma-language-jsonspec >= 1.12.0 && < 1.13+ , ogma-language-lustre >= 1.12.0 && < 1.13+ , ogma-language-smv >= 1.12.0 && < 1.13+ , ogma-language-xlsx >= 1.12.0 && < 1.13+ , ogma-language-xmlspec >= 1.12.0 && < 1.13+ , ogma-spec >= 1.12.0 && < 1.13 hs-source-dirs: src
src/Command/Diagram.hs view
@@ -31,7 +31,7 @@ -- External imports import Control.Exception as E-import Control.Monad (when)+import Control.Monad (when, void) import Data.Aeson (object, (.=)) import Data.ByteString.Lazy (toStrict) import qualified Data.ByteString.Lazy as B@@ -55,10 +55,11 @@ import Data.Void (Void) import System.FilePath ((</>)) import Text.Megaparsec (ErrorFancy (ErrorFail),- ParsecT, empty,+ ParsecT, choice, empty, errorBundlePretty, fancyFailure, many,- manyTill, noneOf, parse)+ manyTill, noneOf, parse,+ (<|>)) import Text.Megaparsec.Char (alphaNumChar, char, digitChar, newline, space1, string)@@ -333,17 +334,24 @@ -- | Type for parser for memaid diagrams. type MermaidParser = ParsecT Void Text Identity +-- | Parser for mermaid diagrams.+pDiagram :: ExprPair -> MermaidParser Diagram+pDiagram exprP =+ pGraphDiagram exprP+ <|> pStateDiagram exprP+ <|> pSequenceDiagram exprP+ -- | Parser for a mermaid diagram. -- -- This parser depends on an auxiliary parser for the expressions associated to -- the edges or connections between states.-pDiagram :: ExprPair -> MermaidParser Diagram-pDiagram exprP = do+pGraphDiagram :: ExprPair -> MermaidParser Diagram+pGraphDiagram exprP = do _ <- string "graph" <* spaces _name <- T.pack <$> manyTill alphaNumChar (char ';') _ <- newline - transitions <- many (pTransition exprP)+ transitions <- many (pGraphTransition exprP) pure $ Diagram transitions @@ -351,8 +359,8 @@ -- -- This parser depends on an auxiliary parser for the expressions associated to -- the edges or connections between states.-pTransition :: ExprPair -> MermaidParser (Int, String, Int)-pTransition ep@(ExprPair { _exprParse = parseProp }) = do+pGraphTransition :: ExprPair -> MermaidParser (Int, String, Int)+pGraphTransition ep@(ExprPair { _exprParse = parseProp }) = do _ <- spaces stateFrom <- many digitChar _ <- string "-->|"@@ -367,6 +375,82 @@ _ <- char ';' _ <- newline return (read stateFrom, exprPairShow ep edge, read stateTo)++-- | Parser for Mermaid diagrams of type stateDiagram-v2.+pStateDiagram :: ExprPair -> MermaidParser Diagram+pStateDiagram exprPair = do+ _ <- string "stateDiagram-v2" <* spaces++ transitions <- many (pStateTransition exprPair)++ pure $ Diagram transitions++-- | Parser for transition label in stateDiagram-v2 mermaid diagram.+pStateTransition :: ExprPair -> MermaidParser (Int, String, Int)+pStateTransition ep@(ExprPair { _exprParse = parseProp }) = do+ _ <- spaces+ from <- read <$> many digitChar+ _ <- spaces+ string "-->"+ _ <- spaces+ to <- read <$> many digitChar+ _ <- spaces+ _ <- char ':'+ _ <- spaces+ edge <- many (noneOf ("\n" :: [Char]))++ let x = parseProp edge+ when (isLeft x) $ fancyFailure $ Set.singleton $+ ErrorFail $ "Edge property has incorrect format: " ++ show edge++ _ <- newline++ pure $ (from, exprPairShow ep edge, to)++-- | Parser for Mermaid diagrams of type sequenceDiagram.+pSequenceDiagram :: ExprPair -> MermaidParser Diagram+pSequenceDiagram exprPair = do+ spaces+ _ <- string "sequenceDiagram"+ spaces++ conditions <- many (pSequenceTransition exprPair)+ let transitions = zipWith (\t idx -> (idx, t, idx + 1)) conditions [0..]++ pure $ Diagram transitions++-- | Parser for a connection, message or transition in a sequence diagram.+--+-- This parser depends on an auxiliary parser for the expressions associated to+-- the connections or messages between elements.+pSequenceTransition :: ExprPair -> MermaidParser String+pSequenceTransition ep@(ExprPair { _exprParse = parseProp }) = do+ spaces+ stateFrom <- many digitChar+ spaces+ pSequenceArrow+ spaces+ stateTo <- many digitChar+ spaces+ _ <- char ':'+ spaces+ edge <- many (noneOf ("\n" :: [Char]))++ let x = parseProp edge+ when (isLeft x) $ fancyFailure $ Set.singleton $+ ErrorFail $ "Edge property has incorrect format: " ++ show edge++ _ <- newline++ pure (exprPairShow ep edge)++-- | Parser for arrow in sequence diagram.+pSequenceArrow :: MermaidParser ()+pSequenceArrow = void $ choice+ [ string "->>"+ , string "-->>"+ , string "-)"+ ] -- | Consume spaces spaces :: MermaidParser ()