From e497068a32cb9f82c60447cf4262a0f777ef78f0 Mon Sep 17 00:00:00 2001 From: Piotr Justyna Date: Thu, 23 May 2024 19:11:32 +0000 Subject: [PATCH] String -> Icon works --- README.md | 20 ++++---- app/Icon.hs | 16 +++++++ app/Main.hs | 7 ++- app/Parser.hs | 109 +++++++++++++++++++++--------------------- app/Renderer.hs | 18 +------ drakon-renderer.cabal | 7 +-- 6 files changed, 93 insertions(+), 84 deletions(-) create mode 100644 app/Icon.hs diff --git a/README.md b/README.md index 34473eb..d9b2e97 100644 --- a/README.md +++ b/README.md @@ -15,23 +15,23 @@ Haskell drakon renderer. Proposed input syntax to be converted to diagram images: ``` -icon "start" as start -icon "action 1" as action1 -icon "end" as end +start t "title - description" +action a1 "action - description" +end e "end - description" -start > action1 -action1 > end +t > a1 +a1 > e ``` -This would render something like: +This would render something like the following mermaid: ```mermaid stateDiagram-v2 -state "start" as start -state "action 1" as action1 -state "end" as end +state "title - description" as title +state "action - description" as action1 +state "end - description" as end -start --> action1 +title --> action1 action1 --> end ``` diff --git a/app/Icon.hs b/app/Icon.hs new file mode 100644 index 0000000..29fc7a8 --- /dev/null +++ b/app/Icon.hs @@ -0,0 +1,16 @@ +module Icon where + +import qualified GHC.Utils.Outputable + +data IconType = Title | End | Action | Question + +instance Show IconType where + show Title = "Title" + show End = "End" + show Action = "Action" + show Question = "Question" + +data Icon = Icon { iconText :: String, iconType :: IconType } + +instance GHC.Utils.Outputable.Outputable Icon where + ppr Icon { iconText = x, iconType = y } = GHC.Utils.Outputable.text $ show y ++ ": " ++ x \ No newline at end of file diff --git a/app/Main.hs b/app/Main.hs index c061e22..ccf38de 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,13 @@ module Main where +import qualified GHC.Utils.Outputable +import qualified GHC.Utils.Ppr + import qualified Parser +import qualified System.IO + main :: IO () main = do - print $ Parser.parse Parser.iconDefinition "icon \"starticon1\" as start" + GHC.Utils.Outputable.printSDocLn GHC.Utils.Outputable.defaultSDocContext GHC.Utils.Ppr.LeftMode System.IO.stdout $ GHC.Utils.Outputable.ppr $ Parser.parse Parser.iconDefinition "title t \"title - description\"" diff --git a/app/Parser.hs b/app/Parser.hs index 7449c9b..a722183 100644 --- a/app/Parser.hs +++ b/app/Parser.hs @@ -3,6 +3,9 @@ module Parser where import qualified Control.Applicative import qualified Data.Char +-- TODO: to qualified +import Icon + newtype Parser a = P (String -> [(a, String)]) instance Functor Parser where @@ -52,14 +55,11 @@ sat f = do -- but the below also works: -- if f x then P (\input -> [(x, input)]) else Control.Applicative.empty -digit :: Parser Char -digit = sat Data.Char.isDigit - -lower :: Parser Char -lower = sat Data.Char.isLower - -alphanum :: Parser Char -alphanum = sat Data.Char.isAlphaNum +isAllowedDescriptionCharacter :: Char -> Bool +isAllowedDescriptionCharacter x = + Data.Char.isAlphaNum x + || Data.Char.isSpace x + || x == '-' char :: Char -> Parser Char char x = sat (== x) @@ -71,30 +71,28 @@ string (x:xs) = do _ <- string xs return (x:xs) -identifier' :: Parser String -identifier' = do - x <- lower - xs <- Control.Applicative.many alphanum - return (x:xs) +-- 2024-05-23 PJ: +-- TODO: many but no more than N +iconIdentifier :: Parser String +iconIdentifier = do Control.Applicative.many $ sat Data.Char.isAlphaNum -identifier :: Parser String -identifier = token identifier' - -naturalNumber' :: Parser Int -naturalNumber' = do - xs <- Control.Applicative.some digit - return (read xs) - -naturalNumber :: Parser Int -naturalNumber = token naturalNumber' +iconDescription :: Parser String +iconDescription = do + _ <- symbol "\"" + name <- Control.Applicative.many $ sat isAllowedDescriptionCharacter + _ <- symbol "\"" + return name -naturalNumbers :: Parser [Int] -naturalNumbers = do _ <- symbol "[" - x <- naturalNumber - xs <- Control.Applicative.many (do symbol "," - naturalNumber) - _ <- symbol "]" - return (x:xs) +-- 2024-05-23 PJ: +-- I thought about "many but no more than N" +-- but in the end convinced myself it won't be needed. +-- We can always limit the number of spaces using an +-- input size constant. +-- Any input larger than that constant will be ignored. +space :: Parser () +space = do + _ <- Control.Applicative.many (sat Data.Char.isSpace) + return () token :: Parser a -> Parser a token p = do @@ -106,28 +104,31 @@ token p = do symbol :: String -> Parser String symbol xs = token (string xs) -integer :: Parser Int -integer = do - _ <- char '-' - n <- naturalNumber - return (-n) +iconDefinition'' :: Parser Icon +iconDefinition'' = + do + _ <- symbol "title" + identifier <- token iconIdentifier + description <- token iconDescription + return Icon { iconText = description, iconType = Title} Control.Applicative.<|> - naturalNumber - -space :: Parser () -space = do - _ <- Control.Applicative.many (sat Data.Char.isSpace) - return () - -iconDefinition' :: Parser String -iconDefinition' = do - _ <- symbol "icon" - _ <- symbol "\"" - name <- token identifier - _ <- symbol "\"" - _ <- symbol "as" - _ <- symbol "start" - return name - -iconDefinition :: Parser String -iconDefinition = token iconDefinition' \ No newline at end of file + do + _ <- symbol "action" + identifier <- token iconIdentifier + description <- token iconDescription + return Icon { iconText = description, iconType = Action} + Control.Applicative.<|> + do + _ <- symbol "question" + identifier <- token iconIdentifier + description <- token iconDescription + return Icon { iconText = description, iconType = Question} + Control.Applicative.<|> + do + _ <- symbol "end" + identifier <- token iconIdentifier + description <- token iconDescription + return Icon { iconText = description, iconType = End} + +iconDefinition :: Parser Icon +iconDefinition = token iconDefinition'' \ No newline at end of file diff --git a/app/Renderer.hs b/app/Renderer.hs index fdcba3b..a01725b 100644 --- a/app/Renderer.hs +++ b/app/Renderer.hs @@ -8,23 +8,9 @@ import qualified Diagrams.Backend.SVG.CmdLine import qualified Diagrams.Prelude import qualified GHC.Data.Graph.Directed -import qualified GHC.Utils.Outputable -import qualified GHC.Utils.Ppr -import qualified System.IO - -data IconType = Title | End | Action | Question - -instance Show IconType where - show Title = "Title" - show End = "End" - show Action = "Action" - show Question = "Question" - -data Icon = Icon { iconText :: String, iconType :: IconType } - -instance GHC.Utils.Outputable.Outputable Icon where - ppr Icon { iconText = x, iconType = y } = GHC.Utils.Outputable.text $ show y ++ ": " ++ x +-- TODO: to qualified +import Icon -- constructing the graph -> diff --git a/drakon-renderer.cabal b/drakon-renderer.cabal index 5b18497..e13f518 100644 --- a/drakon-renderer.cabal +++ b/drakon-renderer.cabal @@ -37,8 +37,8 @@ category: Development build-type: Simple -- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. -extra-doc-files: CHANGELOG.md, - README.md +extra-doc-files: changelog.md, + readme.md -- Extra source files to be distributed with the package, such as examples, or a tutorial module. -- extra-source-files: @@ -51,7 +51,8 @@ executable drakon-renderer main-is: Main.hs - other-modules: Parser, + other-modules: Icon, + Parser, Renderer default-extensions: LambdaCase