Shin Parser

Parser.hs

{-# LANGUAGE OverloadedStrings #-}

module Language.Shin.Parser where



import qualified Data.Map as M
import qualified Data.Vector as V
import qualified Data.Text as T

import           Control.Applicative
import           Text.Groom

import qualified Text.Megaparsec as Prs
import qualified Text.Megaparsec.Text as Prs

import           Language.Shin.Syntax
import           Language.Shin.Lexer


parse :: Prs.Parser a -> String -> String -> Either (Prs.ParseError (Prs.Token T.Text) Prs.Dec) a
parse parser srcName content =
  Prs.parse (parser <* Prs.eof) srcName (T.pack content)

parsePrint :: Show a => Prs.Parser a -> String -> IO ()
parsePrint p = putStrLn . either Prs.parseErrorPretty groom . parse p "test"

litTest :: IO ()
litTest = parsePrint lit "{ fifteen = 15, vec = [\"hello\", [1,2,3], :var, True, \\x -> x, ~\\y -> y] }"

module_ :: Prs.Parser SyntaxModule
module_ = SyntaxModule
  <$> Prs.getPosition
  <*> (symbol "module" *> name)
  <*> pure []
  <*> pure []
  <*> Prs.many def

def :: Prs.Parser Decl
def = rword "def" *>
  ( Decl
    <$> Prs.getPosition
    <*> name
    <*> (Prs.many name <* equals)
    <*> (exprs <* semicolon)
  )

name :: Prs.Parser (Name Prs.SourcePos)
name = Name <$> Prs.getPosition <*> identifier

exprs :: Prs.Parser (Expr Prs.SourcePos)
exprs = Composition <$> Prs.getPosition <*> many expr

expr :: Prs.Parser (Expr Prs.SourcePos)
expr = do
  pos <- Prs.getPosition
  lam
    <|> (ELit pos <$> lit)
    <|> parens expr

lam :: Prs.Parser (Expr Prs.SourcePos)
lam = ELam
  <$> Prs.getPosition
  <*> (lambda *> Prs.many name)
  <*> (arrow  *> exprs)

lit :: Prs.Parser (Lit Prs.SourcePos)
lit = do
  pos <- Prs.getPosition
  (LitBool pos True <$ rword "True")
    <|> (LitBool pos False <$ rword "False")
    <|> (LitChar pos <$> char)
    <|> (LitInt  pos <$> integer)
    <|> (LitIdn  pos <$> name)
    <|> (LitRec  pos . M.fromList <$> record)
    <|> (LitVec  pos . V.fromList <$> brackets (lit `Prs.sepBy` comma))
    <|> (LitString pos <$> string)
    <|> (LitSymbol pos <$> (symbol ":" *> identifier))
    <|> (tilda *> (LitQuoted pos <$> expr))
    <|> (LitQuoted pos <$> lam)

record :: Prs.Parser [(T.Text, Lit Prs.SourcePos)]
record = braces
  . flip Prs.sepBy comma
  $ (,) <$> identifier <*> (equals *> lit)