Updated the example to semi-iso 0.4

This commit is contained in:
Paweł Nowak 2014-11-23 13:39:58 +01:00
parent bebffd3add
commit dbff80580c
2 changed files with 53 additions and 19 deletions

64
Main.hs
View File

@ -3,14 +3,17 @@
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Lens.Cons
import Control.Lens.SemiIso
import Control.Lens.TH
import qualified Data.Attoparsec.Text as AP
import Data.Char
import Data.Scientific (Scientific)
import Data.SemiIsoFunctor
import Data.Syntax (Syntax)
import qualified Data.Syntax as S
import qualified Data.Syntax.Attoparsec.Text as S
import Data.Syntax.Char (SyntaxChar)
import qualified Data.Syntax.Char as S
import qualified Data.Syntax.Combinator as S
import qualified Data.Syntax.Pretty as S
@ -18,37 +21,68 @@ import Data.Text (Text)
import qualified Data.Text.IO as T
import qualified Text.PrettyPrint as P
-- | A simple untyped lambda calculus.
-- A simple untyped lambda calculus.
data Literal = LitStr Text
| LitNum Scientific
deriving (Show)
$(makePrisms ''Literal)
data AST = Var Text
| Lit Literal
| App AST AST
| Abs Text AST
| Let Text AST AST
deriving (Show)
$(makePrisms ''AST)
-- | A variable name.
name :: Syntax syn Text => syn Text
name = S.takeWhile1 isAlphaNum
name = _Cons /$/ S.satisfy isAlpha /*/ S.takeWhile isAlphaNum
-- | A quoted string.
quoted :: SyntaxChar syn seq => syn seq
quoted = S.char '"' */ S.takeTill (=='"') /* S.char '"'
-- | Encloses a symbol in parentheses.
parens :: Syntax syn Text => syn a -> syn a
parens :: SyntaxChar syn seq => syn a -> syn a
parens m = S.char '(' */ S.spaces_ */ m /* S.spaces_ /* S.char ')'
-- | An atom is a variable or an expression in parentheses.
atom :: Syntax syn Text => syn AST
atom = _Var /$/ name
-- | A literal.
literal :: SyntaxChar syn Text => syn Literal
literal = _LitNum /$/ S.scientific
/|/ _LitStr /$/ quoted
-- | An atom is a variable, literal or an expression in parentheses.
atom :: SyntaxChar syn Text => syn AST
atom = _Lit /$/ literal
/|/ _Var /$/ name
/|/ parens expr
-- | Parsers a list of applications.
apps :: Syntax syn Text => syn AST
apps = bifoldl1 (attemptAp_ _App) /$/ S.sepBy1 atom S.spaces1
-- | Parses a list of atoms and folds them with the _App prism.
apps :: SyntaxChar syn Text => syn AST
apps = bifoldl1 _App /$/ S.sepBy1 atom S.spaces1
-- | An expression of our lambda calculus.
expr :: Syntax syn Text => syn AST
expr = _Abs /$/ S.char '\\' /* S.spaces_
*/ name /* S.spaces
/* S.string "->" /* S.spaces
--
-- Thanks to 'tuple-morph' we don't have to worry about /* and */ here.
-- Tuples are reassociated and units are removed by the 'morphed'
-- isomorphism (applied in /$~ operator).
expr :: SyntaxChar syn Text => syn AST
expr = _Abs /$~ S.char '\\' /*/ S.spaces_
/*/ name /*/ S.spaces
/*/ S.string "->" /*/ S.spaces
/*/ expr
/|/ _Let /$~ S.string "let" /*/ S.spaces1
/*/ name /*/ S.spaces
/*/ S.char '=' /*/ S.spaces
/*/ expr /*/ S.spaces1
/*/ S.string "in" /*/ S.spaces1
/*/ expr
/|/ apps
main :: IO ()
@ -58,7 +92,7 @@ main = do
-- Try to parse it.
case AP.parseOnly (S.getParser expr <* AP.skipSpace <* AP.endOfInput) t of
Left err -> putStrLn err
Left err -> putStrLn err
Right ast -> do
-- If parsing succeeded print the AST.
print ast
@ -66,7 +100,7 @@ main = do
-- Try to pretty print it.
-- (Printing cannot really fail in this example)
case S.runPrinter expr ast of
Left err -> putStrLn err
Left err -> putStrLn err
Right doc -> putStrLn (P.render doc)
return ()

View File

@ -1,5 +1,5 @@
name: syntax-example
version: 0.2.0.0
version: 0.3.0.0
synopsis: Example application using syntax, a library for abstract syntax descriptions.
license: MIT
license-file: LICENSE
@ -16,7 +16,7 @@ source-repository head
executable syntax-example
main-is: Main.hs
build-depends: base >= 4 && < 5, lens, semi-iso >= 0.3,
syntax >= 0.1.1, syntax-attoparsec, syntax-pretty,
attoparsec, pretty, text
build-depends: base >= 4 && < 5, lens, semi-iso >= 0.4,
syntax >= 0.2, syntax-attoparsec >= 0.2, syntax-pretty >= 0.2,
attoparsec, pretty, text, scientific >= 0.3
default-language: Haskell2010