{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}

-- | Strongly typed indices and offsets.
--
-- The goal of this module is to make it as easy as possible to keep track
-- of the various indexing schemes used by functions in the nvim API.
--
-- The core abstraction is the type 'Index' tagged with the sort of things it
-- is indexing (@Byte@, @CodePoint@, @Line@) and whether things are 0-indexed
-- or 1-indexed.
--
-- Two constructors and two destructors are provided: 'toZeroIndexed',
-- 'toOneIndexed', 'fromZeroIndexed', and 'fromOneIndexed'.  They should only
-- be used to make external API calls, to unwrap input indices and to wrap
-- output indices. The names of those functions are self-documenting, indicating
-- the indexing scheme used by every index that goes in and out of the external
-- API.
--
-- Within Cornelis, indices remain typed at all times, using dedicated functions
-- to convert between 0/1-indexing ('zeroIndex', 'oneIndex') and between
-- @Byte@ and @CodePoint@ indexing ('toByte', 'fromByte').
--
-- Usually, indices are relative to a common origin (beginning of the same buffer
-- or line), so it doesn't make sense to add them. There is a separate type of
-- 'Offset' which can be added to indices using the operator @('.+')@.
-- And @('.-.')@ gives the offset between two indices.
--
-- @
-- i :: Index 'Byte 'ZeroIndexed
-- i .+ Offset 42 :: Index 'Byte 'ZeroIndexed
-- @
--
-- Types of 'Pos'isitions (pairs of line and column indices) and 'Interval's
-- (pairs of positions or indices) are also provided, and should be used
-- as much as possible to reduce the likelihood of mixing up indices.
--
-- When talking about 'Pos', "(i,j)-indexed" means "i-indexed lines, j-indexed
-- columns".
--
-- Agda's indexing scheme (codepoints, (1,1)-indexed) is the preferred one
-- (0- vs 1-indexing is heavily checked, so it doesn't matter much which
-- we choose; codepoint indexing is preferred for manipulating unicode text
-- (fewer invalid states than byte indexing)).
--
-- A secondary indexing scheme is bytes, (0,0)-indexed, used as a unified
-- low-level representation right before talking to the nvim API.
module Cornelis.Offsets
  ( Index()
  , Indexing(..)
  , Unit(..)
  , Offset(..)
  , Pos(..)
  , Interval(..)
  , LineNumber
  , AgdaIndex
  , AgdaOffset
  , AgdaPos
  , AgdaInterval
  , VimIndex
  , VimOffset
  , VimPos
  , VimInterval
  , toZeroIndexed
  , toOneIndexed
  , fromZeroIndexed
  , fromOneIndexed
  , zeroIndex
  , oneIndex
  , incIndex
  , (.+)
  , (.-.)
  , offsetPlus
  , textToBytes
  , charToBytes
  , toBytes
  , fromBytes
  , containsPoint
  , addCol
  ) where

import           Data.Aeson (FromJSON)
import qualified Data.ByteString as BS
import           Data.Coerce (coerce)
import           Data.Monoid (Sum(..))
import qualified Data.Text as T
import           Data.Text.Encoding (encodeUtf8)
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)
import           GHC.Show (showSpace)
import           Prettyprinter (Pretty)
import qualified DiffLoc as D

-- | Indexing scheme: whether the first index is zero or one.
data Indexing = OneIndexed | ZeroIndexed

-- | What are we counting?
data Unit = Byte | CodePoint | Line

-- | The constructor is hidden, use 'toZeroIndexed' and 'toOneIndexed' to construct it,
-- and 'fromZeroIndexed' and 'fromOneIndexed' to destruct it.
newtype Index (e :: Unit) (i :: Indexing) = Index Int
  deriving newtype (Index e i -> Index e i -> Bool
(Index e i -> Index e i -> Bool)
-> (Index e i -> Index e i -> Bool) -> Eq (Index e i)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
$c== :: forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
== :: Index e i -> Index e i -> Bool
$c/= :: forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
/= :: Index e i -> Index e i -> Bool
Eq, Eq (Index e i)
Eq (Index e i) =>
(Index e i -> Index e i -> Ordering)
-> (Index e i -> Index e i -> Bool)
-> (Index e i -> Index e i -> Bool)
-> (Index e i -> Index e i -> Bool)
-> (Index e i -> Index e i -> Bool)
-> (Index e i -> Index e i -> Index e i)
-> (Index e i -> Index e i -> Index e i)
-> Ord (Index e i)
Index e i -> Index e i -> Bool
Index e i -> Index e i -> Ordering
Index e i -> Index e i -> Index e i
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
forall (e :: Unit) (i :: Indexing). Eq (Index e i)
forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
forall (e :: Unit) (i :: Indexing).
Index e i -> Index e i -> Ordering
forall (e :: Unit) (i :: Indexing).
Index e i -> Index e i -> Index e i
$ccompare :: forall (e :: Unit) (i :: Indexing).
Index e i -> Index e i -> Ordering
compare :: Index e i -> Index e i -> Ordering
$c< :: forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
< :: Index e i -> Index e i -> Bool
$c<= :: forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
<= :: Index e i -> Index e i -> Bool
$c> :: forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
> :: Index e i -> Index e i -> Bool
$c>= :: forall (e :: Unit) (i :: Indexing). Index e i -> Index e i -> Bool
>= :: Index e i -> Index e i -> Bool
$cmax :: forall (e :: Unit) (i :: Indexing).
Index e i -> Index e i -> Index e i
max :: Index e i -> Index e i -> Index e i
$cmin :: forall (e :: Unit) (i :: Indexing).
Index e i -> Index e i -> Index e i
min :: Index e i -> Index e i -> Index e i
Ord, Int -> Index e i -> ShowS
[Index e i] -> ShowS
Index e i -> String
(Int -> Index e i -> ShowS)
-> (Index e i -> String)
-> ([Index e i] -> ShowS)
-> Show (Index e i)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (e :: Unit) (i :: Indexing). Int -> Index e i -> ShowS
forall (e :: Unit) (i :: Indexing). [Index e i] -> ShowS
forall (e :: Unit) (i :: Indexing). Index e i -> String
$cshowsPrec :: forall (e :: Unit) (i :: Indexing). Int -> Index e i -> ShowS
showsPrec :: Int -> Index e i -> ShowS
$cshow :: forall (e :: Unit) (i :: Indexing). Index e i -> String
show :: Index e i -> String
$cshowList :: forall (e :: Unit) (i :: Indexing). [Index e i] -> ShowS
showList :: [Index e i] -> ShowS
Show, ReadPrec [Index e i]
ReadPrec (Index e i)
Int -> ReadS (Index e i)
ReadS [Index e i]
(Int -> ReadS (Index e i))
-> ReadS [Index e i]
-> ReadPrec (Index e i)
-> ReadPrec [Index e i]
-> Read (Index e i)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (e :: Unit) (i :: Indexing). ReadPrec [Index e i]
forall (e :: Unit) (i :: Indexing). ReadPrec (Index e i)
forall (e :: Unit) (i :: Indexing). Int -> ReadS (Index e i)
forall (e :: Unit) (i :: Indexing). ReadS [Index e i]
$creadsPrec :: forall (e :: Unit) (i :: Indexing). Int -> ReadS (Index e i)
readsPrec :: Int -> ReadS (Index e i)
$creadList :: forall (e :: Unit) (i :: Indexing). ReadS [Index e i]
readList :: ReadS [Index e i]
$creadPrec :: forall (e :: Unit) (i :: Indexing). ReadPrec (Index e i)
readPrec :: ReadPrec (Index e i)
$creadListPrec :: forall (e :: Unit) (i :: Indexing). ReadPrec [Index e i]
readListPrec :: ReadPrec [Index e i]
Read, Maybe (Index e i)
Value -> Parser [Index e i]
Value -> Parser (Index e i)
(Value -> Parser (Index e i))
-> (Value -> Parser [Index e i])
-> Maybe (Index e i)
-> FromJSON (Index e i)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
forall (e :: Unit) (i :: Indexing). Maybe (Index e i)
forall (e :: Unit) (i :: Indexing). Value -> Parser [Index e i]
forall (e :: Unit) (i :: Indexing). Value -> Parser (Index e i)
$cparseJSON :: forall (e :: Unit) (i :: Indexing). Value -> Parser (Index e i)
parseJSON :: Value -> Parser (Index e i)
$cparseJSONList :: forall (e :: Unit) (i :: Indexing). Value -> Parser [Index e i]
parseJSONList :: Value -> Parser [Index e i]
$comittedField :: forall (e :: Unit) (i :: Indexing). Maybe (Index e i)
omittedField :: Maybe (Index e i)
FromJSON, (forall ann. Index e i -> Doc ann)
-> (forall ann. [Index e i] -> Doc ann) -> Pretty (Index e i)
forall ann. [Index e i] -> Doc ann
forall ann. Index e i -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
forall (e :: Unit) (i :: Indexing) ann. [Index e i] -> Doc ann
forall (e :: Unit) (i :: Indexing) ann. Index e i -> Doc ann
$cpretty :: forall (e :: Unit) (i :: Indexing) ann. Index e i -> Doc ann
pretty :: forall ann. Index e i -> Doc ann
$cprettyList :: forall (e :: Unit) (i :: Indexing) ann. [Index e i] -> Doc ann
prettyList :: forall ann. [Index e i] -> Doc ann
Pretty)

type role Index nominal nominal

-- | It doesn't seem worth the trouble to hide this constructor.
newtype Offset (e :: Unit) = Offset Int
  deriving newtype (Offset e -> Offset e -> Bool
(Offset e -> Offset e -> Bool)
-> (Offset e -> Offset e -> Bool) -> Eq (Offset e)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (e :: Unit). Offset e -> Offset e -> Bool
$c== :: forall (e :: Unit). Offset e -> Offset e -> Bool
== :: Offset e -> Offset e -> Bool
$c/= :: forall (e :: Unit). Offset e -> Offset e -> Bool
/= :: Offset e -> Offset e -> Bool
Eq, Eq (Offset e)
Eq (Offset e) =>
(Offset e -> Offset e -> Ordering)
-> (Offset e -> Offset e -> Bool)
-> (Offset e -> Offset e -> Bool)
-> (Offset e -> Offset e -> Bool)
-> (Offset e -> Offset e -> Bool)
-> (Offset e -> Offset e -> Offset e)
-> (Offset e -> Offset e -> Offset e)
-> Ord (Offset e)
Offset e -> Offset e -> Bool
Offset e -> Offset e -> Ordering
Offset e -> Offset e -> Offset e
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
forall (e :: Unit). Eq (Offset e)
forall (e :: Unit). Offset e -> Offset e -> Bool
forall (e :: Unit). Offset e -> Offset e -> Ordering
forall (e :: Unit). Offset e -> Offset e -> Offset e
$ccompare :: forall (e :: Unit). Offset e -> Offset e -> Ordering
compare :: Offset e -> Offset e -> Ordering
$c< :: forall (e :: Unit). Offset e -> Offset e -> Bool
< :: Offset e -> Offset e -> Bool
$c<= :: forall (e :: Unit). Offset e -> Offset e -> Bool
<= :: Offset e -> Offset e -> Bool
$c> :: forall (e :: Unit). Offset e -> Offset e -> Bool
> :: Offset e -> Offset e -> Bool
$c>= :: forall (e :: Unit). Offset e -> Offset e -> Bool
>= :: Offset e -> Offset e -> Bool
$cmax :: forall (e :: Unit). Offset e -> Offset e -> Offset e
max :: Offset e -> Offset e -> Offset e
$cmin :: forall (e :: Unit). Offset e -> Offset e -> Offset e
min :: Offset e -> Offset e -> Offset e
Ord, Int -> Offset e -> ShowS
[Offset e] -> ShowS
Offset e -> String
(Int -> Offset e -> ShowS)
-> (Offset e -> String) -> ([Offset e] -> ShowS) -> Show (Offset e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (e :: Unit). Int -> Offset e -> ShowS
forall (e :: Unit). [Offset e] -> ShowS
forall (e :: Unit). Offset e -> String
$cshowsPrec :: forall (e :: Unit). Int -> Offset e -> ShowS
showsPrec :: Int -> Offset e -> ShowS
$cshow :: forall (e :: Unit). Offset e -> String
show :: Offset e -> String
$cshowList :: forall (e :: Unit). [Offset e] -> ShowS
showList :: [Offset e] -> ShowS
Show, ReadPrec [Offset e]
ReadPrec (Offset e)
Int -> ReadS (Offset e)
ReadS [Offset e]
(Int -> ReadS (Offset e))
-> ReadS [Offset e]
-> ReadPrec (Offset e)
-> ReadPrec [Offset e]
-> Read (Offset e)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (e :: Unit). ReadPrec [Offset e]
forall (e :: Unit). ReadPrec (Offset e)
forall (e :: Unit). Int -> ReadS (Offset e)
forall (e :: Unit). ReadS [Offset e]
$creadsPrec :: forall (e :: Unit). Int -> ReadS (Offset e)
readsPrec :: Int -> ReadS (Offset e)
$creadList :: forall (e :: Unit). ReadS [Offset e]
readList :: ReadS [Offset e]
$creadPrec :: forall (e :: Unit). ReadPrec (Offset e)
readPrec :: ReadPrec (Offset e)
$creadListPrec :: forall (e :: Unit). ReadPrec [Offset e]
readListPrec :: ReadPrec [Offset e]
Read, Maybe (Offset e)
Value -> Parser [Offset e]
Value -> Parser (Offset e)
(Value -> Parser (Offset e))
-> (Value -> Parser [Offset e])
-> Maybe (Offset e)
-> FromJSON (Offset e)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
forall (e :: Unit). Maybe (Offset e)
forall (e :: Unit). Value -> Parser [Offset e]
forall (e :: Unit). Value -> Parser (Offset e)
$cparseJSON :: forall (e :: Unit). Value -> Parser (Offset e)
parseJSON :: Value -> Parser (Offset e)
$cparseJSONList :: forall (e :: Unit). Value -> Parser [Offset e]
parseJSONList :: Value -> Parser [Offset e]
$comittedField :: forall (e :: Unit). Maybe (Offset e)
omittedField :: Maybe (Offset e)
FromJSON, (forall ann. Offset e -> Doc ann)
-> (forall ann. [Offset e] -> Doc ann) -> Pretty (Offset e)
forall ann. [Offset e] -> Doc ann
forall ann. Offset e -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
forall (e :: Unit) ann. [Offset e] -> Doc ann
forall (e :: Unit) ann. Offset e -> Doc ann
$cpretty :: forall (e :: Unit) ann. Offset e -> Doc ann
pretty :: forall ann. Offset e -> Doc ann
$cprettyList :: forall (e :: Unit) ann. [Offset e] -> Doc ann
prettyList :: forall ann. [Offset e] -> Doc ann
Pretty)
  deriving (NonEmpty (Offset e) -> Offset e
Offset e -> Offset e -> Offset e
(Offset e -> Offset e -> Offset e)
-> (NonEmpty (Offset e) -> Offset e)
-> (forall b. Integral b => b -> Offset e -> Offset e)
-> Semigroup (Offset e)
forall b. Integral b => b -> Offset e -> Offset e
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (e :: Unit). NonEmpty (Offset e) -> Offset e
forall (e :: Unit). Offset e -> Offset e -> Offset e
forall (e :: Unit) b. Integral b => b -> Offset e -> Offset e
$c<> :: forall (e :: Unit). Offset e -> Offset e -> Offset e
<> :: Offset e -> Offset e -> Offset e
$csconcat :: forall (e :: Unit). NonEmpty (Offset e) -> Offset e
sconcat :: NonEmpty (Offset e) -> Offset e
$cstimes :: forall (e :: Unit) b. Integral b => b -> Offset e -> Offset e
stimes :: forall b. Integral b => b -> Offset e -> Offset e
Semigroup, Semigroup (Offset e)
Offset e
Semigroup (Offset e) =>
Offset e
-> (Offset e -> Offset e -> Offset e)
-> ([Offset e] -> Offset e)
-> Monoid (Offset e)
[Offset e] -> Offset e
Offset e -> Offset e -> Offset e
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (e :: Unit). Semigroup (Offset e)
forall (e :: Unit). Offset e
forall (e :: Unit). [Offset e] -> Offset e
forall (e :: Unit). Offset e -> Offset e -> Offset e
$cmempty :: forall (e :: Unit). Offset e
mempty :: Offset e
$cmappend :: forall (e :: Unit). Offset e -> Offset e -> Offset e
mappend :: Offset e -> Offset e -> Offset e
$cmconcat :: forall (e :: Unit). [Offset e] -> Offset e
mconcat :: [Offset e] -> Offset e
Monoid) via Sum Int

type role Offset nominal

-- | Position in a text file as line-column numbers. This type is indexed by
-- the units of the columns (@Byte@ or @CodePoint@) and by the indexing scheme
-- of lines and columns.
data Pos e i j = Pos
  { forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Index 'Line i
p_line :: Index 'Line i
  , forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Index e j
p_col :: Index e j
  } deriving (Pos e i j -> Pos e i j -> Bool
(Pos e i j -> Pos e i j -> Bool)
-> (Pos e i j -> Pos e i j -> Bool) -> Eq (Pos e i j)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
$c== :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
== :: Pos e i j -> Pos e i j -> Bool
$c/= :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
/= :: Pos e i j -> Pos e i j -> Bool
Eq, Eq (Pos e i j)
Eq (Pos e i j) =>
(Pos e i j -> Pos e i j -> Ordering)
-> (Pos e i j -> Pos e i j -> Bool)
-> (Pos e i j -> Pos e i j -> Bool)
-> (Pos e i j -> Pos e i j -> Bool)
-> (Pos e i j -> Pos e i j -> Bool)
-> (Pos e i j -> Pos e i j -> Pos e i j)
-> (Pos e i j -> Pos e i j -> Pos e i j)
-> Ord (Pos e i j)
Pos e i j -> Pos e i j -> Bool
Pos e i j -> Pos e i j -> Ordering
Pos e i j -> Pos e i j -> Pos e i j
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
forall (e :: Unit) (i :: Indexing) (j :: Indexing). Eq (Pos e i j)
forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Ordering
forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Pos e i j
$ccompare :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Ordering
compare :: Pos e i j -> Pos e i j -> Ordering
$c< :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
< :: Pos e i j -> Pos e i j -> Bool
$c<= :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
<= :: Pos e i j -> Pos e i j -> Bool
$c> :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
> :: Pos e i j -> Pos e i j -> Bool
$c>= :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Bool
>= :: Pos e i j -> Pos e i j -> Bool
$cmax :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Pos e i j
max :: Pos e i j -> Pos e i j -> Pos e i j
$cmin :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Pos e i j -> Pos e i j
min :: Pos e i j -> Pos e i j -> Pos e i j
Ord, (forall x. Pos e i j -> Rep (Pos e i j) x)
-> (forall x. Rep (Pos e i j) x -> Pos e i j)
-> Generic (Pos e i j)
forall x. Rep (Pos e i j) x -> Pos e i j
forall x. Pos e i j -> Rep (Pos e i j) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (e :: Unit) (i :: Indexing) (j :: Indexing) x.
Rep (Pos e i j) x -> Pos e i j
forall (e :: Unit) (i :: Indexing) (j :: Indexing) x.
Pos e i j -> Rep (Pos e i j) x
$cfrom :: forall (e :: Unit) (i :: Indexing) (j :: Indexing) x.
Pos e i j -> Rep (Pos e i j) x
from :: forall x. Pos e i j -> Rep (Pos e i j) x
$cto :: forall (e :: Unit) (i :: Indexing) (j :: Indexing) x.
Rep (Pos e i j) x -> Pos e i j
to :: forall x. Rep (Pos e i j) x -> Pos e i j
Generic)

instance Show (Pos e i j) where
  showsPrec :: Int -> Pos e i j -> ShowS
showsPrec Int
n (Pos Index 'Line i
l Index e j
c) =
    Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Pn () 0 " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Index 'Line i -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Index 'Line i
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Index e j -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Index e j
c

data Interval p = Interval { forall p. Interval p -> p
iStart, forall p. Interval p -> p
iEnd :: !p }
  deriving (Interval p -> Interval p -> Bool
(Interval p -> Interval p -> Bool)
-> (Interval p -> Interval p -> Bool) -> Eq (Interval p)
forall p. Eq p => Interval p -> Interval p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. Eq p => Interval p -> Interval p -> Bool
== :: Interval p -> Interval p -> Bool
$c/= :: forall p. Eq p => Interval p -> Interval p -> Bool
/= :: Interval p -> Interval p -> Bool
Eq, Eq (Interval p)
Eq (Interval p) =>
(Interval p -> Interval p -> Ordering)
-> (Interval p -> Interval p -> Bool)
-> (Interval p -> Interval p -> Bool)
-> (Interval p -> Interval p -> Bool)
-> (Interval p -> Interval p -> Bool)
-> (Interval p -> Interval p -> Interval p)
-> (Interval p -> Interval p -> Interval p)
-> Ord (Interval p)
Interval p -> Interval p -> Bool
Interval p -> Interval p -> Ordering
Interval p -> Interval p -> Interval p
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
forall p. Ord p => Eq (Interval p)
forall p. Ord p => Interval p -> Interval p -> Bool
forall p. Ord p => Interval p -> Interval p -> Ordering
forall p. Ord p => Interval p -> Interval p -> Interval p
$ccompare :: forall p. Ord p => Interval p -> Interval p -> Ordering
compare :: Interval p -> Interval p -> Ordering
$c< :: forall p. Ord p => Interval p -> Interval p -> Bool
< :: Interval p -> Interval p -> Bool
$c<= :: forall p. Ord p => Interval p -> Interval p -> Bool
<= :: Interval p -> Interval p -> Bool
$c> :: forall p. Ord p => Interval p -> Interval p -> Bool
> :: Interval p -> Interval p -> Bool
$c>= :: forall p. Ord p => Interval p -> Interval p -> Bool
>= :: Interval p -> Interval p -> Bool
$cmax :: forall p. Ord p => Interval p -> Interval p -> Interval p
max :: Interval p -> Interval p -> Interval p
$cmin :: forall p. Ord p => Interval p -> Interval p -> Interval p
min :: Interval p -> Interval p -> Interval p
Ord, (forall a b. (a -> b) -> Interval a -> Interval b)
-> (forall a b. a -> Interval b -> Interval a) -> Functor Interval
forall a b. a -> Interval b -> Interval a
forall a b. (a -> b) -> Interval a -> Interval b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Interval a -> Interval b
fmap :: forall a b. (a -> b) -> Interval a -> Interval b
$c<$ :: forall a b. a -> Interval b -> Interval a
<$ :: forall a b. a -> Interval b -> Interval a
Functor, (forall m. Monoid m => Interval m -> m)
-> (forall m a. Monoid m => (a -> m) -> Interval a -> m)
-> (forall m a. Monoid m => (a -> m) -> Interval a -> m)
-> (forall a b. (a -> b -> b) -> b -> Interval a -> b)
-> (forall a b. (a -> b -> b) -> b -> Interval a -> b)
-> (forall b a. (b -> a -> b) -> b -> Interval a -> b)
-> (forall b a. (b -> a -> b) -> b -> Interval a -> b)
-> (forall a. (a -> a -> a) -> Interval a -> a)
-> (forall a. (a -> a -> a) -> Interval a -> a)
-> (forall a. Interval a -> [a])
-> (forall a. Interval a -> Bool)
-> (forall a. Interval a -> Int)
-> (forall a. Eq a => a -> Interval a -> Bool)
-> (forall a. Ord a => Interval a -> a)
-> (forall a. Ord a => Interval a -> a)
-> (forall a. Num a => Interval a -> a)
-> (forall a. Num a => Interval a -> a)
-> Foldable Interval
forall a. Eq a => a -> Interval a -> Bool
forall a. Num a => Interval a -> a
forall a. Ord a => Interval a -> a
forall m. Monoid m => Interval m -> m
forall a. Interval a -> Bool
forall a. Interval a -> Int
forall a. Interval a -> [a]
forall a. (a -> a -> a) -> Interval a -> a
forall m a. Monoid m => (a -> m) -> Interval a -> m
forall b a. (b -> a -> b) -> b -> Interval a -> b
forall a b. (a -> b -> b) -> b -> Interval a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Interval m -> m
fold :: forall m. Monoid m => Interval m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Interval a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Interval a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Interval a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Interval a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Interval a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Interval a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Interval a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Interval a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Interval a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Interval a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Interval a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Interval a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Interval a -> a
foldr1 :: forall a. (a -> a -> a) -> Interval a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Interval a -> a
foldl1 :: forall a. (a -> a -> a) -> Interval a -> a
$ctoList :: forall a. Interval a -> [a]
toList :: forall a. Interval a -> [a]
$cnull :: forall a. Interval a -> Bool
null :: forall a. Interval a -> Bool
$clength :: forall a. Interval a -> Int
length :: forall a. Interval a -> Int
$celem :: forall a. Eq a => a -> Interval a -> Bool
elem :: forall a. Eq a => a -> Interval a -> Bool
$cmaximum :: forall a. Ord a => Interval a -> a
maximum :: forall a. Ord a => Interval a -> a
$cminimum :: forall a. Ord a => Interval a -> a
minimum :: forall a. Ord a => Interval a -> a
$csum :: forall a. Num a => Interval a -> a
sum :: forall a. Num a => Interval a -> a
$cproduct :: forall a. Num a => Interval a -> a
product :: forall a. Num a => Interval a -> a
Foldable, Functor Interval
Foldable Interval
(Functor Interval, Foldable Interval) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Interval a -> f (Interval b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Interval (f a) -> f (Interval a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Interval a -> m (Interval b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Interval (m a) -> m (Interval a))
-> Traversable Interval
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Interval (m a) -> m (Interval a)
forall (f :: * -> *) a.
Applicative f =>
Interval (f a) -> f (Interval a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Interval a -> m (Interval b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Interval a -> f (Interval b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Interval a -> f (Interval b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Interval a -> f (Interval b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Interval (f a) -> f (Interval a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Interval (f a) -> f (Interval a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Interval a -> m (Interval b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Interval a -> m (Interval b)
$csequence :: forall (m :: * -> *) a. Monad m => Interval (m a) -> m (Interval a)
sequence :: forall (m :: * -> *) a. Monad m => Interval (m a) -> m (Interval a)
Traversable, (forall x. Interval p -> Rep (Interval p) x)
-> (forall x. Rep (Interval p) x -> Interval p)
-> Generic (Interval p)
forall x. Rep (Interval p) x -> Interval p
forall x. Interval p -> Rep (Interval p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (Interval p) x -> Interval p
forall p x. Interval p -> Rep (Interval p) x
$cfrom :: forall p x. Interval p -> Rep (Interval p) x
from :: forall x. Interval p -> Rep (Interval p) x
$cto :: forall p x. Rep (Interval p) x -> Interval p
to :: forall x. Rep (Interval p) x -> Interval p
Generic)

instance Show p => Show (Interval p) where
  showsPrec :: Int -> Interval p -> ShowS
showsPrec Int
n (Interval p
s p
e) =
    Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Interval " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> p -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 p
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> p -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 p
e

-- Common specializations

type LineNumber = Index 'Line

type AgdaIndex = Index 'CodePoint 'OneIndexed
type AgdaOffset = Offset 'CodePoint
type AgdaPos = Pos 'CodePoint 'OneIndexed 'OneIndexed
type AgdaInterval = Interval AgdaPos

type VimIndex = Index 'Byte 'ZeroIndexed
type VimOffset = Offset 'Byte
type VimPos = Pos 'Byte 'ZeroIndexed 'ZeroIndexed
type VimInterval = Interval VimPos

-- To pass indices to and from external sources.

-- | Mark a raw index as zero-indexed.
toZeroIndexed :: Integral a => a -> Index e 'ZeroIndexed
toZeroIndexed :: forall a (e :: Unit). Integral a => a -> Index e 'ZeroIndexed
toZeroIndexed a
a = Int -> Index e 'ZeroIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a)

-- | Mark a raw index as one-indexed.
toOneIndexed :: Integral a => a -> Index e 'OneIndexed
toOneIndexed :: forall a (e :: Unit). Integral a => a -> Index e 'OneIndexed
toOneIndexed a
a = Int -> Index e 'OneIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a)

-- | Unwrap a raw zero-indexed index.
fromZeroIndexed :: Num a => Index e 'ZeroIndexed -> a
fromZeroIndexed :: forall a (e :: Unit). Num a => Index e 'ZeroIndexed -> a
fromZeroIndexed (Index Int
a) = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a

-- | Unwrap a raw zero-indexed index.
fromOneIndexed :: Num a => Index e 'OneIndexed -> a
fromOneIndexed :: forall a (e :: Unit). Num a => Index e 'OneIndexed -> a
fromOneIndexed (Index Int
a) = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a

-- | Convert from one- to zero-indexed.
zeroIndex :: Index e 'OneIndexed -> Index e 'ZeroIndexed
zeroIndex :: forall (e :: Unit). Index e 'OneIndexed -> Index e 'ZeroIndexed
zeroIndex (Index Int
i) = Int -> Index e 'ZeroIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | Convert from zero- to one-indexed.
oneIndex :: Index e 'ZeroIndexed -> Index e 'OneIndexed
oneIndex :: forall (e :: Unit). Index e 'ZeroIndexed -> Index e 'OneIndexed
oneIndex (Index Int
i) = Int -> Index e 'OneIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Increment index.
incIndex :: Index e i -> Index e i
incIndex :: forall (e :: Unit) (i :: Indexing). Index e i -> Index e i
incIndex (Index Int
i) = Int -> Index e i
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Add an offset to an index.
(.+) :: Index e i -> Offset e -> Index e i
Index Int
i .+ :: forall (e :: Unit) (i :: Indexing).
Index e i -> Offset e -> Index e i
.+ Offset Int
n = Int -> Index e i
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

(.-.) :: Index e i -> Index e i -> Offset e
Index Int
i .-. :: forall (e :: Unit) (i :: Indexing).
Index e i -> Index e i -> Offset e
.-. Index Int
j = Int -> Offset e
forall (e :: Unit). Int -> Offset e
Offset (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j)

--

offsetPlus :: Offset a -> Offset a -> Offset a
offsetPlus :: forall (e :: Unit). Offset e -> Offset e -> Offset e
offsetPlus = (Int -> Int -> Int) -> Offset a -> Offset a -> Offset a
forall a b. Coercible a b => a -> b
coerce ((Int -> Int -> Int) -> Offset a -> Offset a -> Offset a)
-> (Int -> Int -> Int) -> Offset a -> Offset a -> Offset a
forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a -> a
(+) @Int

--

containsPoint :: Ord p => Interval p -> p -> Bool
containsPoint :: forall p. Ord p => Interval p -> p -> Bool
containsPoint (Interval p
s p
e) p
p = p
s p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
p Bool -> Bool -> Bool
&& p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
< p
e

-- | Number of bytes in a 'T.Text'.
textToBytes :: T.Text -> Int
textToBytes :: Text -> Int
textToBytes Text
t = ByteString -> Int
BS.length (Text -> ByteString
encodeUtf8 Text
t)

-- | Number of bytes in a 'Char'.
charToBytes :: Char -> Int
charToBytes :: Char -> Int
charToBytes Char
c = Text -> Int
textToBytes (Char -> Text
T.singleton Char
c)

------------------------------------------------------------------------------
-- | Convert a character-based index into a byte-indexed one
toBytes :: T.Text -> Index 'CodePoint 'ZeroIndexed -> Index 'Byte 'ZeroIndexed
toBytes :: Text -> Index 'CodePoint 'ZeroIndexed -> Index 'Byte 'ZeroIndexed
toBytes Text
s (Index Int
i) = Int -> Index 'Byte 'ZeroIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (Int -> Index 'Byte 'ZeroIndexed)
-> Int -> Index 'Byte 'ZeroIndexed
forall a b. (a -> b) -> a -> b
$ Text -> Int
textToBytes (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) Text
s

------------------------------------------------------------------------------
-- | Convert a byte-based index into a character-indexed one.
fromBytes :: HasCallStack => T.Text -> Index 'Byte 'ZeroIndexed -> Index 'CodePoint 'ZeroIndexed
fromBytes :: HasCallStack =>
Text -> Index 'Byte 'ZeroIndexed -> Index 'CodePoint 'ZeroIndexed
fromBytes Text
t (Index Int
i) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Index 'CodePoint 'ZeroIndexed
forall a. HasCallStack => String -> a
error (String -> Index 'CodePoint 'ZeroIndexed)
-> String -> Index 'CodePoint 'ZeroIndexed
forall a b. (a -> b) -> a -> b
$ String
"from bytes underflow" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text, Int) -> String
forall a. Show a => a -> String
show (Text
t, Int
i)
fromBytes Text
_ (Index Int
0) = Int -> Index 'CodePoint 'ZeroIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index Int
0
fromBytes Text
t (Index Int
i) | Just (Char
c, Text
str) <- Text -> Maybe (Char, Text)
T.uncons Text
t =
  let diff :: Int
diff = ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
c
   in case Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
diff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 of
        Bool
True -> Int -> Index 'CodePoint 'ZeroIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (Int -> Index 'CodePoint 'ZeroIndexed)
-> Int -> Index 'CodePoint 'ZeroIndexed
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Index 'CodePoint 'ZeroIndexed -> Int
forall a b. Coercible a b => a -> b
coerce (HasCallStack =>
Text -> Index 'Byte 'ZeroIndexed -> Index 'CodePoint 'ZeroIndexed
Text -> Index 'Byte 'ZeroIndexed -> Index 'CodePoint 'ZeroIndexed
fromBytes Text
str (Int -> Index 'Byte 'ZeroIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
diff)))
        -- We ran out of bytes in the middle of a multibyte character. Just
        -- return the one we're on, and don't underflow!
        Bool
False -> Int -> Index 'CodePoint 'ZeroIndexed
forall (e :: Unit) (i :: Indexing). Int -> Index e i
Index Int
0
fromBytes Text
t Index 'Byte 'ZeroIndexed
i = String -> Index 'CodePoint 'ZeroIndexed
forall a. HasCallStack => String -> a
error (String -> Index 'CodePoint 'ZeroIndexed)
-> String -> Index 'CodePoint 'ZeroIndexed
forall a b. (a -> b) -> a -> b
$ String
"missing bytes: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text, Index 'Byte 'ZeroIndexed) -> String
forall a. Show a => a -> String
show (Text
t, Index 'Byte 'ZeroIndexed
i)

addCol :: Pos e i j -> Offset e -> Pos e i j
addCol :: forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Pos e i j -> Offset e -> Pos e i j
addCol (Pos Index 'Line i
l Index e j
c) Offset e
dc = Index 'Line i -> Index e j -> Pos e i j
forall (e :: Unit) (i :: Indexing) (j :: Indexing).
Index 'Line i -> Index e j -> Pos e i j
Pos Index 'Line i
l (Index e j
c Index e j -> Offset e -> Index e j
forall (e :: Unit) (i :: Indexing).
Index e i -> Offset e -> Index e i
.+ Offset e
dc)

-- | Ordered monoid action of offsets on indices.
instance D.Amor (Index e i) where
  type Trans (Index e i) = Offset e
  .+ :: Index e i -> Trans (Index e i) -> Index e i
(.+) = Index e i -> Trans (Index e i) -> Index e i
Index e i -> Offset e -> Index e i
forall (e :: Unit) (i :: Indexing).
Index e i -> Offset e -> Index e i
(Cornelis.Offsets..+)
  Index e i
i .-.? :: Index e i -> Index e i -> Maybe (Trans (Index e i))
.-.? Index e i
j | Index e i
i Index e i -> Index e i -> Bool
forall a. Ord a => a -> a -> Bool
>= Index e i
j = Offset e -> Maybe (Offset e)
forall a. a -> Maybe a
Just (Index e i
i Index e i -> Index e i -> Offset e
forall (e :: Unit) (i :: Indexing).
Index e i -> Index e i -> Offset e
.-. Index e i
j)
           | Bool
otherwise = Maybe (Trans (Index e i))
Maybe (Offset e)
forall a. Maybe a
Nothing

-- | The zero in zero-indexing.
instance D.Origin (Index e 'ZeroIndexed) where
  origin :: Index e 'ZeroIndexed
origin = Int -> Index e 'ZeroIndexed
forall a (e :: Unit). Integral a => a -> Index e 'ZeroIndexed
toZeroIndexed (Int
0 :: Int)