eo-phi-normalizer-0.1.0: app/Main.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}

module Main where

import Control.Monad (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 Options.Generic

data CLINamedParams = CLINamedParams
  { chain :: Bool
  , rulesYaml :: Maybe String
  , outPath :: Maybe String
  }
  deriving (Generic, Show, ParseRecord, Read, ParseField)

instance ParseFields CLINamedParams where
  parseFields _ _ _ _ =
    CLINamedParams
      <$> 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

data CLIOptions = CLIOptions CLINamedParams (Maybe FilePath)
  deriving (Generic, Show, ParseRecord)

main :: IO ()
main = do
  opts <- getRecord "Normalizer"
  let (CLIOptions params inPath) = opts
  let (CLINamedParams{..}) = params
  case rulesYaml of
    Just path -> do
      ruleSet <- parseRuleSetFromFile path
      putStrLn ruleSet.title
      src <- maybe getContents readFile inPath
      let progOrError = parseProgram src
      case progOrError of
        Left err -> error ("An error occurred parsing the input program: " <> err)
        Right input@(Program bindings) -> do
          let results
                | chain = applyRulesChain (Context (convertRule <$> ruleSet.rules)) (Formation bindings)
                | otherwise = pure <$> applyRules (Context (convertRule <$> ruleSet.rules)) (Formation bindings)
              uniqueResults = nub results
              totalResults = length uniqueResults
          -- TODO #48:15m use outPath to output to file if provided
          putStrLn "Input:"
          putStrLn (printTree input)
          putStrLn "===================================================="
          forM_ (zip [1 ..] uniqueResults) $ \(i, steps) -> do
            putStrLn $
              "Result " <> show i <> " out of " <> show totalResults <> ":"
            let n = length steps
            forM_ (zip [1 ..] steps) $ \(k, step) -> do
              Control.Monad.when chain $ do
                putStr ("[ " <> show k <> " / " <> show n <> " ]")
              putStrLn (printTree step)
            putStrLn "----------------------------------------------------"
    -- TODO #48:15m still need to consider `chain` (should rewrite/change defaultMain to mainWithOptions)
    Nothing -> defaultMain