nathanjgill.uk
this repo has no description
feat: add simple parser
+69
-1
+66
-1
app/Main.hs
+66
-1
app/Main.hs
···
1
1
module Main (main) where
2
2
3
+
import qualified Data.Text as T
4
+
import System.Environment
5
+
import Text.Megaparsec
6
+
import Text.Megaparsec.Char
7
+
import qualified Text.Megaparsec.Char.Lexer as L
8
+
9
+
newtype Error = Error T.Text deriving (Show, Eq, Ord)
10
+
11
+
type Input = T.Text
12
+
13
+
instance ShowErrorComponent Error where
14
+
showErrorComponent (Error e) = T.unpack e
15
+
16
+
type NlsParser a = Parsec Error Input a
17
+
18
+
data NlsValue
19
+
= Atom String
20
+
| Number Integer
21
+
| String String
22
+
| List [NlsValue]
23
+
deriving (Show, Eq, Ord)
24
+
25
+
sc :: NlsParser ()
26
+
sc = L.space space1 empty empty
27
+
28
+
parseAtom :: NlsParser NlsValue
29
+
parseAtom = do
30
+
first <- letterChar <|> oneOf ("!$%&|*+-/:<=>?@^_~")
31
+
rest <- many (alphaNumChar <|> oneOf ("!$%&|*+-/:<=>?@^_~"))
32
+
return $ Atom (first : rest)
33
+
34
+
parseNumber :: NlsParser NlsValue
35
+
parseNumber = Number <$> L.decimal
36
+
37
+
parseString :: NlsParser NlsValue
38
+
parseString = String <$> (char '"' >> manyTill L.charLiteral (char '"'))
39
+
40
+
parseList :: NlsParser NlsValue
41
+
parseList = do
42
+
_ <- char '('
43
+
elems <- many (sc *> parseValue)
44
+
sc
45
+
_ <- char ')'
46
+
return $ List elems
47
+
48
+
parseValue :: NlsParser NlsValue
49
+
parseValue = parseNumber <|> parseString <|> parseAtom <|> parseList
50
+
51
+
parseNls :: Input -> Either T.Text NlsValue
52
+
parseNls input =
53
+
case runParser parseValue "" input of
54
+
Left err -> Left $ T.pack $ errorBundlePretty err
55
+
Right val -> Right val
56
+
3
57
main :: IO ()
4
-
main = putStrLn "Hello, Haskell!"
58
+
main = do
59
+
args <- getArgs
60
+
progName <- getProgName
61
+
62
+
if (length args) /= 1
63
+
then
64
+
putStrLn $ "Usage: " ++ progName ++ " <expression>"
65
+
else
66
+
let t = T.pack (args !! 0)
67
+
in case parseNls t of
68
+
Left err -> putStrLn (T.unpack err)
69
+
Right val -> print val
+2
flake.nix
+2
flake.nix