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
Pos -> DataType
Pos -> Constr
(forall b. Data b => b -> b) -> Pos -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pos -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pos -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Pos -> Pos -> Bool
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
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
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
checkForUnderflow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

    Pos Natural
x + :: Pos -> Pos -> Pos
+ Pos Natural
y = Natural -> Pos
Pos (Natural
x 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 forall a. Num a => a -> a -> a
- Natural
y))

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

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

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

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

instance Real Pos
  where

    toRational :: Pos -> Rational
toRational (Pos Natural
n) = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Natural
checkForUnderflow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum

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

checkForUnderflow :: Natural -> Natural
checkForUnderflow :: Natural -> Natural
checkForUnderflow Natural
n =
  if Natural
n forall a. Eq a => a -> a -> Bool
== Natural
0 then 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) =
  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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (forall a. Eq a => a -> a -> Bool
/= Natural
0) 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
Line -> DataType
Line -> Constr
(forall b. Data b => b -> b) -> Line -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Line -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Line -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Line -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Line -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Line -> Line -> Bool
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
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
Ord, Integer -> Line
Line -> Line
Line -> Line -> 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
Line -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Line -> Rational
$ctoRational :: Line -> Rational
Real, Int -> Line
Line -> Int
Line -> [Line]
Line -> Line
Line -> Line -> [Line]
Line -> Line -> Line -> [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
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) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
i Pos
pos

instance Read Line
  where

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


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

newtype Column = Column Pos
  deriving (Typeable Column
Column -> DataType
Column -> Constr
(forall b. Data b => b -> b) -> Column -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Column -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Column -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Column -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Column -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Column -> Column -> Bool
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
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
Ord, Integer -> Column
Column -> Column
Column -> Column -> 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
Column -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Column -> Rational
$ctoRational :: Column -> Rational
Real, Int -> Column
Column -> Int
Column -> [Column]
Column -> Column
Column -> Column -> [Column]
Column -> Column -> Column -> [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
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) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
i Pos
pos

instance Read Column
  where

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