bat/tests/syntax-tests/highlighted/Haskell/test.hs
2020-10-05 07:20:00 +02:00

87 lines
12 KiB
Haskell
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{-# LANGUAGE OverloadedStrings #-}
-- simple parser for a Lisp-like syntax I wrote some time ago
import Data.Void (Void)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Megaparsec.Char
import Text.Megaparsec.Error (errorBundlePretty)
import Text.Megaparsec hiding (State)
import qualified Text.Megaparsec.Char.Lexer as L
data LispVal
 = Symbol Text
 | List [LispVal]
 | Number Integer
 | String Text
 | LispTrue
 | LispFalse
 | Nil
 deriving (Show, Eq)
type Parser = Parsec Void Text
readStr :: Text -> Either String [LispVal]
readStr t =
 case parse pLisp "f" t of
 Right parsed -> Right parsed
 Left err -> Left $ errorBundlePretty err
{-# INLINABLE readStr #-}
sc :: Parser ()
sc = L.space space1 (L.skipLineComment ";") empty
{-# INLINABLE sc #-}
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
{-# INLINE lexeme #-}
symbol :: Text -> Parser Text
symbol = L.symbol sc
{-# INLINE symbol #-}
symbol' :: Text -> Parser Text
symbol' = L.symbol' sc
{-# INLINE symbol' #-}
pNil :: Parser LispVal
pNil = symbol' "nil" >> return Nil
{-# INLINE pNil #-}
integer :: Parser Integer
integer = lexeme L.decimal
{-# INLINE integer #-}
lispSymbols :: Parser Char
lispSymbols = oneOf ("#$%&|*+-/:<=>?@^_~" :: String)
{-# INLINE lispSymbols #-}
pLispVal :: Parser LispVal
pLispVal = choice [pList, pNumber, pSymbol, pNil, pString]
{-# INLINE pLispVal #-}
pSymbol :: Parser LispVal
pSymbol = (Symbol . T.pack <$> lexeme (some (letterChar <|> lispSymbols)))
{-# INLINABLE pSymbol #-}
pList :: Parser LispVal
pList = List <$> between (symbol "(") (symbol ")") (many pLispVal)
{-# INLINABLE pList #-}
pLisp :: Parser [LispVal]
pLisp = some pLispVal
{-# INLINE pLisp #-}
pNumber :: Parser LispVal
pNumber = Number <$> integer
{-# INLINE pNumber #-}
pString :: Parser LispVal
pString = do
 str <- char '\"' *> manyTill L.charLiteral (char '\"')
 return $ String (T.pack str)
{-# INLINABLE pString #-}