{-# LANGUAGE
    FlexibleContexts
  #-}

module LText.Eval where

import LText.Expr (Expr (..))

import           Data.HashSet        (HashSet)
import qualified Data.HashSet        as HS


evaluate :: Expr -> Expr
evaluate :: Expr -> Expr
evaluate Expr
e =
  case Expr
e of
    Abs String
n Expr
e' -> String -> Expr -> Expr
Abs String
n (Expr -> Expr
evaluate Expr
e')
    Concat Expr
e1 Expr
e2 String
s Bool
err ->
      case (Expr -> Expr
evaluate Expr
e1, Expr -> Expr
evaluate Expr
e2) of
        (Lit [Text]
t1 String
_ Bool
_, Lit [Text]
t2 String
_ Bool
_) -> [Text] -> String -> Bool -> Expr
Lit ([Text]
t1 forall a. [a] -> [a] -> [a]
++ [Text]
t2) String
s Bool
err -- forget children?
        (Expr
e1'   , Expr
e2'   ) -> Expr -> Expr -> String -> Bool -> Expr
Concat Expr
e1' Expr
e2' String
s Bool
err
    App Expr
e1 Expr
e2 ->
      case Expr -> Expr
evaluate Expr
e1 of
        Abs String
n Expr
e1' -> String -> Expr -> Expr -> Expr
substitute String
n (Expr -> Expr
evaluate Expr
e2) (Expr -> Expr
evaluate Expr
e1')
        Expr
e1'       -> Expr -> Expr -> Expr
App Expr
e1' (Expr -> Expr
evaluate Expr
e2)
    Expr
_ -> Expr
e


substitute :: String -> Expr -> Expr -> Expr
substitute :: String -> Expr -> Expr -> Expr
substitute String
n Expr
x Expr
e =
  case Expr
e of
    Concat Expr
e1 Expr
e2 String
s Bool
err    -> Expr -> Expr -> String -> Bool -> Expr
Concat (String -> Expr -> Expr -> Expr
substitute String
n Expr
x Expr
e1) (String -> Expr -> Expr -> Expr
substitute String
n Expr
x Expr
e2) String
s Bool
err
    Var String
n'    | String
n forall a. Eq a => a -> a -> Bool
== String
n'   -> Expr
x
              | Bool
otherwise -> String -> Expr
Var String
n'
    App Expr
e1 Expr
e2             -> Expr -> Expr -> Expr
App (String -> Expr -> Expr -> Expr
substitute String
n Expr
x Expr
e1) (String -> Expr -> Expr -> Expr
substitute String
n Expr
x Expr
e2)
    Abs String
n' Expr
e' | String
n forall a. Eq a => a -> a -> Bool
== String
n'   -> String -> Expr -> Expr
Abs String
n' Expr
e'
              | Bool
otherwise -> String -> Expr -> Expr
Abs String
n' forall a b. (a -> b) -> a -> b
$ String -> Expr -> Expr -> Expr
substitute String
n Expr
x Expr
e'
    Expr
_ -> Expr
e


freeVars :: Expr -> HashSet String
freeVars :: Expr -> HashSet String
freeVars Expr
e =
  case Expr
e of
    Abs String
n Expr
e'     -> forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.delete String
n forall a b. (a -> b) -> a -> b
$ Expr -> HashSet String
freeVars Expr
e'
    App Expr
e1 Expr
e2    -> Expr -> HashSet String
freeVars Expr
e1 forall a. Semigroup a => a -> a -> a
<> Expr -> HashSet String
freeVars Expr
e2
    Var String
n        -> forall a. Hashable a => a -> HashSet a
HS.singleton String
n
    Lit [Text]
_ String
_ Bool
_    -> forall a. HashSet a
HS.empty
    Concat Expr
e1 Expr
e2 String
_ Bool
_ -> Expr -> HashSet String
freeVars Expr
e1 forall a. Semigroup a => a -> a -> a
<> Expr -> HashSet String
freeVars Expr
e2