{- This file is part of text-position.
 -
 - Written in 2015 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - To the extent possible under law, the author(s) have dedicated all copyright
 - and related and neighboring rights to this software to the public domain
 - worldwide. This software is distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Data.Position.Types
    ( Position (..)
    , Advance
    , Positioned (..)
    , PosRE
    )
where

import Text.Regex.Applicative

-- | Represents a position in a text. The intended usage is holding the next
-- available position in a file. In other words: If a character would be
-- appended to the file, what its position would be.
data Position = Position
    { line   :: Int -- ^ Line number, start counting from 1
    , column :: Int -- ^ Column number, start counting from 1
    , char   :: Int -- ^ Character index (count of characters in the file so
                    --   far), start counting from 1
    }
    deriving (Show, Eq)

-- | Represents an advancement of the /next available position/ marker due to
-- reading a character. For example, the letter A moves forward by one column,
-- while linefeed (@'\n'@) moves to the beginning of the next line.
--
-- The character type is a type parameter.
--
-- An advance includes a pattern and a change. The pattern determines to which
-- characters, or character sequences, this advance applies. The change
-- determines how to advance the position in the pattern is matched. It can
-- also choose different advances depending on the match, e.g. "move 1 column
-- if matched "a" and move 4 columns if matched "\t".
type Advance s = RE s (Position -> Position)

-- | A value with a position attached.
data Positioned a = Positioned a Position deriving (Show, Eq)

-- | Applicative regex ("Text.Regex.Applicative") which takes position-tagged
-- symbols and returns a position-tagged result.
type PosRE s a = RE (Positioned s) (Positioned a)