module BNFC.Types.Position where

import BNFC.Prelude

data WithPosition a = WithPosition
  { wpPos   :: !Position
  , wpThing :: a
  } deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

data WithPosition' a = WithPosition'
  { wpPos'   :: !Position'
  , wpThing' :: a
  } deriving (Show, Functor, Foldable, Traversable)

type Position' = Maybe Position
data Position = Position
  { posLine :: !Int  -- ^ Starting at line, counting from 1.  (0 for invalid line.)
  , posCol  :: !Int  -- ^ Starting at column, counting from 1.  (0 for invalid column.)
  }
  deriving (Eq, Ord, Show)

instance Bounded Position where
  minBound = Position 0 0
  maxBound = Position maxBound maxBound

-- | Something that can be parsed into a 'Position'.

class ToPosition p where
  toPosition :: p -> Position

instance ToPosition Position where
  toPosition = id

instance ToPosition (Int, Int) where
  toPosition = uncurry Position

-- | Something that can be parsed into a 'Position''.

class ToPosition' p where
  toPosition' :: p -> Position'

instance ToPosition' Position' where
  toPosition' = id

instance ToPosition' Position where
  toPosition' = Just

instance ToPosition' (Int, Int) where
  toPosition' = Just . uncurry Position

instance ToPosition' (Maybe (Int, Int)) where
  toPosition' = fmap (uncurry Position)

-- Decoration instances

instance Decoration WithPosition where
  traverseF  f (WithPosition pos x) = WithPosition pos <$> f x
  traverseF2 f (WithPosition pos x) = bimap (WithPosition pos) (WithPosition pos) $ f x

instance Decoration WithPosition' where
  traverseF  f (WithPosition' pos x) = WithPosition' pos <$> f x
  traverseF2 f (WithPosition' pos x) = bimap (WithPosition' pos) (WithPosition' pos) $ f x