Merge pull request #8 from ckoparkar/master

Add printers for Located parsers

Data/SCargot/Common.hs

@@ -26,7 +26,7 @@ module Data.SCargot.Common ( -- $intro
                            , commonLispNumberAnyBase
                            , gnuM4NumberAnyBase
                              -- ** Source locations
-                           , Location(..), Located(..), located
+                           , Location(..), Located(..), located, dLocation
                            ) where
 
 #if !MIN_VERSION_base(4,8,0)
@@ -37,6 +37,7 @@ import           Data.Char
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Text.Parsec
+import           Text.Parsec.Pos  (newPos)
 import           Text.Parsec.Text (Parser)
 
 -- | Parse an identifier according to the R5RS Scheme standard. This
@@ -353,6 +354,10 @@ located parser = do
   end <- getPosition
   return $ At (Span begin end) result
 
+-- | A default location value
+dLocation :: Location
+dLocation = Span dPos dPos
+  where dPos = newPos "" 0 0
 
 {- $intro
 

Data/SCargot/Language/Basic.hs

@@ -6,6 +6,7 @@ module Data.SCargot.Language.Basic
     basicParser
   , basicPrinter
   , locatedBasicParser
+  , locatedBasicPrinter
   ) where
 
 import           Control.Applicative ((<$>))
@@ -15,7 +16,7 @@ import           Data.Text (Text, pack)
 import           Data.Functor.Identity (Identity)
 import           Text.Parsec.Prim (ParsecT)
 
-import           Data.SCargot.Common (Located, located)
+import           Data.SCargot.Common (Located(..), located)
 import           Data.SCargot.Repr.Basic (SExpr)
 import           Data.SCargot ( SExprParser
                               , SExprPrinter
@@ -68,3 +69,15 @@ locatedBasicParser = mkParser $ located pToken
 -- "(1 elephant)"
 basicPrinter :: SExprPrinter Text (SExpr Text)
 basicPrinter = flatPrint id
+
+-- | A 'SExprPrinter' for 'Located' values. Works exactly like 'basicPrinter'
+--   It ignores the location tags when printing the result.
+--
+-- >>> let (Right dec) = decode locatedBasicParser $ pack "(1 elephant)"
+-- [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)]
+--
+-- >>> encode locatedBasicPrinter dec
+-- "(1 elephant)"
+locatedBasicPrinter :: SExprPrinter (Located Text) (SExpr (Located Text))
+locatedBasicPrinter = flatPrint unLoc
+  where unLoc (At _loc e) = e

Data/SCargot/Language/HaskLike.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Data.SCargot.Language.HaskLike
@@ -5,11 +6,12 @@ module Data.SCargot.Language.HaskLike
     HaskLikeAtom(..)
   , haskLikeParser
   , haskLikePrinter
+  , locatedHaskLikeParser
+  , locatedHaskLikePrinter
     -- * Individual Parsers
   , parseHaskellString
   , parseHaskellFloat
   , parseHaskellInt
-  , locatedHaskLikeParser
   ) where
 
 #if !MIN_VERSION_base(4,8,0)
@@ -57,6 +59,9 @@ data HaskLikeAtom
 instance IsString HaskLikeAtom where
   fromString = HSIdent . fromString
 
+instance IsString (Located HaskLikeAtom) where
+  fromString = (At dLocation) . HSIdent . fromString
+
 -- | Parse a Haskell string literal as defined by the Haskell 2010
 -- language specification.
 parseHaskellString :: Parser Text
@@ -168,7 +173,6 @@ haskLikeParser = mkParser pHaskLikeAtom
 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
@@ -179,3 +183,18 @@ locatedHaskLikeParser = mkParser $ located pHaskLikeAtom
 -- "(1 \"elephant\")"
 haskLikePrinter :: SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom)
 haskLikePrinter = flatPrint sHaskLikeAtom
+
+-- | Ignore location tags when packing values into text
+sLocatedHasklikeAtom :: Located HaskLikeAtom -> Text
+sLocatedHasklikeAtom (At _loc e) = sHaskLikeAtom e
+
+-- | A 'SExprPrinter' for 'Located' values. Works exactly like 'haskLikePrinter'
+--   It ignores the location tags when printing the result.
+--
+-- >>> let (Right dec) = decode locatedHaskLikeParser $ pack "(1 elephant)"
+-- [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)]
+--
+-- >>> encode locatedHaskLikePrinter dec
+-- "(1 elephant)"
+locatedHaskLikePrinter :: SExprPrinter (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom))
+locatedHaskLikePrinter = flatPrint sLocatedHasklikeAtom