feat: add single option that prints a single normalized program

objectionary · Feb 9, 2024 · f44b51a · f44b51a
1 parent d3d37d6
commit f44b51a
Showing 1 changed file with 21 additions and 15 deletions.
diff --git a/eo-phi-normalizer/app/Main.hs b/eo-phi-normalizer/app/Main.hs
@@ -8,20 +8,21 @@
 
 module Main where
 
-import Control.Monad (when)
+import Control.Monad (unless, when)
 import Data.Foldable (forM_)
 
 import Data.List (nub)
 import Language.EO.Phi (Object (Formation), Program (Program), defaultMain, parseProgram, printTree)
 import Language.EO.Phi.Rules.Common (Context (..), applyRules, applyRulesChain)
-import Language.EO.Phi.Rules.Yaml
+import Language.EO.Phi.Rules.Yaml (RuleSet (rules, title), convertRule, parseRuleSetFromFile)
 import Options.Generic
 import System.IO (IOMode (WriteMode), hClose, hPutStr, hPutStrLn, openFile, stdout)
 
 data CLINamedParams = CLINamedParams
   { chain :: Bool
   , rulesYaml :: Maybe String
   , outPath :: Maybe String
+  , single :: Bool
   }
   deriving (Generic, Show, ParseRecord, Read, ParseField)
 
@@ -31,6 +32,7 @@ instance ParseFields CLINamedParams where
       <$> parseFields (Just "Print out steps of reduction") (Just "chain") (Just 'c') Nothing
       <*> parseFields (Just "Path to the Yaml file with custom rules") (Just "rules-yaml") Nothing Nothing
       <*> parseFields (Just "Output file path (defaults to stdout)") (Just "output") (Just 'o') Nothing
+      <*> parseFields (Just "Print a single normlized expression") (Just "single") (Just 's') Nothing
 
 data CLIOptions = CLIOptions CLINamedParams (Maybe FilePath)
   deriving (Generic, Show, ParseRecord)
@@ -46,7 +48,7 @@ main = do
       let logStr = hPutStr handle
       let logStrLn = hPutStrLn handle
       ruleSet <- parseRuleSetFromFile path
-      logStrLn ruleSet.title
+      unless single $ logStrLn ruleSet.title
       src <- maybe getContents readFile inPath
       let progOrError = parseProgram src
       case progOrError of
@@ -57,18 +59,22 @@ main = do
                 | otherwise = pure <$> applyRules (Context (convertRule <$> ruleSet.rules) [Formation bindings]) (Formation bindings)
               uniqueResults = nub results
               totalResults = length uniqueResults
-          logStrLn "Input:"
-          logStrLn (printTree input)
-          logStrLn "===================================================="
-          forM_ (zip [1 ..] uniqueResults) $ \(i, steps) -> do
-            logStrLn $
-              "Result " <> show i <> " out of " <> show totalResults <> ":"
-            let n = length steps
-            forM_ (zip [1 ..] steps) $ \(k, step) -> do
-              Control.Monad.when chain $
-                logStr ("[ " <> show k <> " / " <> show n <> " ]")
-              logStrLn (printTree step)
-            logStrLn "----------------------------------------------------"
+          when (totalResults == 0) $ error "Could not normalize the program"
+          if single
+            then logStrLn (printTree (head uniqueResults))
+            else do
+              logStrLn "Input:"
+              logStrLn (printTree input)
+              logStrLn "===================================================="
+              forM_ (zip [1 ..] uniqueResults) $ \(i, steps) -> do
+                logStrLn $
+                  "Result " <> show i <> " out of " <> show totalResults <> ":"
+                let n = length steps
+                forM_ (zip [1 ..] steps) $ \(k, step) -> do
+                  when chain $
+                    logStr ("[ " <> show k <> " / " <> show n <> " ]")
+                  logStrLn (printTree step)
+                logStrLn "----------------------------------------------------"
       hClose handle
     -- TODO #48:15m still need to consider `chain` (should rewrite/change defaultMain to mainWithOptions)
     Nothing -> defaultMain