module Data.Array.Comfort.Shape.Set where

import qualified Data.Set as Set
import Data.Set (Set)
import Data.Maybe.HT (toMaybe)


offset :: Ord a => Set a -> a -> Maybe Int
offset :: forall a. Ord a => Set a -> a -> Maybe Int
offset = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Maybe Int
Set.lookupIndex

uncheckedOffset :: Ord a => Set a -> a -> Int
uncheckedOffset :: forall a. Ord a => Set a -> a -> Int
uncheckedOffset = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> Set a -> Int
Set.findIndex


indexFromOffset :: Set a -> Int -> Maybe a
indexFromOffset :: forall a. Set a -> Int -> Maybe a
indexFromOffset Set a
set Int
k =
   forall a. Bool -> a -> Maybe a
toMaybe (Int
0forall a. Ord a => a -> a -> Bool
<=Int
k Bool -> Bool -> Bool
&& Int
kforall a. Ord a => a -> a -> Bool
<forall a. Set a -> Int
Set.size Set a
set) (forall a. Int -> Set a -> a
Set.elemAt Int
k Set a
set)

uncheckedIndexFromOffset :: Set a -> Int -> a
uncheckedIndexFromOffset :: forall a. Set a -> Int -> a
uncheckedIndexFromOffset = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Int -> Set a -> a
Set.elemAt