Merge pull request #8 from ckoparkar/master
Add printers for Located parsers
G. D. Ritter authored 6 years ago
GitHub committed 6 years ago
| 26 | 26 | , commonLispNumberAnyBase |
| 27 | 27 | , gnuM4NumberAnyBase |
| 28 | 28 | -- ** Source locations |
| 29 |
, Location(..), Located(..), located |
|
| 29 | , Location(..), Located(..), located, dLocation | |
| 30 | 30 | ) where |
| 31 | 31 | |
| 32 | 32 | #if !MIN_VERSION_base(4,8,0) |
| 37 | 37 | import Data.Text (Text) |
| 38 | 38 | import qualified Data.Text as T |
| 39 | 39 | import Text.Parsec |
| 40 | import Text.Parsec.Pos (newPos) | |
| 40 | 41 | import Text.Parsec.Text (Parser) |
| 41 | 42 | |
| 42 | 43 | -- | Parse an identifier according to the R5RS Scheme standard. This |
| 353 | 354 | end <- getPosition |
| 354 | 355 | return $ At (Span begin end) result |
| 355 | 356 | |
| 357 | -- | A default location value | |
| 358 | dLocation :: Location | |
| 359 | dLocation = Span dPos dPos | |
| 360 | where dPos = newPos "" 0 0 | |
| 356 | 361 | |
| 357 | 362 | {- $intro |
| 358 | 363 | |
| 6 | 6 | basicParser |
| 7 | 7 | , basicPrinter |
| 8 | 8 | , locatedBasicParser |
| 9 | , locatedBasicPrinter | |
| 9 | 10 | ) where |
| 10 | 11 | |
| 11 | 12 | import Control.Applicative ((<$>)) |
| 15 | 16 | import Data.Functor.Identity (Identity) |
| 16 | 17 | import Text.Parsec.Prim (ParsecT) |
| 17 | 18 | |
| 18 |
import Data.SCargot.Common (Located |
|
| 19 | import Data.SCargot.Common (Located(..), located) | |
| 19 | 20 | import Data.SCargot.Repr.Basic (SExpr) |
| 20 | 21 | import Data.SCargot ( SExprParser |
| 21 | 22 | , SExprPrinter |
| 68 | 69 | -- "(1 elephant)" |
| 69 | 70 | basicPrinter :: SExprPrinter Text (SExpr Text) |
| 70 | 71 | basicPrinter = flatPrint id |
| 72 | ||
| 73 | -- | A 'SExprPrinter' for 'Located' values. Works exactly like 'basicPrinter' | |
| 74 | -- It ignores the location tags when printing the result. | |
| 75 | -- | |
| 76 | -- >>> let (Right dec) = decode locatedBasicParser $ pack "(1 elephant)" | |
| 77 | -- [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)] | |
| 78 | -- | |
| 79 | -- >>> encode locatedBasicPrinter dec | |
| 80 | -- "(1 elephant)" | |
| 81 | locatedBasicPrinter :: SExprPrinter (Located Text) (SExpr (Located Text)) | |
| 82 | locatedBasicPrinter = flatPrint unLoc | |
| 83 | where unLoc (At _loc e) = e | |
| 1 | {-# LANGUAGE FlexibleInstances #-} | |
| 1 | 2 | {-# LANGUAGE OverloadedStrings #-} |
| 2 | 3 | |
| 3 | 4 | module Data.SCargot.Language.HaskLike |
| 5 | 6 | HaskLikeAtom(..) |
| 6 | 7 | , haskLikeParser |
| 7 | 8 | , haskLikePrinter |
| 9 | , locatedHaskLikeParser | |
| 10 | , locatedHaskLikePrinter | |
| 8 | 11 | -- * Individual Parsers |
| 9 | 12 | , parseHaskellString |
| 10 | 13 | , parseHaskellFloat |
| 11 | 14 | , parseHaskellInt |
| 12 | , locatedHaskLikeParser | |
| 13 | 15 | ) where |
| 14 | 16 | |
| 15 | 17 | #if !MIN_VERSION_base(4,8,0) |
| 56 | 58 | |
| 57 | 59 | instance IsString HaskLikeAtom where |
| 58 | 60 | fromString = HSIdent . fromString |
| 61 | ||
| 62 | instance IsString (Located HaskLikeAtom) where | |
| 63 | fromString = (At dLocation) . HSIdent . fromString | |
| 59 | 64 | |
| 60 | 65 | -- | Parse a Haskell string literal as defined by the Haskell 2010 |
| 61 | 66 | -- language specification. |
| 168 | 173 | locatedHaskLikeParser :: SExprParser (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom)) |
| 169 | 174 | locatedHaskLikeParser = mkParser $ located pHaskLikeAtom |
| 170 | 175 | |
| 171 | ||
| 172 | 176 | -- | This 'SExprPrinter' emits s-expressions that contain Scheme-like |
| 173 | 177 | -- tokens as well as string literals, integer literals, and floating-point |
| 174 | 178 | -- literals, which will be emitted as the literals produced by Haskell's |
| 179 | 183 | -- "(1 \"elephant\")" |
| 180 | 184 | haskLikePrinter :: SExprPrinter HaskLikeAtom (SExpr HaskLikeAtom) |
| 181 | 185 | haskLikePrinter = flatPrint sHaskLikeAtom |
| 186 | ||
| 187 | -- | Ignore location tags when packing values into text | |
| 188 | sLocatedHasklikeAtom :: Located HaskLikeAtom -> Text | |
| 189 | sLocatedHasklikeAtom (At _loc e) = sHaskLikeAtom e | |
| 190 | ||
| 191 | -- | A 'SExprPrinter' for 'Located' values. Works exactly like 'haskLikePrinter' | |
| 192 | -- It ignores the location tags when printing the result. | |
| 193 | -- | |
| 194 | -- >>> let (Right dec) = decode locatedHaskLikeParser $ pack "(1 elephant)" | |
| 195 | -- [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)] | |
| 196 | -- | |
| 197 | -- >>> encode locatedHaskLikePrinter dec | |
| 198 | -- "(1 elephant)" | |
| 199 | locatedHaskLikePrinter :: SExprPrinter (Located HaskLikeAtom) (SExpr (Located HaskLikeAtom)) | |
| 200 | locatedHaskLikePrinter = flatPrint sLocatedHasklikeAtom | |