{-# LANGUAGE RankNTypes, MultiParamTypeClasses, TypeFamilies, GADTs, RelaxedPolyRec, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
module Data.Cursor.CLASE.Traversal(
  Traversal(..),
  completeTraversal
) where

import Data.Cursor.CLASE.Bound
import Data.Cursor.CLASE.Language

class (Bound l t) => Traversal l t where

  visitStep :: (Reify l a) => a -> (forall b . Reify l b => Movement l Down a b -> t) -> t

  visitPartial :: Context l a b -> b -> t -> (forall c . Reify l c => Movement l Down b c -> t) -> t

  cursor :: l -> t -> t


completeTraversal :: forall l t x a . (Traversal l t) => Cursor l x a -> t
completeTraversal (Cursor it ctx _) = foldUp (cursor (undefined :: l) (visitStep it hook')) it ctx
  where
    hook' :: forall b . Reify l b => Movement l Down a b -> t
    hook' = hook it

hook :: forall l t a b . (Traversal l t, Reify l b) => a -> Movement l Down a b -> t
hook here movement = case unbuildOne movement here of
  Just (ctx, b) -> let hook' :: forall c . Reify l c => Movement l Down b c -> t
                       hook' = hook b
                       in bindingHook ctx (visitStep b hook')
  Nothing -> error "Bad movement in traversal!"


foldUp :: (Traversal l t) => t -> a -> Path l (Context l) a b -> t
foldUp t _ Stop = t
foldUp t here (Step ctx nxt) = foldUp (bindingHook ctx (visitPartial ctx next t (hook next))) next nxt
  where
    next = buildOne ctx here