module Annotations.F.Positional
( selectByRange, selectByPos, validBounds, repairBy, repair, moveSelection
) where
import Annotations.Bounds
import Annotations.ExploreHints
import Annotations.F.Fixpoints
import Annotations.F.Zipper
import Annotations.F.Annotated
import Data.Foldable (Foldable, toList)
import Data.Ord
import Data.List
import Data.Maybe
import Control.Applicative
selectByRange :: Foldable f => Range -> AnnFix Bounds f -> Maybe (Zipper (AnnFix Bounds f))
selectByRange range@(left, _) = listToMaybe . reverse . explore hints where
hints bounds@(Bounds _ (ir, _)) =
ExploreHints
{ matchHere = range `rangeInBounds` bounds
, exploreDown = range `rangeInRange` outerRange bounds
, exploreRight = left >= ir
}
selectByPos :: Foldable f => Int -> AnnFix Bounds f -> Maybe (Zipper (AnnFix Bounds f))
selectByPos pos = findLeftmostDeepest (posInRange pos . innerRange)
validBounds :: Foldable f => AnnFix Bounds f -> [Bounds]
validBounds (In (Ann b f)) = b : concatMap validBounds (toList f)
repairBy :: (Foldable f, Ord dist) =>
(Range -> Range -> dist) -> AnnFix Bounds f -> Range -> Bounds
repairBy cost tree range =
head (sortOn (cost range . innerRange) (validBounds tree))
repair :: Foldable f => AnnFix Bounds f -> Range -> Bounds
repair = repairBy distRange
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn = sortBy . comparing
moveSelection :: Foldable f => AnnFix Bounds f -> Nav -> Range -> Maybe Bounds
moveSelection tree (Nav nav) range = (rootAnn . zFocus) <$> (selectByRange range tree >>= nav)