module Language.KURE.Pathfinder
(
WithLocalPath
, withLocalPathT
, exposeLocalPathT
, acceptLocalPathT
, pathsToT
, onePathToT
, oneNonEmptyPathToT
, prunePathsToT
, uniquePathToT
, uniquePrunePathToT
) where
import Control.Category hiding ((.))
import Control.Arrow
import Data.Monoid (mempty)
import Language.KURE.MonadCatch
import Language.KURE.Transform
import Language.KURE.Combinators.Transform
import Language.KURE.Path
import Language.KURE.Walker
import Language.KURE.ExtendableContext
type WithLocalPath c crumb = ExtendContext c (LocalPath crumb)
withLocalPathT :: Transform (WithLocalPath c crumb) m a b -> Transform c m a b
withLocalPathT = liftContext (extendContext mempty)
exposeLocalPathT :: Monad m => Transform (WithLocalPath c crumb) m a (LocalPath crumb)
exposeLocalPathT = contextT >>^ extraContext
acceptLocalPathT :: Monad m => Transform c m g Bool -> Transform (WithLocalPath c crumb) m g (LocalPath crumb)
acceptLocalPathT q = accepterR (liftContext baseContext q) >>> exposeLocalPathT
pathsToT :: (Walker (WithLocalPath c crumb) g, MonadCatch m) => Transform c m g Bool -> Transform c m g [LocalPath crumb]
pathsToT q = withLocalPathT (collectT $ acceptLocalPathT q)
prunePathsToT :: (Walker (WithLocalPath c crumb) g, MonadCatch m) => Transform c m g Bool -> Transform c m g [LocalPath crumb]
prunePathsToT q = withLocalPathT (collectPruneT $ acceptLocalPathT q)
onePathToT :: forall c crumb g m. (Walker (WithLocalPath c crumb) g, MonadCatch m) => Transform c m g Bool -> Transform c m g (LocalPath crumb)
onePathToT q = setFailMsg "No matching nodes found." $
withLocalPathT (onetdT $ acceptLocalPathT q)
oneNonEmptyPathToT :: (Walker (WithLocalPath c crumb) g, MonadCatch m) => Transform c m g Bool -> Transform c m g (LocalPath crumb)
oneNonEmptyPathToT q = setFailMsg "No matching nodes found." $
withLocalPathT (oneT $ onetdT $ acceptLocalPathT q)
requireUniquePath :: Monad m => Transform c m [LocalPath crumb] (LocalPath crumb)
requireUniquePath = contextfreeT $ \ ps -> case ps of
[] -> fail "No matching nodes found."
[p] -> return p
_ -> fail $ "Ambiguous: " ++ show (length ps) ++ " matching nodes found."
uniquePathToT :: (Walker (WithLocalPath c crumb) g, MonadCatch m) => Transform c m g Bool -> Transform c m g (LocalPath crumb)
uniquePathToT q = pathsToT q >>> requireUniquePath
uniquePrunePathToT :: (Walker (WithLocalPath c crumb) g, MonadCatch m) => Transform c m g Bool -> Transform c m g (LocalPath crumb)
uniquePrunePathToT q = prunePathsToT q >>> requireUniquePath