#!/usr/bin/env stack
-- stack script --resolver nightly-2026-10-16 --package base --package recursion-schemes
{-# LANGUAGE GHC2024 #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

import Data.Functor.Foldable (Base, Recursive (..), Corecursive (..), fold)
import Data.Functor.Foldable.TH (makeBaseFunctor)

-- This language has variables, pairs, and lambdas - just
-- enough to get our point across.
-- Ignore the ! strictness annotations if they are unfamiliar.
data Exp =
    ExpVar !String
  | ExpPair Exp Exp
  | ExpLam !String Exp
  deriving stock (Show)

-- The simple expression `\y -> (x, y)`
-- A lambda with one bound and one free variable in the body
exampleExp :: Exp
exampleExp = ExpLam "y" (ExpPair (ExpVar "x") (ExpVar "y"))

freeVars :: Exp -> [String]
freeVars = \case
  ExpVar v -> [v]
  ExpPair a b -> freeVars a ++ freeVars b
  ExpLam v a -> filter (/= v) (freeVars a)

makeBaseFunctor ''Exp

-- Recall `freeVars :: Exp -> [String]`
-- Here we use the base functor and put the result type
-- into our child type position.
freeVarsF :: ExpF [String] -> [String]
freeVarsF = \case
  ExpVarF v -> [v]
  ExpPairF a b ->
    a ++ b  -- No call here, children already lists
  ExpLamF v a ->
    filter (/= v) a  -- Same here

bindersF :: ExpF [String] -> [String]
bindersF = \case
  ExpVarF _ -> []
  ExpPairF a b -> a ++ b
  ExpLamF v a -> [v] ++ a

fuse :: Functor f =>
  (f x -> x) -> (f y -> y) -> (f (x, y) -> (x, y))
fuse f1 f2 fxy = (f1 (fmap fst fxy), f2 (fmap snd fxy))