{-# LANGUAGE RankNTypes, KindSignatures, BangPatterns #-} {-| All you need to parse lambdaBase. -} module Language.LambdaBase.Parser (parseExpr, name, operatorChars, fixityOf) where import Text.ParserCombinators.Parsec import Language.LambdaBase.Core {-| Parse a valid name -} name = many1 $ oneOf "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_*+-!@#$%?&=<>^|/.:" {-| What is a valid char for an operator. -} operatorChars = "_*+-!@#$%?&=<>^|/.:" {-| Easy function to parse a string. -} parseExpr :: String -> Either ParseError (Expr a) parseExpr s = parse expr "" s exprSep = do spaces optional $ do comment spaces return () comment = do choice [ try inlineComment , try lineComment ] lineComment = do string "--" n <- many $ noneOf "\n" return () inlineComment = do string "{-" n <- many $ do choice [ try (string "-" >> (notFollowedBy $ string "}") >> (return 'a')) , noneOf "-" ] string "-}" return () parenthesis = do string "(" optional spaces n <- expr optional spaces string ")" return n isOperator :: String -> Bool isOperator n = and . map (\x -> any (==x) operatorChars) $ n {-| Will be infix if the string is an operator -} fixityOf :: String -> Fix fixityOf n = if isOperator n then Infix else Prefix nameNaked = do n <- name return $ Name n Naked $ fixityOf n infixName = do (Name s d f) <- notNakedName "`" "`" return $ case fixityOf s of Infix -> Name s d Prefix Prefix -> Name s d Infix nameExpr = do choice [ try nameNaked , try infixName , try $ notNakedName "{" "}" , try $ notNakedName "," "," , try $ notNakedName "\"" "\"" , try $ notNakedName "'" "'" , try $ notNakedName "~" "~" , try $ notNakedName "[" "]" ] notNakedName o c = do string o content <- many $ noneOf c string c return $ Name content (Delimited o c) Prefix lambda = do string "\\" spaces n <- name spaces evsS <- choice [string "->", string "~>"] let evs = case evsS of "->" -> Strict "~>" -> Lazy exprSep content <- expr return $ Lambda (Arg n evs) content Prefix exprSimple = do choice [ try parenthesis , try nameExpr , try lambda ] expr = do optional spaces exprs <- sepEndBy1 exprSimple exprSep optional spaces return $ Expr exprs Prefix