{- |
Description: Binary-search tree for finding the position of new lines.
Copyright: © 2019 James Alexander Feldman-Crough
License: MPL-2.0
-}
module ProSource.LineMap
    ( LineMap
    , lineOffsets
    , lineToOffset
    , offsetToLine
    , fromOffsets
    ) where

import Data.Vector.Unboxed (Vector)
import qualified Data.Vector.Unboxed as V

import ProSource.Units

-- | A dense vector containing offsets poiting to the start of each line. That is, the starting position of the third line of a file can be found at position 2.
newtype LineMap = LineMap (Vector Offset)
    deriving stock (LineMap -> LineMap -> Bool
(LineMap -> LineMap -> Bool)
-> (LineMap -> LineMap -> Bool) -> Eq LineMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LineMap -> LineMap -> Bool
$c/= :: LineMap -> LineMap -> Bool
== :: LineMap -> LineMap -> Bool
$c== :: LineMap -> LineMap -> Bool
Eq, (forall x. LineMap -> Rep LineMap x)
-> (forall x. Rep LineMap x -> LineMap) -> Generic LineMap
forall x. Rep LineMap x -> LineMap
forall x. LineMap -> Rep LineMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LineMap x -> LineMap
$cfrom :: forall x. LineMap -> Rep LineMap x
Generic)
    deriving newtype (Int -> LineMap -> ShowS
[LineMap] -> ShowS
LineMap -> String
(Int -> LineMap -> ShowS)
-> (LineMap -> String) -> ([LineMap] -> ShowS) -> Show LineMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LineMap] -> ShowS
$cshowList :: [LineMap] -> ShowS
show :: LineMap -> String
$cshow :: LineMap -> String
showsPrec :: Int -> LineMap -> ShowS
$cshowsPrec :: Int -> LineMap -> ShowS
Show, LineMap -> ()
(LineMap -> ()) -> NFData LineMap
forall a. (a -> ()) -> NFData a
rnf :: LineMap -> ()
$crnf :: LineMap -> ()
NFData)

instance Hashable LineMap where
    hashWithSalt :: Int -> LineMap -> Int
hashWithSalt Int
salt (LineMap Vector Offset
v) = (Int -> Offset -> Int) -> Int -> Vector Offset -> Int
forall b a. Unbox b => (a -> b -> a) -> a -> Vector b -> a
V.foldl' Int -> Offset -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Vector Offset
v

fromOffsets :: Foldable f => f Offset -> LineMap
fromOffsets :: f Offset -> LineMap
fromOffsets = Vector Offset -> LineMap
LineMap (Vector Offset -> LineMap)
-> (f Offset -> Vector Offset) -> f Offset -> LineMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Offset] -> Vector Offset
forall a. Unbox a => [a] -> Vector a
V.fromList ([Offset] -> Vector Offset)
-> (f Offset -> [Offset]) -> f Offset -> Vector Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Offset] -> [Offset]
forall a. Ord a => [a] -> [a]
sort ([Offset] -> [Offset])
-> (f Offset -> [Offset]) -> f Offset -> [Offset]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Offset -> [Offset]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | Convert a 'LineMap' into a list of 'Offset's, corresponding to the first character of a line. Note that the initial offset is omitted-- the offset at index 0 will be the offset of the /second/ line.
lineOffsets :: LineMap -> [Offset]
lineOffsets :: LineMap -> [Offset]
lineOffsets (LineMap Vector Offset
v) = Vector Offset -> [Offset]
forall a. Unbox a => Vector a -> [a]
V.toList Vector Offset
v

-- | Fetch the 'Offset' for the given 'Line'. Evaluates to 'Nothing' if the given 'Line' does not appear in the LineMap
lineToOffset :: Line -> LineMap -> Maybe Offset
lineToOffset :: Line -> LineMap -> Maybe Offset
lineToOffset = \case
    Line Word
0 -> \LineMap
_ -> Offset -> Maybe Offset
forall a. a -> Maybe a
Just (Offset -> Maybe Offset) -> Offset -> Maybe Offset
forall a b. (a -> b) -> a -> b
$ Word -> Offset
Offset Word
0
    Line Word
nth -> \(LineMap Vector Offset
xs) -> Vector Offset
xs Vector Offset -> Int -> Maybe Offset
forall a. Unbox a => Vector a -> Int -> Maybe a
V.!? Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word
forall a. Enum a => a -> a
pred Word
nth)

-- | Fetch the 'Line' number for a given 'Offset'. Newlines will be attributed the line that they terminate, rather than the line started immediately afterwards.
offsetToLine :: Offset -> LineMap -> Line
offsetToLine :: Offset -> LineMap -> Line
offsetToLine Offset
offset (LineMap Vector Offset
xs) = Word -> Line
Line (Word -> Line) -> Word -> Line
forall a b. (a -> b) -> a -> b
$ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int -> Int -> Int
go Maybe Int
forall a. Maybe a
Nothing Int
0 (Vector Offset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector Offset
xs)
  where
    go :: Maybe Int -> Int -> Int -> Int
go Maybe Int
result Int
min Int
max | Int
min Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
max = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. Enum a => a -> a
succ Maybe Int
result
    go Maybe Int
result Int
min Int
max = case Offset -> Offset -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Offset
nthOffset Offset
offset of
        Ordering
EQ -> Int -> Int
forall a. Enum a => a -> a
succ Int
nthIndex
        Ordering
LT -> Maybe Int -> Int -> Int -> Int
go (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
nthIndex) (Int
nthIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
max
        Ordering
GT -> Maybe Int -> Int -> Int -> Int
go Maybe Int
result Int
min Int
nthIndex
      where
        nthIndex :: Int
nthIndex  = ((Int
max Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
min) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
min
        nthOffset :: Offset
nthOffset = Vector Offset
xs Vector Offset -> Int -> Offset
forall a. Unbox a => Vector a -> Int -> a
V.! Int
nthIndex