Merge pull request #7 from ckoparkar/master

Add support for source locations

Data/SCargot/Common.hs

@@ -25,6 +25,8 @@ module Data.SCargot.Common ( -- $intro
                              -- ** Numeric Literals for Arbitrary Bases
                            , commonLispNumberAnyBase
                            , gnuM4NumberAnyBase
+                             -- ** Source locations
+                           , Location(..), Located(..), located
                            ) where
 
 #if !MIN_VERSION_base(4,8,0)
@@ -332,6 +334,26 @@ hexNumber = number 16 hexDigit
 signedHexNumber :: Parser Integer
 signedHexNumber = ($) <$> sign <*> hexNumber
 
+
+-- |
+data Location = Span !SourcePos !SourcePos
+  deriving (Eq, Ord, Show)
+
+-- | Add support for source locations while parsing S-expressions, as described in this
+--   <https://www.reddit.com/r/haskell/comments/4x22f9/labelling_ast_nodes_with_locations/d6cmdy9/ Reddit>
+-- thread.
+data Located a = At !Location a
+  deriving (Eq, Ord, Show)
+
+-- | Adds a source span to a parser.
+located :: Parser a -> Parser (Located a)
+located parser = do
+  begin <- getPosition
+  result <- parser
+  end <- getPosition
+  return $ At (Span begin end) result
+
+
 {- $intro
 
 This module contains a selection of parsers for different kinds of

Data/SCargot/Language/Basic.hs

@@ -5,13 +5,17 @@ module Data.SCargot.Language.Basic
     -- $descr
     basicParser
   , basicPrinter
+  , locatedBasicParser
   ) where
 
 import           Control.Applicative ((<$>))
 import           Data.Char (isAlphaNum)
 import           Text.Parsec (many1, satisfy)
 import           Data.Text (Text, pack)
+import           Data.Functor.Identity (Identity)
+import           Text.Parsec.Prim (ParsecT)
 
+import           Data.SCargot.Common (Located, located)
 import           Data.SCargot.Repr.Basic (SExpr)
 import           Data.SCargot ( SExprParser
                               , SExprPrinter
@@ -25,6 +29,9 @@ isAtomChar c = isAlphaNum c
   || c == '+' || c == '<' || c == '>'
   || c == '=' || c == '!' || c == '?'
 
+pToken :: ParsecT Text a Identity Text
+pToken = pack <$> many1 (satisfy isAtomChar)
+
 -- $descr
 -- The 'basicSpec' describes S-expressions whose atoms are simply
 -- text strings that contain alphanumeric characters and a small
@@ -43,7 +50,16 @@ isAtomChar c = isAlphaNum c
 -- Right [SCons (SAtom "1") (SCons (SAtom "elephant") SNil)]
 basicParser :: SExprParser Text (SExpr Text)
 basicParser = mkParser pToken
-  where pToken = pack <$> many1 (satisfy isAtomChar)
+
+-- | A 'basicParser' which produces 'Located' values
+--
+-- >>> decode locatedBasicParser $ pack "(1 elephant)"
+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) "1")) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) "elephant")) SNil)]
+--
+-- >>> decode locatedBasicParser $ pack "(let ((x 1))\n  x)"
+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 5)) "let")) (SCons (SCons (SCons (SAtom (At (Span (line 1, column 8) (line 1, column 9)) "x")) (SCons (SAtom (At (Span (line 1, column 10) (line 1, column 11)) "1")) SNil)) SNil) (SCons (SAtom (At (Span (line 2, column 3) (line 2, column 4)) "x")) SNil))]
+locatedBasicParser :: SExprParser (Located Text) (SExpr (Located Text))
+locatedBasicParser = mkParser $ located pToken
 
 -- | A 'SExprPrinter' that prints textual atoms directly (without quoting
 --   or any other processing) onto a single line.

Data/SCargot/Language/HaskLike.hs

@@ -9,6 +9,7 @@ module Data.SCargot.Language.HaskLike
   , parseHaskellString
   , parseHaskellFloat
   , parseHaskellInt
+  , locatedHaskLikeParser
   ) where
 
 #if !MIN_VERSION_base(4,8,0)
@@ -157,6 +158,17 @@ sHaskLikeAtom (HSFloat f)  = pack (show f)
 haskLikeParser :: SExprParser HaskLikeAtom (SExpr HaskLikeAtom)
 haskLikeParser = mkParser pHaskLikeAtom
 
+-- | A 'haskLikeParser' which produces 'Located' values
+--
+-- >>> decode locatedHaskLikeParser $ pack "(0x01 \"\\x65lephant\")"
+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 6)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 7) (line 1, column 20)) (HSString "elephant"))) SNil)]
+--
+-- >>> decode locatedHaskLikeParser $ pack "(1 elephant)"
+-- Right [SCons (SAtom (At (Span (line 1, column 2) (line 1, column 3)) (HSInt 1))) (SCons (SAtom (At (Span (line 1, column 4) (line 1, column 12)) (HSIdent "elephant"))) SNil)]
+locatedHaskLikeParser :: SExprParser (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
+locatedHaskLikeParser = mkParser $ located pHaskLikeAtom
+
+
 -- | This 'SExprPrinter' emits s-expressions that contain Scheme-like
 --   tokens as well as string literals, integer literals, and floating-point
 --   literals, which will be emitted as the literals produced by Haskell's