From b1bc58025c35e1e730b767952fa33bb5a9c7e887 Mon Sep 17 00:00:00 2001
From: David Mosbach <david.mosbach@live.de>
Date: Sun, 3 Sep 2023 18:34:26 +0200
Subject: [PATCH] added warnings for unused variables

---
 dsl/app/DSL.hs        | 10 +++++-----
 dsl/app/DSLMain.hs    | 13 ++++++++++---
 dsl/app/Transpiler.hs | 29 ++++++++++++++++++++++++++---
 3 files changed, 41 insertions(+), 11 deletions(-)

diff --git a/dsl/app/DSL.hs b/dsl/app/DSL.hs
index 3ff1011..0436b3e 100644
--- a/dsl/app/DSL.hs
+++ b/dsl/app/DSL.hs
@@ -168,14 +168,14 @@ module DSL (
 
 
   parsePredicate :: Parsec BSL.ByteString u Predicate
-  parsePredicate =    try (EdgeInHistory <$> (string "edge_in_history"   *> roundBrackets parseLogVar))
-                  <|> try (NodeInHistory <$> (string "node_in_history"   *> roundBrackets parseLogVar))
-                  <|> try (PayloadFilled <$> (string "payload_filled"    *> roundBrackets parseLogVar))
-                  <|> try (PreviousNode <$> (string "previous_node"      *> roundBrackets parseLogVar))
+  parsePredicate =    try (EdgeInHistory  <$> (string "edge_in_history"  *> roundBrackets parseLogVar))
+                  <|> try (NodeInHistory  <$> (string "node_in_history"  *> roundBrackets parseLogVar))
+                  <|> try (PayloadFilled  <$> (string "payload_filled"   *> roundBrackets parseLogVar))
+                  <|> try (PreviousNode   <$> (string "previous_node"    *> roundBrackets parseLogVar))
                   <|> try (EdgesInHistory <$> (string "edges_in_history" *> roundBrackets (try (squareBrackets parseLogVars) <|> parseLogVars)))
                   <|> try (NodesInHistory <$> (string "nodes_in_history" *> roundBrackets (try (squareBrackets parseLogVars) <|> parseLogVars)))
                   <|> try (PayloadsFilled <$> (string "payloads_filled"  *> roundBrackets (try (squareBrackets parseLogVars) <|> parseLogVars)))
-                  <|> (PreviousNodes <$> (string "previous_nodes"        *> roundBrackets (try (squareBrackets parseLogVars) <|> parseLogVars)))
+                  <|>     (PreviousNodes  <$> (string "previous_nodes"   *> roundBrackets (try (squareBrackets parseLogVars) <|> parseLogVars)))
 
 
   parseLogVar :: Parsec BSL.ByteString u LogVar
diff --git a/dsl/app/DSLMain.hs b/dsl/app/DSLMain.hs
index 6af61a0..cc051f4 100644
--- a/dsl/app/DSLMain.hs
+++ b/dsl/app/DSLMain.hs
@@ -2,11 +2,14 @@
 --
 -- 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)
+  import Transpiler (resolve, ResolvedData (..), Warning (Warning))
   import Control.Monad (unless)
   import Data.Either (isLeft, fromRight)
   import Data.YAML (encode)
@@ -35,7 +38,8 @@ module DSLMain (dslMain) where
     "optional substage Vorbereitung {\n" ++
 
         "let always_required = not edge_in_history(some-edge)\n" ++
-        "let sometimes_required = { payload_filled(foo), not bar }\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" ++
@@ -45,6 +49,7 @@ module DSLMain (dslMain) where
 
         "case {\n" ++
           "always_required,\n" ++
+          -- "sometimes_required,\n" ++
           "not previous_node(last-node)\n" ++
         "}\n" ++    
       "}\n"
@@ -59,6 +64,8 @@ module DSLMain (dslMain) where
       let transp = resolve $ fromRight undefined subStage
       print transp
       putStrLn "\n\t   ### YAML ###\n"
-      putStrLn . BSLU.toString $ encode [fromRight undefined transp]
+      let rData = fromRight undefined transp
+      mapM_ print rData.warnings
+      putStrLn . BSLU.toString $ encode [rData.subStage]
 
 
diff --git a/dsl/app/Transpiler.hs b/dsl/app/Transpiler.hs
index f10af33..9fda35b 100644
--- a/dsl/app/Transpiler.hs
+++ b/dsl/app/Transpiler.hs
@@ -13,7 +13,7 @@ module Transpiler where
   import Data.YAML (ToYAML (..), mapping, (.=))
   import Data.Text (Text, pack)
   import YamlParser (AnchorData (..), YAMLNode (Sequence))
-  import Control.Monad.State (State, evalState, get, put, unless, when)
+  import Control.Monad.State (State, evalState, runState, get, put, unless, when)
   import Data.Map (Map, empty)
   import qualified Data.Map as M
   import Control.Monad.Except (ExceptT, runExceptT, throwError)
@@ -79,11 +79,34 @@ module Transpiler where
   }
 
   type Resolver = ExceptT ResolveError (State StateData)
+  newtype Warning = Warning String deriving Show
+  data ResolvedData = RData {
+    subStage :: ResolvedSubStage,
+    warnings :: [Warning]
+  } deriving (Show)
 
-  resolve :: SubStage -> Either ResolveError ResolvedSubStage
-  resolve (SubStage head body) = evalState (runExceptT (RSubStage head <$> eval body)) initState
+  resolve :: SubStage -> Either ResolveError ResolvedData
+  resolve (SubStage head body) = evaluation
     where
+      (evaluation, state) = runState (runExceptT (RData <$> (RSubStage head <$> eval body) <*> warnings)) initState
+      warnings = checkUnusedVariables
       initState = StateData empty (M.map (, False) body.variables) []
+
+  checkUnusedVariables :: Resolver [Warning]
+  checkUnusedVariables = do
+    state <- get
+    let unusedInner = M.foldl f [] state.innerVariables
+    let unusedOuter = M.foldl f [] state.outerVariables
+    return $ unusedInner ++ unusedOuter
+      where
+        f :: [Warning] -> (Variable, Bool) -> [Warning]
+        f acc (_, True) = acc
+        f acc (var, False) = Warning ("Unused variable: " ++ id) : acc
+          where id = case var of
+                        Single id' _ -> id'
+                        Block id' _ -> id'
+
+
   
   eval :: Body -> Resolver DNF
   eval (Body variables []) = get >>= \s -> return s.disjunction