72 lines
2.1 KiB
Haskell
72 lines
2.1 KiB
Haskell
-- SPDX-FileCopyrightText: 2023 David Mosbach <david.mosbach@campus.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
{-# LANGUAGE OverloadedRecordDot,
|
|
NoFieldSelectors #-}
|
|
|
|
module DSLMain (dslMain) where
|
|
import DSL (parseSubStageDef)
|
|
|
|
import Data.ByteString.Lazy.UTF8 as BSLU
|
|
import Transpiler (resolve, ResolvedData (..), Warning (Warning))
|
|
import Control.Monad (unless)
|
|
import Data.Either (isLeft, fromRight)
|
|
import Data.YAML (encode)
|
|
|
|
program =
|
|
"required substage InterneBearbeitung when unfulfilled {\n" ++
|
|
|
|
"let always_required = not edges_in_history([a, b, c])\n" ++
|
|
"let sometimes_required = { payload_filled(foo), not bar }\n" ++
|
|
|
|
"case {\n" ++
|
|
"always_required,\n" ++
|
|
"edge_in_history(abbrechen),\n" ++
|
|
"not payloads_filled([]),\n" ++
|
|
"nodes_in_history([x, y, z])\n" ++
|
|
"}\n" ++
|
|
|
|
"case {\n" ++
|
|
"always_required,\n" ++
|
|
"not previous_nodes()\n" ++
|
|
"}\n" ++
|
|
"}\n"
|
|
|
|
|
|
program2 =
|
|
"optional substage Vorbereitung {\n" ++
|
|
|
|
"let always_required = not edge_in_history(some-edge)\n" ++
|
|
"let sometimes_required = { payload_filled(fill-me), not bar }\n" ++
|
|
"let bar = payload_filled(do-not-fill-me)\n" ++
|
|
|
|
"case {\n" ++
|
|
"always_required,\n" ++
|
|
"edge_in_history(abbrechen),\n" ++
|
|
"not payload_filled(some-payload)\n" ++
|
|
"}\n" ++
|
|
|
|
"case {\n" ++
|
|
"always_required,\n" ++
|
|
-- "sometimes_required,\n" ++
|
|
"not previous_node(last-node)\n" ++
|
|
"}\n" ++
|
|
"}\n"
|
|
|
|
dslMain :: IO ()
|
|
dslMain = do
|
|
putStrLn "\n\t ### AST ###\n"
|
|
let subStage = parseSubStageDef $ BSLU.fromString program2
|
|
print subStage
|
|
unless (isLeft subStage) $ do
|
|
putStrLn "\n\t### Transpiler ###\n"
|
|
let transp = resolve $ fromRight undefined subStage
|
|
print transp
|
|
putStrLn "\n\t ### YAML ###\n"
|
|
let rData = fromRight undefined transp
|
|
mapM_ print rData.warnings
|
|
putStrLn . BSLU.toString $ encode [rData.subStage]
|
|
|
|
|