simple parser

[fp.git] / src / Lambda / Parser / Simple.hs

diff --git a/src/Lambda/Parser/Simple.hs b/src/Lambda/Parser/Simple.hs
new file mode 100644 (file)
index 0000000..7c60639
--- /dev/null
+++ b/src/Lambda/Parser/Simple.hs
@@ -0,0 +1,73 @@
+{-# OPTIONS_GHC -fno-warn-unused-do-bind -fno-warn-orphans #-}
+
+-- |
+-- Module      :  Lambda.Parser.Simple
+-- Copyright   :  Tomáš Musil 2014
+-- License     :  BSD-3
+--
+-- Maintainer  :  tomik.musil@gmail.com
+-- Stability   :  experimental
+--
+-- Simple parser for λ-terms. Corresponds to the recursive λ-term definition. Application is always in brackets, nothing else is.
+
+
+module Lambda.Parser.Simple
+  ( tRead
+  , parseTerm
+  )  where
+
+import Data.Text as T
+import Data.Attoparsec.Text
+import Control.Applicative
+
+import Lambda.Term
+
+-- $setup
+-- >>> import Test.QuickCheck
+-- >>> import Test.Term hiding (tRead, parseTerm)
+
+-- | 
+-- >>> tShow $ Lambda "x" (Var "x")
+-- "\\x.x"
+-- >>> tShow $ App (Var "x") (Var "y")
+-- "(x y)"
+
+tShow :: Term -> String
+tShow (Var x) = x
+tShow (Lambda x t) = "\\" ++ x ++ "." ++ tShow t
+tShow (App t r) = "(" ++ tShow t ++ " " ++ tShow r ++ ")"
+
+-- |
+-- prop> t == tRead (tShow t)
+
+tRead :: String -> Term
+tRead s = case parseOnly (parseTerm <* endOfInput) (T.pack s) of
+    (Right t) -> t
+    (Left e) -> error e
+
+parseVar :: Parser Term
+parseVar = do
+  x <- many1 letter
+  return $! Var x
+
+parseLambda :: Parser Term
+parseLambda = do
+  char '\\'
+  (Var x) <- parseVar
+  char '.'
+  t <- parseTerm
+  return $! Lambda x t
+
+parseApp :: Parser Term
+parseApp = do
+  char '('
+  t <- parseTerm
+  char ' '
+  r <- parseTerm
+  char ')'
+  return $! App t r
+
+parseTerm :: Parser Term
+parseTerm = parseVar <|> parseLambda <|> parseApp
+
+