module Ideas.Common.Strategy.Combinators where
import Data.Graph
import Data.List ((\\))
import Data.Maybe
import Ideas.Common.CyclicTree hiding (label)
import Ideas.Common.Id
import Ideas.Common.Rule
import Ideas.Common.Strategy.Abstract
import Ideas.Common.Strategy.Process
import Ideas.Common.Strategy.StrategyTree
import Ideas.Common.Utils (fst3, thd3)
import Prelude hiding (not, repeat, fail, sequence)
import qualified Ideas.Common.Strategy.Choice as Choice
import qualified Ideas.Common.Strategy.Derived as Derived
import qualified Ideas.Common.Strategy.Sequence as Sequence
import qualified Prelude
infixr 2 .%., .@.
infixr 3 .|.
infixr 4 ./., |>
infixr 5 .*., !~>
(.*.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
(.*.) = liftS2 (Sequence..*.)
(.|.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
(.|.) = liftS2 (Choice..|.)
(.%.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
s .%. t = interleave [toStrategy s, toStrategy t]
(.@.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
(.@.) = decl2 $ "alternate" .=. Binary (Derived.<@>)
(!~>) :: IsStrategy f => Rule a -> f a -> Strategy a
(!~>) = decl2 $ "atomicprefix" .=. Binary (Derived.!*>)
inits :: IsStrategy f => f a -> Strategy a
inits = decl1 $ "inits" .=. Unary Derived.inits
succeed :: Strategy a
succeed = Sequence.done
fail :: Strategy a
fail = Choice.empty
atomic :: IsStrategy f => f a -> Strategy a
atomic = decl1 $ "atomic" .=. Unary Derived.atomic
sequence :: IsStrategy f => [f a] -> Strategy a
sequence = Sequence.sequence . map toStrategy
choice :: IsStrategy f => [f a] -> Strategy a
choice = Choice.choice . map toStrategy
interleave :: IsStrategy f => [f a] -> Strategy a
interleave = declN $ associative (interleaveId .=. Nary Derived.interleave)
noInterleaving :: IsStrategy f => f a -> Strategy a
noInterleaving = onStrategyTree (replaceNode f)
where
f d = if getId d == interleaveId
then fromNary (applyDecl ("sequence" .=. Nary Sequence.sequence))
else node d
interleaveId :: Id
interleaveId = newId "interleave"
permute :: IsStrategy f => [f a] -> Strategy a
permute = declN $ "permute" .=. Nary Derived.permute
many :: IsStrategy f => f a -> Strategy a
many = decl1 $ "many" .=. Unary Derived.many
many1 :: IsStrategy f => f a -> Strategy a
many1 = decl1 $ "many1" .=. Unary Derived.many1
replicate :: IsStrategy f => Int -> f a -> Strategy a
replicate n = decl1 $ ("replicate" # show n) .=. Unary (Derived.replicate n)
option :: IsStrategy f => f a -> Strategy a
option = decl1 $ "option" .=. Unary Derived.option
check :: (a -> Bool) -> Strategy a
check = toStrategy . checkRule "check"
not :: IsStrategy f => f a -> Strategy a
not = decl1 $ "not" .=. Unary (\x ->
Sequence.single $ checkRule "core.not" $ null . runProcess x)
repeat :: IsStrategy f => f a -> Strategy a
repeat = decl1 $ "repeat" .=. Unary Derived.repeat
repeat1 :: IsStrategy f => f a -> Strategy a
repeat1 = decl1 $ "repeat1" .=. Unary Derived.repeat1
try :: IsStrategy f => f a -> Strategy a
try = decl1 $ "try" .=. Unary Derived.try
(./.) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
(./.) = liftS2 (Choice../.)
(|>) :: (IsStrategy f, IsStrategy g) => f a -> g a -> Strategy a
(|>) = liftS2 (Choice.|>)
while :: IsStrategy f => (a -> Bool) -> f a -> Strategy a
while p s = repeat (check p .*. s)
until :: IsStrategy f => (a -> Bool) -> f a -> Strategy a
until p = while (Prelude.not . p)
exhaustive :: IsStrategy f => [f a] -> Strategy a
exhaustive = declN $ "exhaustive" .=. Nary Derived.exhaustive
type DependencyGraph node key = [(node, key, [key])]
dependencyGraph:: (IsStrategy f, Ord key) => DependencyGraph (f a) key -> Strategy a
dependencyGraph = make . graphFromEdges
where
make (graph, vertex2data, key2data) = rec []
where
rec seen
| null reachables = succeed
| otherwise = choice $ map makePath reachables
where
reachables = filter isReachable $ vertices graph \\ seen
isReachable = null . (\\ seen) . mapMaybe key2data . thd3 . vertex2data
makePath v = fst3 (vertex2data v) .*. rec (v:seen)