{-|
Module      : Prosidy.Source
Description : Utilities for tracking source locaitons.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Prosidy.Source
    ( Source(..)
    , Location
    , SparseLocation(..)
    , LineMap
    , Offset(..)
    , Line(..)
    , Column(..)
    , locationSource
    , locationColumn
    , locationLine
    , locationOffset
    , makeSource
    , getSourceLine
    , getLocation
    , enrichLocation
    , stripLocation
    , lineOffsets
    , lineToOffset
    , offsetToLine
    )
where

import           Data.Hashable                  ( Hashable(..) )
import           Data.Vector.Unboxed            ( Vector
                                                , MVector
                                                , Unbox
                                                )
import           Data.Text                      ( Text )
import           GHC.Generics                   ( Generic )
import           Control.DeepSeq                ( NFData )
import           Data.Binary                    ( Binary(..) )
import           Data.Aeson                     ( ToJSON(..)
                                                , FromJSON(..)
                                                )
import           Control.Monad                  ( guard )

import qualified Data.Text                     as T
import qualified Data.Vector.Unboxed           as V
import qualified Data.Vector.Generic           as VG
import qualified Data.Vector.Generic.Mutable   as VGM

-- | Information about Prosidy source file.
--
-- The 'Show' instance for ths class does not include the 'LineMap' or 'Text'
-- fields, as those are rather noisy.
data Source = Source
  { Source -> String
sourceName    :: String
    -- ^ The reported file-name of the 'Source'.
    --
    -- When read from file handles, a non-filepath description such as
    -- @"\<stdin\>"@ is typically chosen.
    -- This field doesn't have semantic meaning, and should only be used to
    -- enrich the output displayed to users.
  , Source -> Text
sourceText    :: Text
    -- ^ The full source, as 'Text'.
  , Source -> LineMap
sourceLineMap :: LineMap
    -- ^ A mapping of the start position of each line in the 'Source'.
  }
  deriving stock (Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, (forall x. Source -> Rep Source x)
-> (forall x. Rep Source x -> Source) -> Generic Source
forall x. Rep Source x -> Source
forall x. Source -> Rep Source x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Source x -> Source
$cfrom :: forall x. Source -> Rep Source x
Generic)
  deriving anyclass (Int -> Source -> Int
Source -> Int
(Int -> Source -> Int) -> (Source -> Int) -> Hashable Source
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Source -> Int
$chash :: Source -> Int
hashWithSalt :: Int -> Source -> Int
$chashWithSalt :: Int -> Source -> Int
Hashable, Source -> ()
(Source -> ()) -> NFData Source
forall a. (a -> ()) -> NFData a
rnf :: Source -> ()
$crnf :: Source -> ()
NFData, Get Source
[Source] -> Put
Source -> Put
(Source -> Put) -> Get Source -> ([Source] -> Put) -> Binary Source
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Source] -> Put
$cputList :: [Source] -> Put
get :: Get Source
$cget :: Get Source
put :: Source -> Put
$cput :: Source -> Put
Binary)

instance Show Source where
    show :: Source -> String
show (Source fp :: String
fp _ _) = "Source " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
fp

-- | Create a 'Source' from a descriptive name and a body. The source name is
-- typically a 'FilePath', but this is not guarenteed. For instance, when read 
-- from standard-input, Prosidy chooses to name the source @\<stdin\>@.
makeSource :: String -> Text -> Source
makeSource :: String -> Text -> Source
makeSource name :: String
name body :: Text
body = String -> Text -> LineMap -> Source
Source String
name Text
body LineMap
lineMap
  where
    lineMap :: LineMap
lineMap = case ((Word, Char, [Offset]) -> Char -> (Word, Char, [Offset]))
-> (Word, Char, [Offset]) -> Text -> (Word, Char, [Offset])
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Word, Char, [Offset]) -> Char -> (Word, Char, [Offset])
lineMapFold (1, '\0', []) (Text -> (Word, Char, [Offset])) -> Text -> (Word, Char, [Offset])
forall a b. (a -> b) -> a -> b
$ Text
body of
        (_, _, acc :: [Offset]
acc) -> Vector Offset -> LineMap
LineMap (Vector Offset -> LineMap)
-> ([Offset] -> Vector Offset) -> [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)
-> ([Offset] -> [Offset]) -> [Offset] -> Vector Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Offset] -> [Offset]
forall a. [a] -> [a]
reverse ([Offset] -> LineMap) -> [Offset] -> LineMap
forall a b. (a -> b) -> a -> b
$ [Offset]
acc
    lineMapFold :: (Word, Char, [Offset]) -> Char -> (Word, Char, [Offset])
lineMapFold (ix :: Word
ix, prev :: Char
prev, acc :: [Offset]
acc) ch :: Char
ch
        | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
&& Char
prev Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r' = (Word -> Word
forall a. Enum a => a -> a
succ Word
ix, Char
ch, Word -> Offset
Offset Word
ix Offset -> [Offset] -> [Offset]
forall a. a -> [a] -> [a]
: Int -> [Offset] -> [Offset]
forall a. Int -> [a] -> [a]
drop 1 [Offset]
acc)
        | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\r'   = (Word -> Word
forall a. Enum a => a -> a
succ Word
ix, Char
ch, Word -> Offset
Offset Word
ix Offset -> [Offset] -> [Offset]
forall a. a -> [a] -> [a]
: [Offset]
acc)
        | Bool
otherwise                  = (Word -> Word
forall a. Enum a => a -> a
succ Word
ix, Char
ch, [Offset]
acc)

-- | Convert an 'Offset' into a 'Location'.
getLocation :: Offset -> Source -> Maybe Location
getLocation :: Offset -> Source -> Maybe Location
getLocation offset :: Offset
offset src :: Source
src = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Source -> Text
sourceText Source
src) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Offset -> Int
forall a. Enum a => a -> Int
fromEnum Offset
offset
    Location -> Maybe Location
forall a. a -> Maybe a
Just (Location -> Maybe Location)
-> (SparseLocation -> Location) -> SparseLocation -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SparseLocation -> Location
enrichLocation (SparseLocation -> Maybe Location)
-> SparseLocation -> Maybe Location
forall a b. (a -> b) -> a -> b
$ Source -> Offset -> SparseLocation
SparseLocation Source
src Offset
offset

-- | Fetch a single line from a source.
getSourceLine :: Line -> Source -> Maybe Text
getSourceLine :: Line -> Source -> Maybe Text
getSourceLine line :: Line
line source :: Source
source = do
    Int
start <- Offset -> Int
forall a. Enum a => a -> Int
fromEnum (Offset -> Int) -> Maybe Offset -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> LineMap -> Maybe Offset
lineToOffset Line
line LineMap
lineMap
    let end :: Maybe Int
end = Offset -> Int
forall a. Enum a => a -> Int
fromEnum (Offset -> Int) -> Maybe Offset -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> LineMap -> Maybe Offset
lineToOffset (Line -> Line
forall a. Enum a => a -> a
succ Line
line) LineMap
lineMap
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id (Int -> Text -> Text
T.take (Int -> Text -> Text) -> (Int -> Int) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) Int
start)) Maybe Int
end (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
start (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Source -> Text
sourceText
        Source
source
    where lineMap :: LineMap
lineMap = Source -> LineMap
sourceLineMap Source
source

-- | A location in a 'Source'. The line and column numbers of this type are not
-- attached to this type; convert to a 'Location' to access those values.
data SparseLocation = SparseLocation
    { SparseLocation -> Source
sparseLocationSource :: Source
      -- ^ The 'Source' this location references.
    , SparseLocation -> Offset
sparseLocationOffset :: Offset
      -- ^ The position in the 'Source', counted by Unicode codepoints.
    }
  deriving stock (Int -> SparseLocation -> ShowS
[SparseLocation] -> ShowS
SparseLocation -> String
(Int -> SparseLocation -> ShowS)
-> (SparseLocation -> String)
-> ([SparseLocation] -> ShowS)
-> Show SparseLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SparseLocation] -> ShowS
$cshowList :: [SparseLocation] -> ShowS
show :: SparseLocation -> String
$cshow :: SparseLocation -> String
showsPrec :: Int -> SparseLocation -> ShowS
$cshowsPrec :: Int -> SparseLocation -> ShowS
Show, (forall x. SparseLocation -> Rep SparseLocation x)
-> (forall x. Rep SparseLocation x -> SparseLocation)
-> Generic SparseLocation
forall x. Rep SparseLocation x -> SparseLocation
forall x. SparseLocation -> Rep SparseLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SparseLocation x -> SparseLocation
$cfrom :: forall x. SparseLocation -> Rep SparseLocation x
Generic, SparseLocation -> SparseLocation -> Bool
(SparseLocation -> SparseLocation -> Bool)
-> (SparseLocation -> SparseLocation -> Bool) -> Eq SparseLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SparseLocation -> SparseLocation -> Bool
$c/= :: SparseLocation -> SparseLocation -> Bool
== :: SparseLocation -> SparseLocation -> Bool
$c== :: SparseLocation -> SparseLocation -> Bool
Eq)
  deriving anyclass (SparseLocation -> ()
(SparseLocation -> ()) -> NFData SparseLocation
forall a. (a -> ()) -> NFData a
rnf :: SparseLocation -> ()
$crnf :: SparseLocation -> ()
NFData, Get SparseLocation
[SparseLocation] -> Put
SparseLocation -> Put
(SparseLocation -> Put)
-> Get SparseLocation
-> ([SparseLocation] -> Put)
-> Binary SparseLocation
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [SparseLocation] -> Put
$cputList :: [SparseLocation] -> Put
get :: Get SparseLocation
$cget :: Get SparseLocation
put :: SparseLocation -> Put
$cput :: SparseLocation -> Put
Binary, Int -> SparseLocation -> Int
SparseLocation -> Int
(Int -> SparseLocation -> Int)
-> (SparseLocation -> Int) -> Hashable SparseLocation
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SparseLocation -> Int
$chash :: SparseLocation -> Int
hashWithSalt :: Int -> SparseLocation -> Int
$chashWithSalt :: Int -> SparseLocation -> Int
Hashable)

-- | A location in a 'Source', with the line and column number computed lazily.
data Location = Location
    { Location -> Source
locationSource :: Source
      -- ^ The 'Source' this location references.
    , Location -> Offset
locationOffset :: Offset
      -- ^ The position in the 'Source', counted by Unicode codepoints.
    , Location -> Line
locationLine   :: ~Line
      -- ^ The line number in the 'Source'.
    , Location -> Column
locationColumn :: ~Column
      -- ^ The column number in the 'Source'.
    }
  deriving stock (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, (forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Location x -> Location
$cfrom :: forall x. Location -> Rep Location x
Generic, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq)
  deriving anyclass (Location -> ()
(Location -> ()) -> NFData Location
forall a. (a -> ()) -> NFData a
rnf :: Location -> ()
$crnf :: Location -> ()
NFData, Get Location
[Location] -> Put
Location -> Put
(Location -> Put)
-> Get Location -> ([Location] -> Put) -> Binary Location
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Location] -> Put
$cputList :: [Location] -> Put
get :: Get Location
$cget :: Get Location
put :: Location -> Put
$cput :: Location -> Put
Binary, Int -> Location -> Int
Location -> Int
(Int -> Location -> Int) -> (Location -> Int) -> Hashable Location
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Location -> Int
$chash :: Location -> Int
hashWithSalt :: Int -> Location -> Int
$chashWithSalt :: Int -> Location -> Int
Hashable)

-- | Add lazily computed line and column number information to a 
-- 'SparseLocation'.
enrichLocation :: SparseLocation -> Location
enrichLocation :: SparseLocation -> Location
enrichLocation sl :: SparseLocation
sl = $WLocation :: Source -> Offset -> Line -> Column -> Location
Location { locationSource :: Source
locationSource = Source
source
                             , locationOffset :: Offset
locationOffset = Offset
offset
                             , locationLine :: Line
locationLine   = Line
line
                             , locationColumn :: Column
locationColumn = Column
column
                             }
  where
    source :: Source
source                     = SparseLocation -> Source
sparseLocationSource SparseLocation
sl
    lineMap :: LineMap
lineMap                    = Source -> LineMap
sourceLineMap Source
source
    offset :: Offset
offset@(~(Offset offsetN :: Word
offsetN)) = SparseLocation -> Offset
sparseLocationOffset SparseLocation
sl
    line :: Line
line                       = Offset -> LineMap -> Line
offsetToLine Offset
offset LineMap
lineMap
    column :: Column
column                     = case Line -> LineMap -> Maybe Offset
lineToOffset Line
line LineMap
lineMap of
        Just (Offset n :: Word
n) -> Word -> Column
Column (Word
offsetN Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
n)
        Nothing         -> Word -> Column
Column 0

-- | Remove line and column number information from a 'Location'.
stripLocation :: Location -> SparseLocation
stripLocation :: Location -> SparseLocation
stripLocation l :: Location
l = $WSparseLocation :: Source -> Offset -> SparseLocation
SparseLocation { sparseLocationSource :: Source
sparseLocationSource = Location -> Source
locationSource Location
l
                                 , sparseLocationOffset :: Offset
sparseLocationOffset = Location -> Offset
locationOffset Location
l
                                 }

-- | 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 Binary LineMap where
    get :: Get LineMap
get = ([Offset] -> LineMap) -> Get [Offset] -> Get LineMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector Offset -> LineMap
LineMap (Vector Offset -> LineMap)
-> ([Offset] -> Vector Offset) -> [Offset] -> LineMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Offset] -> Vector Offset
forall a. Unbox a => [a] -> Vector a
V.fromList) Get [Offset]
forall t. Binary t => Get t
get
    put :: LineMap -> Put
put (LineMap v :: Vector Offset
v) = [Offset] -> Put
forall t. Binary t => t -> Put
put (Vector Offset -> [Offset]
forall a. Unbox a => Vector a -> [a]
V.toList Vector Offset
v)

instance Hashable LineMap where
    hashWithSalt :: Int -> LineMap -> Int
hashWithSalt salt :: Int
salt (LineMap v :: 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

-- | 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 v :: 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 (Line 0  ) _            = 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 0
lineToOffset (Line nth :: Word
nth) (LineMap xs :: 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
offset (LineMap xs :: Vector Offset
xs) = Word -> Line
Line (Word -> Line) -> (Int -> Word) -> Int -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Line) -> Int -> Line
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int -> Int -> Int
go Maybe Int
forall a. Maybe a
Nothing
                                                            0
                                                            (Vector Offset -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector Offset
xs)
  where
    go :: Maybe Int -> Int -> Int -> Int
go result :: Maybe Int
result min :: Int
min max :: 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 0 Int -> Int
forall a. Enum a => a -> a
succ Maybe Int
result
        | Bool
otherwise
        = let 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` 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
          in  case Offset
nthOffset Offset -> Offset -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Offset
offset of
                  EQ -> Int -> Int
forall a. Enum a => a -> a
succ Int
nthIndex
                  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
+ 1) Int
max
                  GT -> Maybe Int -> Int -> Int -> Int
go Maybe Int
result Int
min Int
nthIndex

-- | A line number.
--
-- The 'Show' instance for 'Line' counts from one, while the internal
-- implementation counts from zero.
newtype Line = Line Word
  deriving stock (Line -> Line -> Bool
(Line -> Line -> Bool) -> (Line -> Line -> Bool) -> Eq Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line -> Line -> Bool
$c/= :: Line -> Line -> Bool
== :: Line -> Line -> Bool
$c== :: Line -> Line -> Bool
Eq, Eq Line
Eq Line =>
(Line -> Line -> Ordering)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Bool)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> Ord Line
Line -> Line -> Bool
Line -> Line -> Ordering
Line -> Line -> Line
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Line -> Line -> Line
$cmin :: Line -> Line -> Line
max :: Line -> Line -> Line
$cmax :: Line -> Line -> Line
>= :: Line -> Line -> Bool
$c>= :: Line -> Line -> Bool
> :: Line -> Line -> Bool
$c> :: Line -> Line -> Bool
<= :: Line -> Line -> Bool
$c<= :: Line -> Line -> Bool
< :: Line -> Line -> Bool
$c< :: Line -> Line -> Bool
compare :: Line -> Line -> Ordering
$ccompare :: Line -> Line -> Ordering
$cp1Ord :: Eq Line
Ord, (forall x. Line -> Rep Line x)
-> (forall x. Rep Line x -> Line) -> Generic Line
forall x. Rep Line x -> Line
forall x. Line -> Rep Line x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Line x -> Line
$cfrom :: forall x. Line -> Rep Line x
Generic, Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
(Int -> Line -> ShowS)
-> (Line -> String) -> ([Line] -> ShowS) -> Show Line
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)
  deriving newtype ([Line] -> Encoding
[Line] -> Value
Line -> Encoding
Line -> Value
(Line -> Value)
-> (Line -> Encoding)
-> ([Line] -> Value)
-> ([Line] -> Encoding)
-> ToJSON Line
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Line] -> Encoding
$ctoEncodingList :: [Line] -> Encoding
toJSONList :: [Line] -> Value
$ctoJSONList :: [Line] -> Value
toEncoding :: Line -> Encoding
$ctoEncoding :: Line -> Encoding
toJSON :: Line -> Value
$ctoJSON :: Line -> Value
ToJSON, Value -> Parser [Line]
Value -> Parser Line
(Value -> Parser Line) -> (Value -> Parser [Line]) -> FromJSON Line
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Line]
$cparseJSONList :: Value -> Parser [Line]
parseJSON :: Value -> Parser Line
$cparseJSON :: Value -> Parser Line
FromJSON, Int -> Line
Line -> Int
Line -> [Line]
Line -> Line
Line -> Line -> [Line]
Line -> Line -> Line -> [Line]
(Line -> Line)
-> (Line -> Line)
-> (Int -> Line)
-> (Line -> Int)
-> (Line -> [Line])
-> (Line -> Line -> [Line])
-> (Line -> Line -> [Line])
-> (Line -> Line -> Line -> [Line])
-> Enum Line
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Line -> Line -> Line -> [Line]
$cenumFromThenTo :: Line -> Line -> Line -> [Line]
enumFromTo :: Line -> Line -> [Line]
$cenumFromTo :: Line -> Line -> [Line]
enumFromThen :: Line -> Line -> [Line]
$cenumFromThen :: Line -> Line -> [Line]
enumFrom :: Line -> [Line]
$cenumFrom :: Line -> [Line]
fromEnum :: Line -> Int
$cfromEnum :: Line -> Int
toEnum :: Int -> Line
$ctoEnum :: Int -> Line
pred :: Line -> Line
$cpred :: Line -> Line
succ :: Line -> Line
$csucc :: Line -> Line
Enum)
  deriving anyclass (Int -> Line -> Int
Line -> Int
(Int -> Line -> Int) -> (Line -> Int) -> Hashable Line
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Line -> Int
$chash :: Line -> Int
hashWithSalt :: Int -> Line -> Int
$chashWithSalt :: Int -> Line -> Int
Hashable, Line -> ()
(Line -> ()) -> NFData Line
forall a. (a -> ()) -> NFData a
rnf :: Line -> ()
$crnf :: Line -> ()
NFData, Get Line
[Line] -> Put
Line -> Put
(Line -> Put) -> Get Line -> ([Line] -> Put) -> Binary Line
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Line] -> Put
$cputList :: [Line] -> Put
get :: Get Line
$cget :: Get Line
put :: Line -> Put
$cput :: Line -> Put
Binary)

-- | A column number.
newtype Column = Column Word
  deriving stock (Column -> Column -> Bool
(Column -> Column -> Bool)
-> (Column -> Column -> Bool) -> Eq Column
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq, Eq Column
Eq Column =>
(Column -> Column -> Ordering)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Column)
-> (Column -> Column -> Column)
-> Ord Column
Column -> Column -> Bool
Column -> Column -> Ordering
Column -> Column -> Column
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Column -> Column -> Column
$cmin :: Column -> Column -> Column
max :: Column -> Column -> Column
$cmax :: Column -> Column -> Column
>= :: Column -> Column -> Bool
$c>= :: Column -> Column -> Bool
> :: Column -> Column -> Bool
$c> :: Column -> Column -> Bool
<= :: Column -> Column -> Bool
$c<= :: Column -> Column -> Bool
< :: Column -> Column -> Bool
$c< :: Column -> Column -> Bool
compare :: Column -> Column -> Ordering
$ccompare :: Column -> Column -> Ordering
$cp1Ord :: Eq Column
Ord, (forall x. Column -> Rep Column x)
-> (forall x. Rep Column x -> Column) -> Generic Column
forall x. Rep Column x -> Column
forall x. Column -> Rep Column x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Column x -> Column
$cfrom :: forall x. Column -> Rep Column x
Generic, Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show)
  deriving newtype ([Column] -> Encoding
[Column] -> Value
Column -> Encoding
Column -> Value
(Column -> Value)
-> (Column -> Encoding)
-> ([Column] -> Value)
-> ([Column] -> Encoding)
-> ToJSON Column
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Column] -> Encoding
$ctoEncodingList :: [Column] -> Encoding
toJSONList :: [Column] -> Value
$ctoJSONList :: [Column] -> Value
toEncoding :: Column -> Encoding
$ctoEncoding :: Column -> Encoding
toJSON :: Column -> Value
$ctoJSON :: Column -> Value
ToJSON, Value -> Parser [Column]
Value -> Parser Column
(Value -> Parser Column)
-> (Value -> Parser [Column]) -> FromJSON Column
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Column]
$cparseJSONList :: Value -> Parser [Column]
parseJSON :: Value -> Parser Column
$cparseJSON :: Value -> Parser Column
FromJSON, Int -> Column
Column -> Int
Column -> [Column]
Column -> Column
Column -> Column -> [Column]
Column -> Column -> Column -> [Column]
(Column -> Column)
-> (Column -> Column)
-> (Int -> Column)
-> (Column -> Int)
-> (Column -> [Column])
-> (Column -> Column -> [Column])
-> (Column -> Column -> [Column])
-> (Column -> Column -> Column -> [Column])
-> Enum Column
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Column -> Column -> Column -> [Column]
$cenumFromThenTo :: Column -> Column -> Column -> [Column]
enumFromTo :: Column -> Column -> [Column]
$cenumFromTo :: Column -> Column -> [Column]
enumFromThen :: Column -> Column -> [Column]
$cenumFromThen :: Column -> Column -> [Column]
enumFrom :: Column -> [Column]
$cenumFrom :: Column -> [Column]
fromEnum :: Column -> Int
$cfromEnum :: Column -> Int
toEnum :: Int -> Column
$ctoEnum :: Int -> Column
pred :: Column -> Column
$cpred :: Column -> Column
succ :: Column -> Column
$csucc :: Column -> Column
Enum)
  deriving anyclass (Int -> Column -> Int
Column -> Int
(Int -> Column -> Int) -> (Column -> Int) -> Hashable Column
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Column -> Int
$chash :: Column -> Int
hashWithSalt :: Int -> Column -> Int
$chashWithSalt :: Int -> Column -> Int
Hashable, Column -> ()
(Column -> ()) -> NFData Column
forall a. (a -> ()) -> NFData a
rnf :: Column -> ()
$crnf :: Column -> ()
NFData, Get Column
[Column] -> Put
Column -> Put
(Column -> Put) -> Get Column -> ([Column] -> Put) -> Binary Column
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Column] -> Put
$cputList :: [Column] -> Put
get :: Get Column
$cget :: Get Column
put :: Column -> Put
$cput :: Column -> Put
Binary)

-- | An offset into a 'Source', counted by UTF-8 codepoint.
newtype Offset = Offset Word
  deriving stock (Offset -> Offset -> Bool
(Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool) -> Eq Offset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offset -> Offset -> Bool
$c/= :: Offset -> Offset -> Bool
== :: Offset -> Offset -> Bool
$c== :: Offset -> Offset -> Bool
Eq, Int -> Offset -> ShowS
[Offset] -> ShowS
Offset -> String
(Int -> Offset -> ShowS)
-> (Offset -> String) -> ([Offset] -> ShowS) -> Show Offset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offset] -> ShowS
$cshowList :: [Offset] -> ShowS
show :: Offset -> String
$cshow :: Offset -> String
showsPrec :: Int -> Offset -> ShowS
$cshowsPrec :: Int -> Offset -> ShowS
Show, Eq Offset
Eq Offset =>
(Offset -> Offset -> Ordering)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Bool)
-> (Offset -> Offset -> Offset)
-> (Offset -> Offset -> Offset)
-> Ord Offset
Offset -> Offset -> Bool
Offset -> Offset -> Ordering
Offset -> Offset -> Offset
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Offset -> Offset -> Offset
$cmin :: Offset -> Offset -> Offset
max :: Offset -> Offset -> Offset
$cmax :: Offset -> Offset -> Offset
>= :: Offset -> Offset -> Bool
$c>= :: Offset -> Offset -> Bool
> :: Offset -> Offset -> Bool
$c> :: Offset -> Offset -> Bool
<= :: Offset -> Offset -> Bool
$c<= :: Offset -> Offset -> Bool
< :: Offset -> Offset -> Bool
$c< :: Offset -> Offset -> Bool
compare :: Offset -> Offset -> Ordering
$ccompare :: Offset -> Offset -> Ordering
$cp1Ord :: Eq Offset
Ord, (forall x. Offset -> Rep Offset x)
-> (forall x. Rep Offset x -> Offset) -> Generic Offset
forall x. Rep Offset x -> Offset
forall x. Offset -> Rep Offset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Offset x -> Offset
$cfrom :: forall x. Offset -> Rep Offset x
Generic)
  deriving newtype ([Offset] -> Encoding
[Offset] -> Value
Offset -> Encoding
Offset -> Value
(Offset -> Value)
-> (Offset -> Encoding)
-> ([Offset] -> Value)
-> ([Offset] -> Encoding)
-> ToJSON Offset
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Offset] -> Encoding
$ctoEncodingList :: [Offset] -> Encoding
toJSONList :: [Offset] -> Value
$ctoJSONList :: [Offset] -> Value
toEncoding :: Offset -> Encoding
$ctoEncoding :: Offset -> Encoding
toJSON :: Offset -> Value
$ctoJSON :: Offset -> Value
ToJSON, Value -> Parser [Offset]
Value -> Parser Offset
(Value -> Parser Offset)
-> (Value -> Parser [Offset]) -> FromJSON Offset
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Offset]
$cparseJSONList :: Value -> Parser [Offset]
parseJSON :: Value -> Parser Offset
$cparseJSON :: Value -> Parser Offset
FromJSON, Int -> Offset
Offset -> Int
Offset -> [Offset]
Offset -> Offset
Offset -> Offset -> [Offset]
Offset -> Offset -> Offset -> [Offset]
(Offset -> Offset)
-> (Offset -> Offset)
-> (Int -> Offset)
-> (Offset -> Int)
-> (Offset -> [Offset])
-> (Offset -> Offset -> [Offset])
-> (Offset -> Offset -> [Offset])
-> (Offset -> Offset -> Offset -> [Offset])
-> Enum Offset
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Offset -> Offset -> Offset -> [Offset]
$cenumFromThenTo :: Offset -> Offset -> Offset -> [Offset]
enumFromTo :: Offset -> Offset -> [Offset]
$cenumFromTo :: Offset -> Offset -> [Offset]
enumFromThen :: Offset -> Offset -> [Offset]
$cenumFromThen :: Offset -> Offset -> [Offset]
enumFrom :: Offset -> [Offset]
$cenumFrom :: Offset -> [Offset]
fromEnum :: Offset -> Int
$cfromEnum :: Offset -> Int
toEnum :: Int -> Offset
$ctoEnum :: Int -> Offset
pred :: Offset -> Offset
$cpred :: Offset -> Offset
succ :: Offset -> Offset
$csucc :: Offset -> Offset
Enum)
  deriving anyclass (Int -> Offset -> Int
Offset -> Int
(Int -> Offset -> Int) -> (Offset -> Int) -> Hashable Offset
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Offset -> Int
$chash :: Offset -> Int
hashWithSalt :: Int -> Offset -> Int
$chashWithSalt :: Int -> Offset -> Int
Hashable, Offset -> ()
(Offset -> ()) -> NFData Offset
forall a. (a -> ()) -> NFData a
rnf :: Offset -> ()
$crnf :: Offset -> ()
NFData, Get Offset
[Offset] -> Put
Offset -> Put
(Offset -> Put) -> Get Offset -> ([Offset] -> Put) -> Binary Offset
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Offset] -> Put
$cputList :: [Offset] -> Put
get :: Get Offset
$cget :: Get Offset
put :: Offset -> Put
$cput :: Offset -> Put
Binary)

newtype instance MVector s Offset = MV_Offset (MVector s Word)

instance VGM.MVector MVector Offset where
    basicLength :: MVector s Offset -> Int
basicLength (MV_Offset m) = MVector s Word -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.basicLength MVector s Word
m
    {-# INLINE basicLength #-}

    basicUnsafeSlice :: Int -> Int -> MVector s Offset -> MVector s Offset
basicUnsafeSlice ix :: Int
ix len :: Int
len (MV_Offset m) =
        MVector s Word -> MVector s Offset
forall s. MVector s Word -> MVector s Offset
MV_Offset (MVector s Word -> MVector s Offset)
-> MVector s Word -> MVector s Offset
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s Word -> MVector s Word
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.basicUnsafeSlice Int
ix Int
len MVector s Word
m
    {-# INLINE basicUnsafeSlice #-}

    basicOverlaps :: MVector s Offset -> MVector s Offset -> Bool
basicOverlaps (MV_Offset x) (MV_Offset y) = MVector s Word -> MVector s Word -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
VGM.basicOverlaps MVector s Word
x MVector s Word
y
    {-# INLINE basicOverlaps #-}

    basicUnsafeNew :: Int -> m (MVector (PrimState m) Offset)
basicUnsafeNew len :: Int
len = MVector (PrimState m) Word -> MVector (PrimState m) Offset
forall s. MVector s Word -> MVector s Offset
MV_Offset (MVector (PrimState m) Word -> MVector (PrimState m) Offset)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Offset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Word)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
VGM.basicUnsafeNew Int
len
    {-# INLINE basicUnsafeNew #-}

    basicInitialize :: MVector (PrimState m) Offset -> m ()
basicInitialize (MV_Offset v) = MVector (PrimState m) Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
VGM.basicInitialize MVector (PrimState m) Word
v
    {-# INLINE basicInitialize #-}

    basicUnsafeRead :: MVector (PrimState m) Offset -> Int -> m Offset
basicUnsafeRead (MV_Offset v) = (Word -> Offset) -> m Word -> m Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Offset
Offset (m Word -> m Offset) -> (Int -> m Word) -> Int -> m Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word -> Int -> m Word
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
VGM.basicUnsafeRead MVector (PrimState m) Word
v
    {-# INLINE basicUnsafeRead #-}

    basicUnsafeWrite :: MVector (PrimState m) Offset -> Int -> Offset -> m ()
basicUnsafeWrite (MV_Offset v) ix :: Int
ix (Offset w :: Word
w) = MVector (PrimState m) Word -> Int -> Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.basicUnsafeWrite MVector (PrimState m) Word
v Int
ix Word
w
    {-# INLINE basicUnsafeWrite #-}

newtype instance Vector Offset = V_Offset (Vector Word)

instance VG.Vector Vector Offset where
    basicUnsafeFreeze :: Mutable Vector (PrimState m) Offset -> m (Vector Offset)
basicUnsafeFreeze (MV_Offset v) = Vector Word -> Vector Offset
V_Offset (Vector Word -> Vector Offset)
-> m (Vector Word) -> m (Vector Offset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) Word -> m (Vector Word)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
VG.basicUnsafeFreeze MVector (PrimState m) Word
Mutable Vector (PrimState m) Word
v
    {-# INLINE basicUnsafeFreeze #-}

    basicUnsafeThaw :: Vector Offset -> m (Mutable Vector (PrimState m) Offset)
basicUnsafeThaw (V_Offset v) = MVector (PrimState m) Word -> MVector (PrimState m) Offset
forall s. MVector s Word -> MVector s Offset
MV_Offset (MVector (PrimState m) Word -> MVector (PrimState m) Offset)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Offset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word -> m (Mutable Vector (PrimState m) Word)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
VG.basicUnsafeThaw Vector Word
v
    {-# INLINE basicUnsafeThaw #-}

    basicLength :: Vector Offset -> Int
basicLength (V_Offset v) = Vector Word -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.basicLength Vector Word
v
    {-# INLINE basicLength #-}

    basicUnsafeSlice :: Int -> Int -> Vector Offset -> Vector Offset
basicUnsafeSlice ix :: Int
ix len :: Int
len (V_Offset v) =
        Vector Word -> Vector Offset
V_Offset (Vector Word -> Vector Offset) -> Vector Word -> Vector Offset
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Word -> Vector Word
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
VG.basicUnsafeSlice Int
ix Int
len Vector Word
v
    {-# INLINE basicUnsafeSlice #-}

    basicUnsafeIndexM :: Vector Offset -> Int -> m Offset
basicUnsafeIndexM (V_Offset v) ix :: Int
ix = Word -> Offset
Offset (Word -> Offset) -> m Word -> m Offset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word -> Int -> m Word
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
VG.basicUnsafeIndexM Vector Word
v Int
ix
    {-# INLINE basicUnsafeIndexM #-}

instance Unbox Offset where