diff --git a/tests/syntax-tests/highlighted/Haskell/test.hs b/tests/syntax-tests/highlighted/Haskell/test.hs new file mode 100644 index 00000000..10fd1919 --- /dev/null +++ b/tests/syntax-tests/highlighted/Haskell/test.hs @@ -0,0 +1,86 @@ +{-# 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 #-} diff --git a/tests/syntax-tests/source/Haskell/test.hs b/tests/syntax-tests/source/Haskell/test.hs new file mode 100644 index 00000000..4c184b86 --- /dev/null +++ b/tests/syntax-tests/source/Haskell/test.hs @@ -0,0 +1,86 @@ +{-# 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 #-}