{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.REST.Internal.WorkStrategy where

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

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])

newtype WorkStrategy rule term oc = WorkStrategy (forall m . GetWork m rule term oc)

bfs :: WorkStrategy rule term oc
bfs :: WorkStrategy rule term oc
bfs = (forall (m :: * -> *). GetWork m rule term oc)
-> WorkStrategy rule term oc
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])
forall (m :: * -> *). GetWork m rule term oc
bfs'

notVisitedFirst :: (Eq term, Eq rule, Eq oc, Hashable term) => WorkStrategy rule term oc
notVisitedFirst :: WorkStrategy rule term oc
notVisitedFirst = (forall (m :: * -> *). GetWork m rule term oc)
-> WorkStrategy rule term oc
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
forall (m :: * -> *). GetWork m rule term oc
notVisitedFirst'

bfs' :: [Path rule term oc] ->  ExploredTerms et oc m -> (Path rule term oc, [Path rule term oc])
bfs' :: [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
_ = [Char] -> (Path rule term oc, [Path rule term oc])
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' :: GetWork m rule term oc
notVisitedFirst' [Path rule term oc]
paths ExploredTerms term oc m
et =
  case (Path rule term oc -> Bool)
-> [Path rule term oc] -> Maybe (Path rule term oc)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\Path rule term oc
p -> Bool -> Bool
not (term -> ExploredTerms term oc m -> Bool
forall term c (m :: * -> *).
(Eq term, Hashable term) =>
term -> ExploredTerms term c m -> Bool
ET.visited (Path rule term oc -> term
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, Path rule term oc -> [Path rule term oc] -> [Path rule term oc]
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 -> ([Path rule term oc] -> Path rule term oc
forall a. [a] -> a
head [Path rule term oc]
paths, [Path rule term oc] -> [Path rule term oc]
forall a. [a] -> [a]
tail [Path rule term oc]
paths)

commutesLast :: forall term oc . (Eq term, Eq oc, Hashable term) => WorkStrategy Rewrite term oc
commutesLast :: WorkStrategy Rewrite term oc
commutesLast = (forall (m :: * -> *). GetWork m Rewrite term oc)
-> WorkStrategy Rewrite term oc
forall rule term oc.
(forall (m :: * -> *). GetWork m rule term oc)
-> WorkStrategy rule term oc
WorkStrategy forall term a c (m :: * -> *).
(Hashable term, Eq term, Eq a) =>
[Path Rewrite term a]
-> ExploredTerms term c m
-> (Path Rewrite term a, [Path Rewrite term a])
forall (m :: * -> *). GetWork m Rewrite term oc
go where
  go :: [Path Rewrite term a]
-> ExploredTerms term c m
-> (Path Rewrite term a, [Path Rewrite term a])
go [Path Rewrite term a]
paths ExploredTerms term c m
et =
    case (Path Rewrite term a -> Bool)
-> [Path Rewrite term a] -> Maybe (Path Rewrite term a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\Path Rewrite term a
p -> Bool -> Bool
not (term -> ExploredTerms term c m -> Bool
forall term c (m :: * -> *).
(Eq term, Hashable term) =>
term -> ExploredTerms term c m -> Bool
ET.visited (Path Rewrite term a -> term
forall rule term a. Path rule term a -> term
runtimeTerm Path Rewrite term a
p) ExploredTerms term c m
et Bool -> Bool -> Bool
|| Path Rewrite term a -> Bool
forall term a b. ([Step Rewrite term a], b) -> Bool
fromComm Path Rewrite term a
p)) [Path Rewrite term a]
paths of
        Just Path Rewrite term a
p  -> (Path Rewrite term a
p, Path Rewrite term a
-> [Path Rewrite term a] -> [Path Rewrite term a]
forall a. Eq a => a -> [a] -> [a]
L.delete Path Rewrite term a
p [Path Rewrite term a]
paths)
        Maybe (Path Rewrite term a)
Nothing -> ([Path Rewrite term a] -> Path Rewrite term a
forall a. [a] -> a
head [Path Rewrite term a]
paths, [Path Rewrite term a] -> [Path Rewrite term a]
forall a. [a] -> [a]
tail [Path Rewrite term a]
paths)
  fromComm :: ([Step Rewrite term a], b) -> Bool
fromComm ([], b
_)    = Bool
False
  fromComm ([Step Rewrite term a]
steps, b
_) = (Rewrite -> Maybe [Char]
getName (Rewrite -> Maybe [Char])
-> ([Step Rewrite term a] -> Rewrite)
-> [Step Rewrite term a]
-> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Step Rewrite term a -> Rewrite
forall rule term a. Step rule term a -> rule
rule (Step Rewrite term a -> Rewrite)
-> ([Step Rewrite term a] -> Step Rewrite term a)
-> [Step Rewrite term a]
-> Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Step Rewrite term a] -> Step Rewrite term a
forall a. [a] -> a
last) [Step Rewrite term a]
steps Maybe [Char] -> Maybe [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"mpComm"