{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.Loc.Pos
  ( Pos
  , Line
  , Column
  , ToNat (..)

  -- * Show and Read
  , posShowsPrec
  , posReadPrec

  ) where

import Data.Loc.Internal.Prelude

import Prelude (Num (..))

import Data.Data (Data)

{- |

'Pos' stands for /positive integer/. You can also think of it as /position/,
because we use it to represent line and column numbers ('Line' and 'Column').

'Pos' has instances of several of the standard numeric typeclasses, although
many of the operations throw 'Underflow' when non-positive values result.
'Pos' does /not/ have an 'Integral' instance, because there is no sensible
way to implement 'quotRem'.

-}
newtype Pos = Pos Natural
  deriving (Typeable Pos
DataType
Constr
Typeable Pos
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pos -> c Pos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pos)
-> (Pos -> Constr)
-> (Pos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos))
-> ((forall b. Data b => b -> b) -> Pos -> Pos)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pos -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pos -> m Pos)
-> Data Pos
Pos -> DataType
Pos -> Constr
(forall b. Data b => b -> b) -> Pos -> Pos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
forall u. (forall d. Data d => d -> u) -> Pos -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cPos :: Constr
$tPos :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapMp :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapM :: (forall d. Data d => d -> m d) -> Pos -> m Pos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pos -> m Pos
gmapQi :: Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pos -> r
gmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
$cgmapT :: (forall b. Data b => b -> b) -> Pos -> Pos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Pos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pos)
dataTypeOf :: Pos -> DataType
$cdataTypeOf :: Pos -> DataType
toConstr :: Pos -> Constr
$ctoConstr :: Pos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pos -> c Pos
$cp1Data :: Typeable Pos
Data, Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Eq Pos
-> (Pos -> Pos -> Ordering)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Bool)
-> (Pos -> Pos -> Pos)
-> (Pos -> Pos -> Pos)
-> Ord Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
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 :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
$cp1Ord :: Eq Pos
Ord)

instance ToNat Pos
  where

    toNat :: Pos -> Natural
toNat (Pos Natural
n) = Natural
n

instance Show Pos
  where

    showsPrec :: Int -> Pos -> ShowS
showsPrec = Int -> Pos -> ShowS
posShowsPrec

instance Read Pos
  where

    readPrec :: ReadPrec Pos
readPrec = ReadPrec Pos
posReadPrec

{- |

>>> fromInteger 3 :: Pos
3

>>> fromInteger 0 :: Pos
*** Exception: arithmetic underflow

>>> 2 + 3 :: Pos
5

>>> 3 - 2 :: Pos
1

>>> 3 - 3 :: Pos
*** Exception: arithmetic underflow

>>> 2 * 3 :: Pos
6

>>> negate 3 :: Pos
*** Exception: arithmetic underflow

-}
instance Num Pos
  where

    fromInteger :: Integer -> Pos
fromInteger = Natural -> Pos
Pos (Natural -> Pos) -> (Integer -> Natural) -> Integer -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
checkForUnderflow (Natural -> Natural) -> (Integer -> Natural) -> Integer -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Natural
forall a. Num a => Integer -> a
fromInteger

    Pos Natural
x + :: Pos -> Pos -> Pos
+ Pos Natural
y = Natural -> Pos
Pos (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
y)

    Pos Natural
x - :: Pos -> Pos -> Pos
- Pos Natural
y = Natural -> Pos
Pos (Natural -> Natural
checkForUnderflow (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
y))

    Pos Natural
x * :: Pos -> Pos -> Pos
* Pos Natural
y = Natural -> Pos
Pos (Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
y)

    abs :: Pos -> Pos
abs = Pos -> Pos
forall a. a -> a
id

    signum :: Pos -> Pos
signum Pos
_ = Natural -> Pos
Pos Natural
1

    negate :: Pos -> Pos
negate Pos
_ = ArithException -> Pos
forall a e. Exception e => e -> a
throw ArithException
Underflow

instance Real Pos
  where

    toRational :: Pos -> Rational
toRational (Pos Natural
n) = Natural -> Rational
forall a. Real a => a -> Rational
toRational Natural
n

{- |

>>> toEnum 3 :: Pos
3

>>> toEnum 0 :: Pos
*** Exception: arithmetic underflow

>>> fromEnum (3 :: Pos)
3

-}
instance Enum Pos
  where

    toEnum :: Int -> Pos
toEnum = Natural -> Pos
Pos (Natural -> Pos) -> (Int -> Natural) -> Int -> Pos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
checkForUnderflow (Natural -> Natural) -> (Int -> Natural) -> Int -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Natural
forall a. Enum a => Int -> a
toEnum

    fromEnum :: Pos -> Int
fromEnum (Pos Natural
n) = Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
n

checkForUnderflow :: Natural -> Natural
checkForUnderflow :: Natural -> Natural
checkForUnderflow Natural
n =
  if Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0 then ArithException -> Natural
forall a e. Exception e => e -> a
throw ArithException
Underflow else Natural
n

{- |

>>> posShowsPrec minPrec 1 ""
"1"

>>> posShowsPrec minPrec 42 ""
"42"

-}
posShowsPrec :: Int -> Pos -> ShowS
posShowsPrec :: Int -> Pos -> ShowS
posShowsPrec Int
i (Pos Natural
n) =
  Int -> Natural -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i Natural
n

{- |

>>> readPrec_to_S posReadPrec minPrec "1"
[(1,"")]

>>> readPrec_to_S posReadPrec minPrec "42"
[(42,"")]

>>> readPrec_to_S posReadPrec minPrec "0"
[]

>>> readPrec_to_S posReadPrec minPrec "-1"
[]

-}
posReadPrec :: ReadPrec Pos
posReadPrec :: ReadPrec Pos
posReadPrec =
  Natural -> Pos
Pos (Natural -> Pos) -> ReadPrec Natural -> ReadPrec Pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural -> Bool) -> ReadPrec Natural -> ReadPrec Natural
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0) ReadPrec Natural
forall a. Read a => ReadPrec a
readPrec


--------------------------------------------------------------------------------
--  ToNat
--------------------------------------------------------------------------------

{- |

Types that can be converted to 'Natural'.

This class mostly exists so that 'toNat' can be used in situations that would
normally call for 'toInteger' (which we cannot use because 'Pos' does not have
an instance of 'Integral').

-}
class ToNat a
  where

    toNat :: a -> Natural


--------------------------------------------------------------------------------
--  Line
--------------------------------------------------------------------------------

newtype Line = Line Pos
  deriving (Typeable Line
DataType
Constr
Typeable Line
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Line -> c Line)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Line)
-> (Line -> Constr)
-> (Line -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Line))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line))
-> ((forall b. Data b => b -> b) -> Line -> Line)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r)
-> (forall u. (forall d. Data d => d -> u) -> Line -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Line -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Line -> m Line)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Line -> m Line)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Line -> m Line)
-> Data Line
Line -> DataType
Line -> Constr
(forall b. Data b => b -> b) -> Line -> Line
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Line -> c Line
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Line
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Line -> u
forall u. (forall d. Data d => d -> u) -> Line -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Line -> m Line
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Line -> m Line
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Line
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Line -> c Line
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Line)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line)
$cLine :: Constr
$tLine :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Line -> m Line
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Line -> m Line
gmapMp :: (forall d. Data d => d -> m d) -> Line -> m Line
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Line -> m Line
gmapM :: (forall d. Data d => d -> m d) -> Line -> m Line
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Line -> m Line
gmapQi :: Int -> (forall d. Data d => d -> u) -> Line -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Line -> u
gmapQ :: (forall d. Data d => d -> u) -> Line -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Line -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Line -> r
gmapT :: (forall b. Data b => b -> b) -> Line -> Line
$cgmapT :: (forall b. Data b => b -> b) -> Line -> Line
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Line)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Line)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Line)
dataTypeOf :: Line -> DataType
$cdataTypeOf :: Line -> DataType
toConstr :: Line -> Constr
$ctoConstr :: Line -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Line
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Line
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Line -> c Line
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Line -> c Line
$cp1Data :: Typeable Line
Data, 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, Integer -> Line
Line -> Line
Line -> Line -> Line
(Line -> Line -> Line)
-> (Line -> Line -> Line)
-> (Line -> Line -> Line)
-> (Line -> Line)
-> (Line -> Line)
-> (Line -> Line)
-> (Integer -> Line)
-> Num Line
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Line
$cfromInteger :: Integer -> Line
signum :: Line -> Line
$csignum :: Line -> Line
abs :: Line -> Line
$cabs :: Line -> Line
negate :: Line -> Line
$cnegate :: Line -> Line
* :: Line -> Line -> Line
$c* :: Line -> Line -> Line
- :: Line -> Line -> Line
$c- :: Line -> Line -> Line
+ :: Line -> Line -> Line
$c+ :: Line -> Line -> Line
Num, Num Line
Ord Line
Num Line -> Ord Line -> (Line -> Rational) -> Real Line
Line -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Line -> Rational
$ctoRational :: Line -> Rational
$cp2Real :: Ord Line
$cp1Real :: Num Line
Real, 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, Line -> Natural
(Line -> Natural) -> ToNat Line
forall a. (a -> Natural) -> ToNat a
toNat :: Line -> Natural
$ctoNat :: Line -> Natural
ToNat)

instance Show Line
  where

    showsPrec :: Int -> Line -> ShowS
showsPrec Int
i (Line Pos
pos) = Int -> Pos -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i Pos
pos

instance Read Line
  where

    readPrec :: ReadPrec Line
readPrec = Pos -> Line
Line (Pos -> Line) -> ReadPrec Pos -> ReadPrec Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Pos
forall a. Read a => ReadPrec a
readPrec


--------------------------------------------------------------------------------
--  Column
--------------------------------------------------------------------------------

newtype Column = Column Pos
  deriving (Typeable Column
DataType
Constr
Typeable Column
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Column -> c Column)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Column)
-> (Column -> Constr)
-> (Column -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Column))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Column))
-> ((forall b. Data b => b -> b) -> Column -> Column)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Column -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Column -> r)
-> (forall u. (forall d. Data d => d -> u) -> Column -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Column -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Column -> m Column)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Column -> m Column)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Column -> m Column)
-> Data Column
Column -> DataType
Column -> Constr
(forall b. Data b => b -> b) -> Column -> Column
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Column -> c Column
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Column
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Column -> u
forall u. (forall d. Data d => d -> u) -> Column -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Column -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Column -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Column -> m Column
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Column -> m Column
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Column
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Column -> c Column
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Column)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Column)
$cColumn :: Constr
$tColumn :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Column -> m Column
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Column -> m Column
gmapMp :: (forall d. Data d => d -> m d) -> Column -> m Column
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Column -> m Column
gmapM :: (forall d. Data d => d -> m d) -> Column -> m Column
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Column -> m Column
gmapQi :: Int -> (forall d. Data d => d -> u) -> Column -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Column -> u
gmapQ :: (forall d. Data d => d -> u) -> Column -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Column -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Column -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Column -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Column -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Column -> r
gmapT :: (forall b. Data b => b -> b) -> Column -> Column
$cgmapT :: (forall b. Data b => b -> b) -> Column -> Column
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Column)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Column)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Column)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Column)
dataTypeOf :: Column -> DataType
$cdataTypeOf :: Column -> DataType
toConstr :: Column -> Constr
$ctoConstr :: Column -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Column
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Column
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Column -> c Column
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Column -> c Column
$cp1Data :: Typeable Column
Data, 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, Integer -> Column
Column -> Column
Column -> Column -> Column
(Column -> Column -> Column)
-> (Column -> Column -> Column)
-> (Column -> Column -> Column)
-> (Column -> Column)
-> (Column -> Column)
-> (Column -> Column)
-> (Integer -> Column)
-> Num Column
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Column
$cfromInteger :: Integer -> Column
signum :: Column -> Column
$csignum :: Column -> Column
abs :: Column -> Column
$cabs :: Column -> Column
negate :: Column -> Column
$cnegate :: Column -> Column
* :: Column -> Column -> Column
$c* :: Column -> Column -> Column
- :: Column -> Column -> Column
$c- :: Column -> Column -> Column
+ :: Column -> Column -> Column
$c+ :: Column -> Column -> Column
Num, Num Column
Ord Column
Num Column -> Ord Column -> (Column -> Rational) -> Real Column
Column -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Column -> Rational
$ctoRational :: Column -> Rational
$cp2Real :: Ord Column
$cp1Real :: Num Column
Real, 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, Column -> Natural
(Column -> Natural) -> ToNat Column
forall a. (a -> Natural) -> ToNat a
toNat :: Column -> Natural
$ctoNat :: Column -> Natural
ToNat)

instance Show Column
  where

    showsPrec :: Int -> Column -> ShowS
showsPrec Int
i (Column Pos
pos) = Int -> Pos -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
i Pos
pos

instance Read Column
  where

    readPrec :: ReadPrec Column
readPrec = Pos -> Column
Column (Pos -> Column) -> ReadPrec Pos -> ReadPrec Column
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Pos
forall a. Read a => ReadPrec a
readPrec