{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.REST.Internal.WorkStrategy (
  GetWork,
  WorkStrategy(..),
  bfs,
  notVisitedFirst) where

import Language.REST.ExploredTerms as ET
import Language.REST.Path

import Data.Hashable
import qualified Data.List as L

type GetWork m rule term oc = [Path rule term oc] -> ExploredTerms term oc m -> (Path rule term oc, [Path rule term oc])

-- | 'WorkStrategy' defines the procedure for choosing which pending path REST explores
newtype WorkStrategy rule term oc = WorkStrategy (forall m . GetWork m rule term oc)

-- | Explore the rewrite tree in BFS style. Using this strategy enables finding the
--   shortest rewrite path to a desired term.
bfs :: WorkStrategy rule term oc
bfs :: forall rule term oc. WorkStrategy rule term oc
bfs = forall rule term oc.
(forall (m :: * -> *). GetWork m rule term oc)
-> WorkStrategy rule term oc
WorkStrategy forall rule term oc et (m :: * -> *).
[Path rule term oc]
-> ExploredTerms et oc m
-> (Path rule term oc, [Path rule term oc])
bfs'

-- | Prioritize searching for terms that haven't been seen before. This strategy may
--   explore all reachable terms earlier, reducing the need to explore down the remaining
--   unexplored paths.
notVisitedFirst :: (Eq term, Eq rule, Eq oc, Hashable term) => WorkStrategy rule term oc
notVisitedFirst :: forall term rule oc.
(Eq term, Eq rule, Eq oc, Hashable term) =>
WorkStrategy rule term oc
notVisitedFirst = forall rule term oc.
(forall (m :: * -> *). GetWork m rule term oc)
-> WorkStrategy rule term oc
WorkStrategy forall term rule oc (m :: * -> *).
(Eq term, Eq rule, Eq oc, Hashable term) =>
GetWork m rule term oc
notVisitedFirst'

bfs' :: [Path rule term oc] ->  ExploredTerms et oc m -> (Path rule term oc, [Path rule term oc])
bfs' :: forall rule term oc et (m :: * -> *).
[Path rule term oc]
-> ExploredTerms et oc m
-> (Path rule term oc, [Path rule term oc])
bfs' (Path rule term oc
h:[Path rule term oc]
t) ExploredTerms et oc m
_ = (Path rule term oc
h, [Path rule term oc]
t)
bfs' [Path rule term oc]
_ ExploredTerms et oc m
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"empty path list"

notVisitedFirst' :: (Eq term, Eq rule, Eq oc, Hashable term) => GetWork m rule term oc
notVisitedFirst' :: forall term rule oc (m :: * -> *).
(Eq term, Eq rule, Eq oc, Hashable term) =>
GetWork m rule term oc
notVisitedFirst' [Path rule term oc]
paths ExploredTerms term oc m
et =
  case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\Path rule term oc
p -> Bool -> Bool
not (forall term c (m :: * -> *).
(Eq term, Hashable term) =>
term -> ExploredTerms term c m -> Bool
ET.visited (forall rule term a. Path rule term a -> term
runtimeTerm Path rule term oc
p) ExploredTerms term oc m
et)) [Path rule term oc]
paths of
    Just Path rule term oc
p  -> (Path rule term oc
p, forall a. Eq a => a -> [a] -> [a]
L.delete Path rule term oc
p [Path rule term oc]
paths)
    Maybe (Path rule term oc)
Nothing -> (forall a. [a] -> a
head [Path rule term oc]
paths, forall a. [a] -> [a]
tail [Path rule term oc]
paths)