From dbff80580c8fe61cd9672c580d032c08dc5b1223 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Pawe=C5=82=20Nowak?= <pawel834@gmail.com>
Date: Sun, 23 Nov 2014 13:39:58 +0100
Subject: [PATCH] Updated the example to semi-iso 0.4

---
 Main.hs              | 64 +++++++++++++++++++++++++++++++++-----------
 syntax-example.cabal |  8 +++---
 2 files changed, 53 insertions(+), 19 deletions(-)

diff --git a/Main.hs b/Main.hs
index b014e4d..a3e9cd0 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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 ()
diff --git a/syntax-example.cabal b/syntax-example.cabal
index 8472a39..7df5255 100644
--- a/syntax-example.cabal
+++ b/syntax-example.cabal
@@ -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