-- |
-- Module      :  Data.SExpresso.Parse.Location
-- Copyright   :  © 2019 Vincent Archambault
-- License     :  0BSD
--
-- Maintainer  :  Vincent Archambault <archambault.v@gmail.com>
-- Stability   :  experimental
--
-- The module "Data.SExpresso.Parse" re-exports the functions and
-- datatypes of this module.

{-# LANGUAGE DeriveFunctor #-}

module Data.SExpresso.Parse.Location
  (
    Location(..),
    Located(..),
    located,
    startPosPretty,
    endPosPretty
   )
  where

import Text.Megaparsec

-- Taken from https://www.reddit.com/r/haskell/comments/4x22f9/labelling_ast_nodes_with_locations/d6cmdy9/

-- | The 'Location' datatype represents a source span 
data Location = Span SourcePos SourcePos
              deriving (Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, Eq Location
Eq Location =>
(Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$c< :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> Location
Ord, Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> String
show :: Location -> String
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show)

-- | Pretty prints @S1@ of a @'Span' S1 _@ object with 'sourcePosPretty'
startPosPretty :: Location -> String
startPosPretty :: Location -> String
startPosPretty (Span SourcePos
s SourcePos
_) = SourcePos -> String
sourcePosPretty SourcePos
s

-- | Pretty prints @S2@ of a @'Span' _ S2@ object with 'sourcePosPretty'
endPosPretty :: Location -> String
endPosPretty :: Location -> String
endPosPretty (Span SourcePos
_ SourcePos
s) = SourcePos -> String
sourcePosPretty SourcePos
s

-- | The 'Located' datatype adds a source span to the type @a@
data Located a = At Location a
               deriving (Located a -> Located a -> Bool
(Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool) -> Eq (Located a)
forall a. Eq a => Located a -> Located a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Located a -> Located a -> Bool
== :: Located a -> Located a -> Bool
$c/= :: forall a. Eq a => Located a -> Located a -> Bool
/= :: Located a -> Located a -> Bool
Eq, Eq (Located a)
Eq (Located a) =>
(Located a -> Located a -> Ordering)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Bool)
-> (Located a -> Located a -> Located a)
-> (Located a -> Located a -> Located a)
-> Ord (Located a)
Located a -> Located a -> Bool
Located a -> Located a -> Ordering
Located a -> Located a -> Located a
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
forall a. Ord a => Eq (Located a)
forall a. Ord a => Located a -> Located a -> Bool
forall a. Ord a => Located a -> Located a -> Ordering
forall a. Ord a => Located a -> Located a -> Located a
$ccompare :: forall a. Ord a => Located a -> Located a -> Ordering
compare :: Located a -> Located a -> Ordering
$c< :: forall a. Ord a => Located a -> Located a -> Bool
< :: Located a -> Located a -> Bool
$c<= :: forall a. Ord a => Located a -> Located a -> Bool
<= :: Located a -> Located a -> Bool
$c> :: forall a. Ord a => Located a -> Located a -> Bool
> :: Located a -> Located a -> Bool
$c>= :: forall a. Ord a => Located a -> Located a -> Bool
>= :: Located a -> Located a -> Bool
$cmax :: forall a. Ord a => Located a -> Located a -> Located a
max :: Located a -> Located a -> Located a
$cmin :: forall a. Ord a => Located a -> Located a -> Located a
min :: Located a -> Located a -> Located a
Ord, Int -> Located a -> ShowS
[Located a] -> ShowS
Located a -> String
(Int -> Located a -> ShowS)
-> (Located a -> String)
-> ([Located a] -> ShowS)
-> Show (Located a)
forall a. Show a => Int -> Located a -> ShowS
forall a. Show a => [Located a] -> ShowS
forall a. Show a => Located a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Located a -> ShowS
showsPrec :: Int -> Located a -> ShowS
$cshow :: forall a. Show a => Located a -> String
show :: Located a -> String
$cshowList :: forall a. Show a => [Located a] -> ShowS
showList :: [Located a] -> ShowS
Show, (forall a b. (a -> b) -> Located a -> Located b)
-> (forall a b. a -> Located b -> Located a) -> Functor Located
forall a b. a -> Located b -> Located a
forall a b. (a -> b) -> Located a -> Located b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Located a -> Located b
fmap :: forall a b. (a -> b) -> Located a -> Located b
$c<$ :: forall a b. a -> Located b -> Located a
<$ :: forall a b. a -> Located b -> Located a
Functor)

-- | The 'located' function adds a source span to a parser.
located :: (MonadParsec e s m, TraversableStream s) => m a -> m (Located a)
located :: forall e s (m :: * -> *) a.
(MonadParsec e s m, TraversableStream s) =>
m a -> m (Located a)
located m a
parser = do
  SourcePos
begin <- m SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  a
result <- m a
parser
  SourcePos
end <- m SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Located a -> m (Located a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Located a -> m (Located a)) -> Located a -> m (Located a)
forall a b. (a -> b) -> a -> b
$ Location -> a -> Located a
forall a. Location -> a -> Located a
At (SourcePos -> SourcePos -> Location
Span SourcePos
begin SourcePos
end) a
result