{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards #-}

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

-- The goal of the module is to traverse though the Program with replacing
-- pattern sub expression with target expressions
module Replacer (replaceProgram, replaceProgramThrows) where

import Ast
import Control.Exception (Exception, throwIO)
import Matcher (Tail (TaApplication, TaDispatch))
import Pretty (prettyExpression, prettyProgram)
import Text.Printf (printf)

newtype ReplaceException = CouldNotReplace {ReplaceException -> Program
prog :: Program}
  deriving (Show ReplaceException
Typeable ReplaceException
(Typeable ReplaceException, Show ReplaceException) =>
(ReplaceException -> SomeException)
-> (SomeException -> Maybe ReplaceException)
-> (ReplaceException -> String)
-> Exception ReplaceException
SomeException -> Maybe ReplaceException
ReplaceException -> String
ReplaceException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ReplaceException -> SomeException
toException :: ReplaceException -> SomeException
$cfromException :: SomeException -> Maybe ReplaceException
fromException :: SomeException -> Maybe ReplaceException
$cdisplayException :: ReplaceException -> String
displayException :: ReplaceException -> String
Exception)

instance Show ReplaceException where
  show :: ReplaceException -> String
show CouldNotReplace {Program
prog :: ReplaceException -> Program
prog :: Program
..} =
    String -> ShowS
forall r. PrintfType r => String -> r
printf
      String
"Couldn't replace expression in program, lists of patterns and targets has different lengths\nProgram: %s"
      (Program -> String
prettyProgram Program
prog)

replaceBindings :: [Binding] -> [Expression] -> [Expression] -> ([Binding], [Expression], [Expression])
replaceBindings :: [Binding]
-> [Expression]
-> [Expression]
-> ([Binding], [Expression], [Expression])
replaceBindings [Binding]
bds [] [] = ([Binding]
bds, [], [])
replaceBindings [] [Expression]
ptns [Expression]
repls = ([], [Expression]
ptns, [Expression]
repls)
replaceBindings (BiTau Attribute
attr Expression
expr : [Binding]
bds) [Expression]
ptns [Expression]
repls =
  let (Expression
expr', [Expression]
ptns', [Expression]
repls') = Expression
-> [Expression]
-> [Expression]
-> (Expression, [Expression], [Expression])
replaceExpression Expression
expr [Expression]
ptns [Expression]
repls
      ([Binding]
bds', [Expression]
ptns'', [Expression]
repls'') = [Binding]
-> [Expression]
-> [Expression]
-> ([Binding], [Expression], [Expression])
replaceBindings [Binding]
bds [Expression]
ptns' [Expression]
repls'
   in (Attribute -> Expression -> Binding
BiTau Attribute
attr Expression
expr' Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: [Binding]
bds', [Expression]
ptns'', [Expression]
repls'')
replaceBindings (Binding
bd : [Binding]
bds) [Expression]
ptns [Expression]
repls =
  let ([Binding]
bds', [Expression]
ptns', [Expression]
repls') = [Binding]
-> [Expression]
-> [Expression]
-> ([Binding], [Expression], [Expression])
replaceBindings [Binding]
bds [Expression]
ptns [Expression]
repls
   in (Binding
bd Binding -> [Binding] -> [Binding]
forall a. a -> [a] -> [a]
: [Binding]
bds', [Expression]
ptns', [Expression]
repls')

replaceExpression :: Expression -> [Expression] -> [Expression] -> (Expression, [Expression], [Expression])
replaceExpression :: Expression
-> [Expression]
-> [Expression]
-> (Expression, [Expression], [Expression])
replaceExpression Expression
expr [] [] = (Expression
expr, [], [])
replaceExpression Expression
expr [Expression]
ptns [Expression]
repls =
  let (Expression
ptn : [Expression]
ptnsRest) = [Expression]
ptns
      (Expression
repl : [Expression]
replsRest) = [Expression]
repls
   in if Expression
expr Expression -> Expression -> Bool
forall a. Eq a => a -> a -> Bool
== Expression
ptn
        then Expression
-> [Expression]
-> [Expression]
-> (Expression, [Expression], [Expression])
replaceExpression Expression
repl [Expression]
ptnsRest [Expression]
replsRest
        else case Expression
expr of
          ExDispatch Expression
inner Attribute
attr ->
            let (Expression
expr', [Expression]
ptns', [Expression]
repls') = Expression
-> [Expression]
-> [Expression]
-> (Expression, [Expression], [Expression])
replaceExpression Expression
inner [Expression]
ptns [Expression]
repls
             in (Expression -> Attribute -> Expression
ExDispatch Expression
expr' Attribute
attr, [Expression]
ptns', [Expression]
repls')
          ExApplication Expression
inner Binding
tau ->
            let (Expression
expr', [Expression]
ptns', [Expression]
repls') = Expression
-> [Expression]
-> [Expression]
-> (Expression, [Expression], [Expression])
replaceExpression Expression
inner [Expression]
ptns [Expression]
repls
                ([Binding
tau'], [Expression]
ptns'', [Expression]
repls'') = [Binding]
-> [Expression]
-> [Expression]
-> ([Binding], [Expression], [Expression])
replaceBindings [Binding
tau] [Expression]
ptns' [Expression]
repls'
             in (Expression -> Binding -> Expression
ExApplication Expression
expr' Binding
tau', [Expression]
ptns'', [Expression]
repls'')
          ExFormation [Binding]
bds ->
            let ([Binding]
bds', [Expression]
ptns', [Expression]
repls') = [Binding]
-> [Expression]
-> [Expression]
-> ([Binding], [Expression], [Expression])
replaceBindings [Binding]
bds [Expression]
ptns [Expression]
repls
             in ([Binding] -> Expression
ExFormation [Binding]
bds', [Expression]
ptns', [Expression]
repls')
          Expression
_ -> (Expression
expr, [Expression]
ptns, [Expression]
repls)

replaceProgram :: Program -> [Expression] -> [Expression] -> Maybe Program
replaceProgram :: Program -> [Expression] -> [Expression] -> Maybe Program
replaceProgram (Program Expression
expr) [Expression]
ptns [Expression]
repls
  | [Expression] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression]
ptns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Expression] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression]
repls =
      let (Expression
expr', [Expression]
_, [Expression]
_) = Expression
-> [Expression]
-> [Expression]
-> (Expression, [Expression], [Expression])
replaceExpression Expression
expr [Expression]
ptns [Expression]
repls
       in Program -> Maybe Program
forall a. a -> Maybe a
Just (Expression -> Program
Program Expression
expr')
  | Bool
otherwise = Maybe Program
forall a. Maybe a
Nothing

replaceProgramThrows :: Program -> [Expression] -> [Expression] -> IO Program
replaceProgramThrows :: Program -> [Expression] -> [Expression] -> IO Program
replaceProgramThrows Program
prog [Expression]
ptns [Expression]
repls = case Program -> [Expression] -> [Expression] -> Maybe Program
replaceProgram Program
prog [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
_ -> ReplaceException -> IO Program
forall e a. Exception e => e -> IO a
throwIO (Program -> ReplaceException
CouldNotReplace Program
prog)