{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

-- SPDX-FileCopyrightText: Copyright (c) 2025 Objectionary.com
-- SPDX-License-Identifier: MIT

module Rewriter (rewrite) where

import Ast
import Builder
import qualified Condition as C
import Control.Exception
import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust)
import Logger (logDebug)
import Matcher (MetaValue (MvAttribute, MvBindings, MvExpression), Subst (Subst), combine, combineMany, matchProgram, substEmpty, substSingle)
import Misc (ensuredFile)
import Parser (parseProgram, parseProgramThrows)
import Pretty (prettyExpression, prettyProgram, prettySubsts)
import Replacer (replaceProgram)
import Text.Printf
import qualified Yaml as Y

data RewriteException
  = CouldNotBuild {RewriteException -> Expression
expr :: Expression, RewriteException -> [Subst]
substs :: [Subst]}
  | CouldNotReplace {RewriteException -> Program
prog :: Program, RewriteException -> Expression
ptn :: Expression, RewriteException -> Expression
res :: Expression}
  deriving (Show RewriteException
Typeable RewriteException
(Typeable RewriteException, Show RewriteException) =>
(RewriteException -> SomeException)
-> (SomeException -> Maybe RewriteException)
-> (RewriteException -> String)
-> Exception RewriteException
SomeException -> Maybe RewriteException
RewriteException -> String
RewriteException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: RewriteException -> SomeException
toException :: RewriteException -> SomeException
$cfromException :: SomeException -> Maybe RewriteException
fromException :: SomeException -> Maybe RewriteException
$cdisplayException :: RewriteException -> String
displayException :: RewriteException -> String
Exception)

instance Show RewriteException where
  show :: RewriteException -> String
show CouldNotBuild {[Subst]
Expression
expr :: RewriteException -> Expression
substs :: RewriteException -> [Subst]
expr :: Expression
substs :: [Subst]
..} =
    String -> String -> String -> String
forall r. PrintfType r => String -> r
printf
      String
"Couldn't build given expression with provided substitutions\n--Expression: %s\n--Substitutions: %s"
      (Expression -> String
prettyExpression Expression
expr)
      ([Subst] -> String
prettySubsts [Subst]
substs)
  show CouldNotReplace {Expression
Program
prog :: RewriteException -> Program
ptn :: RewriteException -> Expression
res :: RewriteException -> Expression
prog :: Program
ptn :: Expression
res :: Expression
..} =
    String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf
      String
"Couldn't replace expression in program by pattern\nProgram: %s\n--Pattern: %s\n--Result: %s"
      (Program -> String
prettyProgram Program
prog)
      (Expression -> String
prettyExpression Expression
ptn)
      (Expression -> String
prettyExpression Expression
res)

-- Build pattern and result expression and replace patterns to results in given program
buildAndReplace :: Program -> Expression -> Expression -> [Subst] -> IO Program
buildAndReplace :: Program -> Expression -> Expression -> [Subst] -> IO Program
buildAndReplace Program
program Expression
ptn Expression
res [Subst]
substs =
  case (Expression -> [Subst] -> Maybe [Expression]
buildExpressions Expression
ptn [Subst]
substs, Expression -> [Subst] -> Maybe [Expression]
buildExpressions Expression
res [Subst]
substs) of
    (Just [Expression]
ptns, Just [Expression]
repls) -> case Program -> [Expression] -> [Expression] -> Maybe Program
replaceProgram Program
program [Expression]
ptns [Expression]
repls of
      Just Program
prog -> Program -> IO Program
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
prog
      Maybe Program
_ -> RewriteException -> IO Program
forall e a. Exception e => e -> IO a
throwIO (Program -> Expression -> Expression -> RewriteException
CouldNotReplace Program
program Expression
ptn Expression
res)
    (Maybe [Expression]
Nothing, Maybe [Expression]
_) -> RewriteException -> IO Program
forall e a. Exception e => e -> IO a
throwIO (Expression -> [Subst] -> RewriteException
CouldNotBuild Expression
ptn [Subst]
substs)
    (Maybe [Expression]
_, Maybe [Expression]
Nothing) -> RewriteException -> IO Program
forall e a. Exception e => e -> IO a
throwIO (Expression -> [Subst] -> RewriteException
CouldNotBuild Expression
res [Subst]
substs)

-- Extend list of given substitutions with extra substitutions from 'where' yaml rule section
extraSubstitutions :: Program -> Maybe [Y.Extra] -> [Subst] -> [Subst]
extraSubstitutions :: Program -> Maybe [Extra] -> [Subst] -> [Subst]
extraSubstitutions Program
prog Maybe [Extra]
extras [Subst]
substs = case Maybe [Extra]
extras of
  Maybe [Extra]
Nothing -> [Subst]
substs
  Just [Extra]
extras' ->
    [Maybe Subst] -> [Subst]
forall a. [Maybe a] -> [a]
catMaybes
      [ case Extra -> Expression
Y.meta Extra
extra of
          ExMeta String
name -> do
            let func :: String
func = Extra -> String
Y.function Extra
extra
                args :: [Expression]
args = Extra -> [Expression]
Y.args Extra
extra
            Expression
expr <- String -> [Expression] -> Subst -> Program -> Maybe Expression
buildExpressionFromFunction String
func [Expression]
args Subst
subst Program
prog
            Subst -> Subst -> Maybe Subst
combine (String -> MetaValue -> Subst
substSingle String
name (Expression -> MetaValue
MvExpression Expression
expr)) Subst
subst
          Expression
_ -> Subst -> Maybe Subst
forall a. a -> Maybe a
Just Subst
subst
        | Subst
subst <- [Subst]
substs,
          Extra
extra <- [Extra]
extras'
      ]

rewrite :: Program -> [Y.Rule] -> IO Program
rewrite :: Program -> [Rule] -> IO Program
rewrite Program
program [] = Program -> IO Program
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
program
rewrite Program
program (Rule
rule : [Rule]
rest) = do
  String -> IO ()
logDebug (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Trying to apply rule: %s" (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"unknown" (Rule -> Maybe String
Y.name Rule
rule)))
  let ptn :: Expression
ptn = Rule -> Expression
Y.pattern Rule
rule
      res :: Expression
res = Rule -> Expression
Y.result Rule
rule
      condition :: Maybe Condition
condition = Rule -> Maybe Condition
Y.when Rule
rule
      replaced :: [Subst] -> IO Program
replaced = Program -> Expression -> Expression -> [Subst] -> IO Program
buildAndReplace Program
program Expression
ptn Expression
res
      extended :: [Subst] -> [Subst]
extended = Program -> Maybe [Extra] -> [Subst] -> [Subst]
extraSubstitutions Program
program (Rule -> Maybe [Extra]
Y.where_ Rule
rule)
  Program
prog <- case Expression -> Maybe Condition -> Program -> Maybe [Subst]
C.matchProgramWithCondition Expression
ptn Maybe Condition
condition Program
program of
    Maybe [Subst]
Nothing -> do
      String -> IO ()
logDebug String
"Rule didn't match"
      Program -> IO Program
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
program
    Just [Subst]
matched -> do
      let substs :: [Subst]
substs = [Subst] -> [Subst]
extended [Subst]
matched
      String -> IO ()
logDebug (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Rule has been matched, substitutions are:\n%s" ([Subst] -> String
prettySubsts [Subst]
substs))
      [Subst] -> IO Program
replaced [Subst]
substs
  Program -> [Rule] -> IO Program
rewrite Program
prog [Rule]
rest