1
0
mirror of https://github.com/sharkdp/bat.git synced 2025-07-15 19:43:17 +01:00
Files
.github
assets
diagnostics
doc
examples
src
tests
benchmarks
examples
scripts
snapshots
syntax-tests
highlighted
source
ARM Assembly
ASP
AWK
ActionScript
Apache
AppleScript
AsciiDoc
Assembly (x86_64)
Bash
Batch
BibTeX
C
C-Sharp
CMake
CSS
CSV
Clojure
Cpp
CpuInfo
Crystal
D
Dart
Diff
Dockerfile
DotENV
Elixir
Elm
Email
Erlang
EtcGroup
Fish
Fstab
GLSL
Git Attributes
Git Config
Git Ignore
Go
GraphQL
Graphviz DOT
Groovy
HTML
Haskell
test.hs
Hosts
INI
JSON
Java
JavaScript
Jinja2
Julia
Kotlin
Less
Lisp
Lua
MATLAB
Makefile
Manpage
Markdown
MemInfo
Ninja
OCaml
Objective-C
Objective-C++
PHP
Pascal
Passwd
Perl
Plaintext
PowerShell
Protocol Buffer
PureScript
Python
QML
R
Regular Expression
RequirementsTXT
Ruby
Ruby Haml
Ruby On Rails
Rust
SCSS
SLS
SML
SQL
SSH Config
SSHD Config
Sass
Scala
Svelte
Swift
TOML
Tcl
TeX
Terraform
Textile
TypeScript
Vue
XML
YAML
nginx
nim
nix
orgmode
reStructuredText
compare_highlighted_versions.py
create_highlighted_versions.py
regression_test.sh
update.sh
.gitattributes
assets.rs
integration_tests.rs
no_duplicate_extensions.rs
snapshot_tests.rs
tester.rs
.gitignore
.gitmodules
CHANGELOG.md
CONTRIBUTING.md
Cargo.lock
Cargo.toml
LICENSE-APACHE
LICENSE-MIT
README.md
build.rs
bat/tests/syntax-tests/source/Haskell/test.hs
2020-10-05 07:20:00 +02:00

87 lines
1.9 KiB
Haskell

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