{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

module FoldE where

import Generics.MultiRec.Base
import Generics.MultiRec.Fold
import Generics.MultiRec.HFunctor
import Generics.MultiRec.HFix
import Control.Applicative

import Except


type ErrorAlgebra' phi f e r = forall ix. phi ix -> f r ix -> Either e (r ix)
type ErrorAlgebra  s   e r = ErrorAlgebra' s (PF s) e r

type Ann x s = HFix (K x :*: PF s)

foldE :: HFunctor phi f => ErrorAlgebra' phi f e r ->
  phi ix -> HFix (K x :*: f) ix -> Except [(e, x)] (r ix)
foldE alg proof (HIn (K k :*: f)) = case hmapA (foldE alg) proof f of
  Failed xs -> Failed xs
  OK expr' -> case alg proof expr' of
    Left x'  -> Failed [(x', k)]
    Right v  -> OK v