Haskell highligth test

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 #-}

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 #-}