{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}

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

-- This module represents Ast tree for parsed phi-calculus program
module Ast where

import GHC.Generics (Generic)

newtype Program = Program Expression -- Q -> expr
  deriving (Program -> Program -> Bool
(Program -> Program -> Bool)
-> (Program -> Program -> Bool) -> Eq Program
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Program -> Program -> Bool
== :: Program -> Program -> Bool
$c/= :: Program -> Program -> Bool
/= :: Program -> Program -> Bool
Eq, Int -> Program -> ShowS
[Program] -> ShowS
Program -> String
(Int -> Program -> ShowS)
-> (Program -> String) -> ([Program] -> ShowS) -> Show Program
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Program -> ShowS
showsPrec :: Int -> Program -> ShowS
$cshow :: Program -> String
show :: Program -> String
$cshowList :: [Program] -> ShowS
showList :: [Program] -> ShowS
Show)

data Expression
  = ExFormation [Binding] -- [bindings]
  | ExThis
  | ExGlobal -- Q
  | ExTermination -- T
  | ExMeta String -- !e
  | ExApplication Expression Binding -- expr(attr -> expr)
  | ExDispatch Expression Attribute -- expr.attr
  | ExMetaTail Expression String -- expr * !t
  deriving (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
/= :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expression -> ShowS
showsPrec :: Int -> Expression -> ShowS
$cshow :: Expression -> String
show :: Expression -> String
$cshowList :: [Expression] -> ShowS
showList :: [Expression] -> ShowS
Show, (forall x. Expression -> Rep Expression x)
-> (forall x. Rep Expression x -> Expression) -> Generic Expression
forall x. Rep Expression x -> Expression
forall x. Expression -> Rep Expression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Expression -> Rep Expression x
from :: forall x. Expression -> Rep Expression x
$cto :: forall x. Rep Expression x -> Expression
to :: forall x. Rep Expression x -> Expression
Generic)

data Binding
  = BiTau Attribute Expression -- attr -> expr
  | BiMeta String -- !B
  | BiDelta Bytes -- Δ ⤍ 1F-2A
  | BiVoid Attribute -- attr ↦ ?
  | BiLambda String -- λ ⤍ Function
  | BiMetaLambda String -- λ ⤍ !F
  deriving (Binding -> Binding -> Bool
(Binding -> Binding -> Bool)
-> (Binding -> Binding -> Bool) -> Eq Binding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Binding -> Binding -> Bool
== :: Binding -> Binding -> Bool
$c/= :: Binding -> Binding -> Bool
/= :: Binding -> Binding -> Bool
Eq, Int -> Binding -> ShowS
[Binding] -> ShowS
Binding -> String
(Int -> Binding -> ShowS)
-> (Binding -> String) -> ([Binding] -> ShowS) -> Show Binding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Binding -> ShowS
showsPrec :: Int -> Binding -> ShowS
$cshow :: Binding -> String
show :: Binding -> String
$cshowList :: [Binding] -> ShowS
showList :: [Binding] -> ShowS
Show, (forall x. Binding -> Rep Binding x)
-> (forall x. Rep Binding x -> Binding) -> Generic Binding
forall x. Rep Binding x -> Binding
forall x. Binding -> Rep Binding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Binding -> Rep Binding x
from :: forall x. Binding -> Rep Binding x
$cto :: forall x. Rep Binding x -> Binding
to :: forall x. Rep Binding x -> Binding
Generic)

data Bytes
  = BtEmpty -- --
  | BtOne String -- 1F-
  | BtMany [String] -- 00-01-02-...04
  | BtMeta String -- !b
  deriving (Bytes -> Bytes -> Bool
(Bytes -> Bytes -> Bool) -> (Bytes -> Bytes -> Bool) -> Eq Bytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bytes -> Bytes -> Bool
== :: Bytes -> Bytes -> Bool
$c/= :: Bytes -> Bytes -> Bool
/= :: Bytes -> Bytes -> Bool
Eq, Int -> Bytes -> ShowS
[Bytes] -> ShowS
Bytes -> String
(Int -> Bytes -> ShowS)
-> (Bytes -> String) -> ([Bytes] -> ShowS) -> Show Bytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bytes -> ShowS
showsPrec :: Int -> Bytes -> ShowS
$cshow :: Bytes -> String
show :: Bytes -> String
$cshowList :: [Bytes] -> ShowS
showList :: [Bytes] -> ShowS
Show, (forall x. Bytes -> Rep Bytes x)
-> (forall x. Rep Bytes x -> Bytes) -> Generic Bytes
forall x. Rep Bytes x -> Bytes
forall x. Bytes -> Rep Bytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Bytes -> Rep Bytes x
from :: forall x. Bytes -> Rep Bytes x
$cto :: forall x. Rep Bytes x -> Bytes
to :: forall x. Rep Bytes x -> Bytes
Generic)

data Attribute
  = AtLabel String -- attr
  | AtAlpha Integer -- α1
  | AtPhi -- φ
  | AtRho -- ρ
  | AtLambda -- λ, used only in yaml conditions
  | AtDelta -- Δ, used only in yaml conditions
  | AtMeta String -- !a
  deriving (Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
/= :: Attribute -> Attribute -> Bool
Eq, (forall x. Attribute -> Rep Attribute x)
-> (forall x. Rep Attribute x -> Attribute) -> Generic Attribute
forall x. Rep Attribute x -> Attribute
forall x. Attribute -> Rep Attribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Attribute -> Rep Attribute x
from :: forall x. Attribute -> Rep Attribute x
$cto :: forall x. Rep Attribute x -> Attribute
to :: forall x. Rep Attribute x -> Attribute
Generic, Eq Attribute
Eq Attribute =>
(Attribute -> Attribute -> Ordering)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Attribute)
-> (Attribute -> Attribute -> Attribute)
-> Ord Attribute
Attribute -> Attribute -> Bool
Attribute -> Attribute -> Ordering
Attribute -> Attribute -> Attribute
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Attribute -> Attribute -> Ordering
compare :: Attribute -> Attribute -> Ordering
$c< :: Attribute -> Attribute -> Bool
< :: Attribute -> Attribute -> Bool
$c<= :: Attribute -> Attribute -> Bool
<= :: Attribute -> Attribute -> Bool
$c> :: Attribute -> Attribute -> Bool
> :: Attribute -> Attribute -> Bool
$c>= :: Attribute -> Attribute -> Bool
>= :: Attribute -> Attribute -> Bool
$cmax :: Attribute -> Attribute -> Attribute
max :: Attribute -> Attribute -> Attribute
$cmin :: Attribute -> Attribute -> Attribute
min :: Attribute -> Attribute -> Attribute
Ord)

instance Show Attribute where
  show :: Attribute -> String
show (AtLabel String
label) = String
label
  show (AtAlpha Integer
idx) = Char
'α' Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> String
forall a. Show a => a -> String
show Integer
idx
  show Attribute
AtRho = String
"ρ"
  show Attribute
AtPhi = String
"φ"
  show Attribute
AtDelta = String
"Δ"
  show Attribute
AtLambda = String
"λ"
  show (AtMeta String
meta) = Char
'!' Char -> ShowS
forall a. a -> [a] -> [a]
: String
meta

countNodes :: Program -> Integer
countNodes :: Program -> Integer
countNodes (Program Expression
expr) = Expression -> Integer
countNodes' Expression
expr
  where
    countNodes' :: Expression -> Integer
    countNodes' :: Expression -> Integer
countNodes' Expression
ExGlobal = Integer
1
    countNodes' Expression
ExTermination = Integer
1
    countNodes' Expression
ExThis = Integer
1
    countNodes' (ExApplication Expression
expr' (BiTau Attribute
attr Expression
bexpr')) = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expression -> Integer
countNodes' Expression
expr' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expression -> Integer
countNodes' Expression
bexpr'
    countNodes' (ExDispatch Expression
expr' Attribute
attr) = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expression -> Integer
countNodes' Expression
expr'
    countNodes' (ExFormation [Binding]
bds) = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Binding -> Integer) -> [Binding] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (\case BiTau Attribute
attr Expression
expr' -> Expression -> Integer
countNodes' Expression
expr'; Binding
_ -> Integer
1) [Binding]
bds)
    countNodes' Expression
_ = Integer
0