module Data.Loc.Loc
  ( Loc,

    -- * Constructing
    loc,
    origin,

    -- * Querying
    line,
    column,

    -- * Show and Read
    locShowsPrec,
    locReadPrec,
  )
where

import Data.Loc.Internal.Prelude
import Data.Loc.Pos (Column, Line)
import Integer.Positive (Positive)

-- | Stands for /location/, consists of a 'Line' and a 'Column'
--
-- You can think of a 'Loc' like a caret position in a text editor.
-- Following the normal convention for text editors and such, line
-- and column numbers start with 1.
data Loc = Loc
  { Loc -> Line
line :: Line,
    Loc -> Column
column :: Column
  }
  deriving (Loc -> Loc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c== :: Loc -> Loc -> Bool
Eq, Eq Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
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 :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmax :: Loc -> Loc -> Loc
>= :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c< :: Loc -> Loc -> Bool
compare :: Loc -> Loc -> Ordering
$ccompare :: Loc -> Loc -> Ordering
Ord)

-- | 'showsPrec' = 'locShowsPrec'
instance Show Loc where
  showsPrec :: Int -> Loc -> ShowS
showsPrec = Int -> Loc -> ShowS
locShowsPrec

-- | 'readPrec' = 'locReadPrec'
instance Read Loc where
  readPrec :: ReadPrec Loc
readPrec = ReadPrec Loc
locReadPrec

-- |
--
-- >>> locShowsPrec minPrec (loc 3 14) ""
-- "3:14"
locShowsPrec :: Int -> Loc -> ShowS
locShowsPrec :: Int -> Loc -> ShowS
locShowsPrec Int
_ (Loc Line
l Column
c) =
  forall a. Show a => a -> ShowS
shows Line
l
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
":"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Column
c

-- |
--
-- >>> readPrec_to_S locReadPrec minPrec "3:14"
-- [(3:14,"")]
locReadPrec :: ReadPrec Loc
locReadPrec :: ReadPrec Loc
locReadPrec =
  Line -> Column -> Loc
Loc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec @Positive)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadPrec ()
readPrecChar Char
':'
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => ReadPrec a
readPrec @Positive)

-- | Create a 'Loc' from a line number and column number.
loc :: Line -> Column -> Loc
loc :: Line -> Column -> Loc
loc = Line -> Column -> Loc
Loc

-- | The smallest location: @'loc' 1 1@
--
-- >>> origin
-- 1:1
origin :: Loc
origin :: Loc
origin = Line -> Column -> Loc
loc Line
1 Column
1