| 1 |
{-# LANGUAGE OverloadedStrings #-}
|
| 2 |
|
| 3 |
module Main where
|
| 4 |
|
| 5 |
import Control.Applicative ((<|>))
|
| 6 |
import Data.Char (isDigit)
|
| 7 |
import Data.SCargot
|
| 8 |
import Data.SCargot.Repr.Basic
|
| 9 |
import Data.Text (Text, pack)
|
| 10 |
import Numeric (readHex)
|
| 11 |
import System.Environment (getArgs)
|
| 12 |
import Text.Parsec (anyChar, char, digit, many1, manyTill, newline, satisfy, string)
|
| 13 |
import Text.Parsec.Text (Parser)
|
| 14 |
|
| 15 |
-- Our operators are going to represent addition, subtraction, or
|
| 16 |
-- multiplication
|
| 17 |
data Op = Add | Sub | Mul deriving (Eq, Show)
|
| 18 |
|
| 19 |
-- The atoms of our language are either one of the aforementioned
|
| 20 |
-- operators, or positive integers
|
| 21 |
data Atom = AOp Op | ANum Int deriving (Eq, Show)
|
| 22 |
|
| 23 |
-- Once parsed, our language will consist of the applications of
|
| 24 |
-- binary operators with literal integers at the leaves
|
| 25 |
data Expr = EOp Op Expr Expr | ENum Int deriving (Eq, Show)
|
| 26 |
|
| 27 |
-- Conversions to and from our Expr type
|
| 28 |
toExpr :: SExpr Atom -> Either String Expr
|
| 29 |
toExpr (A (AOp op) ::: l ::: r ::: Nil) = EOp op <$> toExpr l <*> toExpr r
|
| 30 |
toExpr (A (ANum n)) = pure (ENum n)
|
| 31 |
toExpr sexpr = Left ("Unable to parse expression: " ++ show sexpr)
|
| 32 |
|
| 33 |
fromExpr :: Expr -> SExpr Atom
|
| 34 |
fromExpr (EOp op l r) = A (AOp op) ::: fromExpr l ::: fromExpr r ::: Nil
|
| 35 |
fromExpr (ENum n) = A (ANum n) ::: Nil
|
| 36 |
|
| 37 |
-- Parser and serializer for our Atom type
|
| 38 |
pAtom :: Parser Atom
|
| 39 |
pAtom = ((ANum . read) <$> many1 digit)
|
| 40 |
<|> (char '+' *> pure (AOp Add))
|
| 41 |
<|> (char '-' *> pure (AOp Sub))
|
| 42 |
<|> (char '*' *> pure (AOp Mul))
|
| 43 |
|
| 44 |
sAtom :: Atom -> Text
|
| 45 |
sAtom (AOp Add) = "+"
|
| 46 |
sAtom (AOp Sub) = "-"
|
| 47 |
sAtom (AOp Mul) = "*"
|
| 48 |
sAtom (ANum n) = pack (show n)
|
| 49 |
|
| 50 |
-- Our comment syntax is going to be Haskell-like:
|
| 51 |
hsComment :: Parser ()
|
| 52 |
hsComment = string "--" >> manyTill anyChar newline >> return ()
|
| 53 |
|
| 54 |
-- Our custom reader macro: grab the parse stream and read a
|
| 55 |
-- hexadecimal number from it:
|
| 56 |
hexReader :: Reader Atom
|
| 57 |
hexReader _ = (A . ANum . rd) <$> many1 (satisfy isHexDigit)
|
| 58 |
where isHexDigit c = isDigit c || c `elem` hexChars
|
| 59 |
rd = fst . head . readHex
|
| 60 |
hexChars :: String
|
| 61 |
hexChars = "AaBbCcDdEeFf"
|
| 62 |
|
| 63 |
-- Our final s-expression parser and printer:
|
| 64 |
myLangParser :: SExprParser Atom Expr
|
| 65 |
myLangParser
|
| 66 |
= setComment hsComment -- set comment syntax to be Haskell-style
|
| 67 |
$ addReader '#' hexReader -- add hex reader
|
| 68 |
$ setCarrier toExpr -- convert final repr to Expr
|
| 69 |
$ mkParser pAtom -- create spec with Atom type
|
| 70 |
|
| 71 |
mkLangPrinter :: SExprPrinter Atom Expr
|
| 72 |
mkLangPrinter
|
| 73 |
= setFromCarrier fromExpr
|
| 74 |
$ setIndentStrategy (const Align)
|
| 75 |
$ basicPrint sAtom
|
| 76 |
|
| 77 |
|
| 78 |
main :: IO ()
|
| 79 |
main = do
|
| 80 |
sExprText <- pack . head <$> getArgs
|
| 81 |
either putStrLn print (decode myLangParser sExprText)
|
| 82 |
|
| 83 |
{-
|
| 84 |
Exmaple usage:
|
| 85 |
|
| 86 |
$ dist/build/example/example "$(echo -e '(+ (* 2 20) 10) (* 10 10)')"
|
| 87 |
[EOp Add (EOp Mul (ENum 2) (ENum 20)) (ENum 10),EOp Mul (ENum 10) (ENum 10)]
|
| 88 |
-}
|