lmu/uni2work.workflows.visualiser
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added negated case for yaml encoding

Browse Source
This commit is contained in:
David Mosbach 2023-09-02 02:28:50 +02:00
parent 79fd7c8ab6
commit 8972304232
2 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
dsl/app/DSLMain.hs
View File

@ -9,6 +9,7 @@ module DSLMain (dslMain) where
import Transpiler (resolve)
import Control.Monad (unless)
import Data.Either (isLeft, fromRight)
import Data.YAML (encode)
program =
"required substage InterneBearbeitung when unfulfilled {\n" ++
@ -57,4 +58,7 @@ module DSLMain (dslMain) where
putStrLn "\n\t### Transpiler ###\n"
let transp = resolve $ fromRight undefined subStage
print transp
putStrLn "\n\t ### YAML ###\n"
putStrLn . BSLU.toString $ encode [fromRight undefined transp]

8
dsl/app/Transpiler.hs
View File

@ -48,20 +48,24 @@ module Transpiler where
]
instance ToYAML DNFLiteral where
toYAML (DNFLit anchor (Pred' p)) = mapping [
"tag" .= ("variable" :: Text),
toYAML (DNFLit anchor pred) = mapping [
"tag" .= tag,
"var" .= mapping [
"tag" .= predToText p,
predToText p .= pack p.ref
]
]
where
(tag, p) = case pred of
Pred' x -> ("variable" :: Text, x)
Neg' x -> ("negated", x)
predToText :: Predicate -> Text
predToText (EdgeInHistory _) = "edge-in-history"
predToText (NodeInHistory _) = "node-in-history"
predToText (PayloadFilled _) = "payload-filled"
predToText (PreviousNode _) = "previous-node"
predToText x = error $ show x ++ " is not fully resolved"
newtype ResolveError = ResolveError String