git.iko.soy/bat
on 3d07dec help sign in
bat/tests/syntax-tests/source/Haskell/test.hs
86 lines 1.9 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
3-- simple parser for a Lisp-like syntax I wrote some time ago
5import Data.Void (Void)
7import Data.Text (Text)
8import qualified Data.Text as T
10import Text.Megaparsec.Char
11import Text.Megaparsec.Error (errorBundlePretty)
12import Text.Megaparsec hiding (State)
13import qualified Text.Megaparsec.Char.Lexer as L
15data LispVal
16 = Symbol Text
17 | List [LispVal]
18 | Number Integer
19 | String Text
20 | LispTrue
21 | LispFalse
22 | Nil
23 deriving (Show, Eq)
25type Parser = Parsec Void Text
27readStr :: Text -> Either String [LispVal]
28readStr t =
29 case parse pLisp "f" t of
30 Right parsed -> Right parsed
31 Left err -> Left $ errorBundlePretty err
32{-# INLINABLE readStr #-}
34sc :: Parser ()
35sc = L.space space1 (L.skipLineComment ";") empty
36{-# INLINABLE sc #-}
38lexeme :: Parser a -> Parser a
39lexeme = L.lexeme sc
40{-# INLINE lexeme #-}
42symbol :: Text -> Parser Text
43symbol = L.symbol sc
44{-# INLINE symbol #-}
46symbol' :: Text -> Parser Text
47symbol' = L.symbol' sc
48{-# INLINE symbol' #-}
50pNil :: Parser LispVal
51pNil = symbol' "nil" >> return Nil
52{-# INLINE pNil #-}
54integer :: Parser Integer
55integer = lexeme L.decimal
56{-# INLINE integer #-}
58lispSymbols :: Parser Char
59lispSymbols = oneOf ("#$%&|*+-/:<=>?@^_~" :: String)
60{-# INLINE lispSymbols #-}
62pLispVal :: Parser LispVal
63pLispVal = choice [pList, pNumber, pSymbol, pNil, pString]
64{-# INLINE pLispVal #-}
66pSymbol :: Parser LispVal
67pSymbol = (Symbol . T.pack <$> lexeme (some (letterChar <|> lispSymbols)))
68{-# INLINABLE pSymbol #-}
70pList :: Parser LispVal
71pList = List <$> between (symbol "(") (symbol ")") (many pLispVal)
72{-# INLINABLE pList #-}
74pLisp :: Parser [LispVal]
75pLisp = some pLispVal
76{-# INLINE pLisp #-}
78pNumber :: Parser LispVal
79pNumber = Number <$> integer
80{-# INLINE pNumber #-}
82pString :: Parser LispVal
83pString = do
84 str <- char '\"' *> manyTill L.charLiteral (char '\"')
85 return $ String (T.pack str)
86{-# INLINABLE pString #-}