{-# LANGUAGE StrictData #-}

{- |
Copyright: © 2019 James Alexander Feldman-Crough
License: MPL-2.0
-}
module ProSource.SparseLocation (SparseLocation (..)) where

import ProSource.Offset
import ProSource.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, Eq SparseLocation
Eq SparseLocation
-> (Int -> SparseLocation -> Int)
-> (SparseLocation -> Int)
-> Hashable SparseLocation
Int -> SparseLocation -> Int
SparseLocation -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SparseLocation -> Int
$chash :: SparseLocation -> Int
hashWithSalt :: Int -> SparseLocation -> Int
$chashWithSalt :: Int -> SparseLocation -> Int
$cp1Hashable :: Eq SparseLocation
Hashable)