Skip to content

Instantly share code, notes, and snippets.

@cocreature
Created March 22, 2018 09:09
Show Gist options
  • Save cocreature/845109729b10e4b734d675ccc24e2a16 to your computer and use it in GitHub Desktop.
Save cocreature/845109729b10e4b734d675ccc24e2a16 to your computer and use it in GitHub Desktop.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
import Control.Monad
import Data.Text (Text)
import Data.Void
import Text.Megaparsec
import qualified Text.Megaparsec.Char.Lexer as Lexer
import Text.Megaparsec.Expr
type Parser = Parsec Void Text
sc :: Parser ()
sc = Lexer.space (void (takeWhile1P Nothing f)) lineComment empty
where f x = x `elem` [' ', '\t']
lineComment :: Parser ()
lineComment = Lexer.skipLineComment "#"
symbol :: Text -> Parser Text
symbol = Lexer.symbol sc
parens :: Parser a -> Parser a
parens = between (symbol "(") (symbol ")")
data Type a = TyInt a | TyFun a (Type a) (Type a)
deriving Show
data SrcSpan = SrcSpan SourcePos SourcePos Text
deriving (Eq, Ord, Show)
withSrcSpan :: (SrcSpan -> Parser a) -> Parser a
withSrcSpan f = mdo
spanStart <- getPosition
(text, a) <- match (f (SrcSpan spanStart spanEnd text))
spanEnd <- getPosition
pure a
parseType :: Parser (Type SrcSpan)
parseType =
withSrcSpan $ \srcSpan ->
let term = choice [parens parseType, tyInt]
table = [ [InfixR tyFun] ]
tyFun = do
_ <- symbol "->"
-- Problem: This will always use the full SrcSpan even for nested TyFuns.
pure (TyFun srcSpan)
in makeExprParser term table
where tyInt = withSrcSpan (\srcSpan -> TyInt srcSpan <$ symbol "Int")
main :: IO ()
main = do
parseTest parseType "Int -> Int -> Int"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment