module Ideas.Common.Strategy.Location
( subTaskLocation, nextTaskLocation
, strategyLocations, subStrategy
) where
import Data.Maybe
import Ideas.Common.Id
import Ideas.Common.Strategy.Abstract
import Ideas.Common.Strategy.Core
import Ideas.Common.Utils.Uniplate
subTaskLocation :: LabeledStrategy a -> Id -> Id -> Id
subTaskLocation s xs ys = g (rec (f xs) (f ys))
where
f = fromMaybe [] . toLoc s
g = fromMaybe (getId s) . fromLoc s
rec (i:is) (j:js)
| i == j = i : rec is js
| otherwise = []
rec _ (j:_) = [j]
rec _ _ = []
nextTaskLocation :: LabeledStrategy a -> Id -> Id -> Id
nextTaskLocation s xs ys = g (rec (f xs) (f ys))
where
f = fromMaybe [] . toLoc s
g = fromMaybe (getId s) . fromLoc s
rec (i:is) (j:js)
| i == j = i : rec is js
| otherwise = [j]
rec _ _ = []
strategyLocations :: LabeledStrategy a -> [([Int], LabeledStrategy a)]
strategyLocations s = ([], s) : rec [] (toCore (unlabel s))
where
rec is = concat . zipWith make (map (:is) [0..]) . collect
make is (l, core) =
let ls = makeLabeledStrategy l (fromCore core)
in (is, ls) : rec is core
collect core =
case core of
Label l t -> [(l, t)]
Not _ -> []
_ -> concatMap collect (children core)
subStrategy :: Id -> LabeledStrategy a -> Maybe (LabeledStrategy a)
subStrategy loc =
fmap snd . listToMaybe . filter ((==loc) . getId . snd) . strategyLocations
fromLoc :: LabeledStrategy a -> [Int] -> Maybe Id
fromLoc s loc = fmap getId (lookup loc (strategyLocations s))
toLoc :: LabeledStrategy a -> Id -> Maybe [Int]
toLoc s i =
fmap fst (listToMaybe (filter ((==i) . getId . snd) (strategyLocations s)))