{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
module Staged.SOP.Examples.Eq where

import Staged.SOP
import Generics.SOP

-- | Derive equality decision function.
--
-- >>> :set -XTemplateHaskell -XScopedTypeVariables
-- >>> :{
--   let ex :: Either Char Bool -> Either Char Bool -> Bool
--       ex = $$(fromFn2 deriveEq)
--     :}
--
-- >>> ex (Left 'x') (Right True)
-- False
--
-- >>> ex (Left 'x') (Left 'x')
-- True
--
deriveEq :: (All2 Eq (Code a), StagedGeneric a) => TExpQ a -> TExpQ a -> TExpQ Bool
deriveEq x0 y0 =
    sfrom x0 $ \xc ->
    sfrom y0 $ \yc ->
    go (unSOP xc) (unSOP yc)
  where
    go :: All2 Eq xs => NS (NP C) xs -> NS (NP C) xs -> TExpQ Bool
    go (Z xs) (Z ys)
        = andTE
        $ hcollapse
        $ hczipWith (Proxy :: Proxy Eq) (mapCCK $ \x y -> [|| $$x == $$y ||]) xs ys
    go (S _) (Z _) = [|| False ||]
    go (Z _) (S _) = [|| False ||]
    go (S x) (S y) = go x y

andTE :: [TExpQ Bool] -> TExpQ Bool
andTE = foldr (\x y -> [|| $$x && $$y ||]) [|| True ||]