example.hs 2.8 KB

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