-- 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]