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

-- The goal of the module is to build phi expression based on
-- pattern expression and set of substitutions by replacing
-- meta variables with appropriate meta values
module Builder
  ( buildExpressions,
    buildExpression,
    buildExpressionFromFunction,
    buildAttribute,
    buildBinding,
  )
where

import Ast
import qualified Data.Map.Strict as Map
import Matcher

contextualize :: Expression -> Expression -> Program -> Expression
contextualize :: Expression -> Expression -> Program -> Expression
contextualize Expression
ExGlobal Expression
_ (Program Expression
expr) = Expression
expr
contextualize Expression
ExThis Expression
expr Program
_ = Expression
expr
contextualize Expression
ExTermination Expression
_ Program
_ = Expression
ExTermination
contextualize (ExFormation [Binding]
bds) Expression
_ Program
_ = [Binding] -> Expression
ExFormation [Binding]
bds
contextualize (ExDispatch Expression
expr Attribute
attr) Expression
context Program
prog = Expression -> Attribute -> Expression
ExDispatch (Expression -> Expression -> Program -> Expression
contextualize Expression
expr Expression
context Program
prog) Attribute
attr
contextualize (ExApplication Expression
expr (BiTau Attribute
attr Expression
bexpr)) Expression
context Program
prog = do
  let expr' :: Expression
expr' = Expression -> Expression -> Program -> Expression
contextualize Expression
expr Expression
context Program
prog
      bexpr' :: Expression
bexpr' = Expression -> Expression -> Program -> Expression
contextualize Expression
bexpr Expression
context Program
prog
  Expression -> Binding -> Expression
ExApplication Expression
expr' (Attribute -> Expression -> Binding
BiTau Attribute
attr Expression
bexpr')

buildAttribute :: Attribute -> Subst -> Maybe Attribute
buildAttribute :: Attribute -> Subst -> Maybe Attribute
buildAttribute (AtMeta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvAttribute Attribute
attr) -> Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just Attribute
attr
  Maybe MetaValue
_ -> Maybe Attribute
forall a. Maybe a
Nothing
buildAttribute Attribute
attr Subst
_ = Attribute -> Maybe Attribute
forall a. a -> Maybe a
Just Attribute
attr

-- Build binding
-- The function returns [Binding] because the BiMeta is always attached
-- to the list of bindings
buildBinding :: Binding -> Subst -> Maybe [Binding]
buildBinding :: Binding -> Subst -> Maybe [Binding]
buildBinding (BiTau Attribute
attr Expression
expr) Subst
subst = do
  Attribute
attribute <- Attribute -> Subst -> Maybe Attribute
buildAttribute Attribute
attr Subst
subst
  Expression
expression <- Expression -> Subst -> Maybe Expression
buildExpression Expression
expr Subst
subst
  [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Attribute -> Expression -> Binding
BiTau Attribute
attribute Expression
expression]
buildBinding (BiVoid Attribute
attr) Subst
subst = do
  Attribute
attribute <- Attribute -> Subst -> Maybe Attribute
buildAttribute Attribute
attr Subst
subst
  [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Attribute -> Binding
BiVoid Attribute
attribute]
buildBinding (BiMeta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvBindings [Binding]
bds) -> [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Binding]
bds
  Maybe MetaValue
_ -> Maybe [Binding]
forall a. Maybe a
Nothing
buildBinding (BiMetaDelta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvBytes String
bytes) -> [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [String -> Binding
BiDelta String
bytes]
  Maybe MetaValue
_ -> Maybe [Binding]
forall a. Maybe a
Nothing
buildBinding (BiMetaLambda String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvFunction String
func) -> [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [String -> Binding
BiLambda String
func]
  Maybe MetaValue
_ -> Maybe [Binding]
forall a. Maybe a
Nothing
buildBinding Binding
binding Subst
_ = [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just [Binding
binding]

-- Build bindings that may contain meta binding (BiMeta)
buildBindings :: [Binding] -> Subst -> Maybe [Binding]
buildBindings :: [Binding] -> Subst -> Maybe [Binding]
buildBindings [] Subst
_ = [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just []
buildBindings (Binding
bd : [Binding]
rest) Subst
subst = do
  [Binding]
first <- Binding -> Subst -> Maybe [Binding]
buildBinding Binding
bd Subst
subst
  [Binding]
bds <- [Binding] -> Subst -> Maybe [Binding]
buildBindings [Binding]
rest Subst
subst
  [Binding] -> Maybe [Binding]
forall a. a -> Maybe a
Just ([Binding]
first [Binding] -> [Binding] -> [Binding]
forall a. [a] -> [a] -> [a]
++ [Binding]
bds)

buildExpressionWithTails :: Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails :: Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails Expression
expr [] Subst
_ = Expression
expr
buildExpressionWithTails Expression
expr (Tail
tail : [Tail]
rest) Subst
subst = case Tail
tail of
  TaApplication Binding
taus -> Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails (Expression -> Binding -> Expression
ExApplication Expression
expr Binding
taus) [Tail]
rest Subst
subst
  TaDispatch Attribute
attr -> Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails (Expression -> Attribute -> Expression
ExDispatch Expression
expr Attribute
attr) [Tail]
rest Subst
subst

buildExpression :: Expression -> Subst -> Maybe Expression
buildExpression :: Expression -> Subst -> Maybe Expression
buildExpression (ExDispatch Expression
expr Attribute
attr) Subst
subst = do
  Expression
dispatched <- Expression -> Subst -> Maybe Expression
buildExpression Expression
expr Subst
subst
  Attribute
attr <- Attribute -> Subst -> Maybe Attribute
buildAttribute Attribute
attr Subst
subst
  Expression -> Maybe Expression
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Attribute -> Expression
ExDispatch Expression
dispatched Attribute
attr)
buildExpression (ExApplication Expression
expr (BiTau Attribute
battr Expression
bexpr)) Subst
subst = do
  Expression
applied <- Expression -> Subst -> Maybe Expression
buildExpression Expression
expr Subst
subst
  [Binding
binding] <- Binding -> Subst -> Maybe [Binding]
buildBinding (Attribute -> Expression -> Binding
BiTau Attribute
battr Expression
bexpr) Subst
subst
  Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Binding -> Expression
ExApplication Expression
applied Binding
binding)
buildExpression (ExApplication Expression
_ Binding
_) Subst
_ = Maybe Expression
forall a. Maybe a
Nothing
buildExpression (ExFormation [Binding]
bds) Subst
subst = [Binding] -> Subst -> Maybe [Binding]
buildBindings [Binding]
bds Subst
subst Maybe [Binding]
-> ([Binding] -> Maybe Expression) -> Maybe Expression
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> Maybe Expression)
-> ([Binding] -> Expression) -> [Binding] -> Maybe Expression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Binding] -> Expression
ExFormation)
buildExpression (ExMeta String
meta) (Subst Map String MetaValue
mp) = case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
  Just (MvExpression Expression
expr) -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
expr
  Maybe MetaValue
_ -> Maybe Expression
forall a. Maybe a
Nothing
buildExpression (ExMetaTail Expression
expr String
meta) Subst
subst = do
  let (Subst Map String MetaValue
mp) = Subst
subst
  Expression
expression <- Expression -> Subst -> Maybe Expression
buildExpression Expression
expr Subst
subst
  case String -> Map String MetaValue -> Maybe MetaValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
meta Map String MetaValue
mp of
    Just (MvTail [Tail]
tails) -> Expression -> Maybe Expression
forall a. a -> Maybe a
Just (Expression -> [Tail] -> Subst -> Expression
buildExpressionWithTails Expression
expression [Tail]
tails Subst
subst)
    Maybe MetaValue
_ -> Maybe Expression
forall a. Maybe a
Nothing
buildExpression Expression
expr Subst
_ = Expression -> Maybe Expression
forall a. a -> Maybe a
Just Expression
expr

buildExpressionFromFunction :: String -> [Expression] -> Subst -> Program -> Maybe Expression
buildExpressionFromFunction :: String -> [Expression] -> Subst -> Program -> Maybe Expression
buildExpressionFromFunction String
"contextualize" [Expression
expr, Expression
context] Subst
subst Program
prog = do
  Expression
expr' <- Expression -> Subst -> Maybe Expression
buildExpression Expression
expr Subst
subst
  Expression
context' <- Expression -> Subst -> Maybe Expression
buildExpression Expression
context Subst
subst
  Expression -> Maybe Expression
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Expression -> Program -> Expression
contextualize Expression
expr' Expression
context' Program
prog)
buildExpressionFromFunction String
_ [Expression]
_ Subst
_ Program
_ = Maybe Expression
forall a. Maybe a
Nothing

-- Build a several expression from one expression and several substitutions
buildExpressions :: Expression -> [Subst] -> Maybe [Expression]
buildExpressions :: Expression -> [Subst] -> Maybe [Expression]
buildExpressions Expression
expr = (Subst -> Maybe Expression) -> [Subst] -> Maybe [Expression]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Expression -> Subst -> Maybe Expression
buildExpression Expression
expr)