@hackage syntax-example0.3.0.0

Example application using syntax, a library for abstract syntax descriptions.

The code.

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
import           Data.Text (Text)
import qualified Data.Text.IO as T
import qualified Text.PrettyPrint as P

-- A simple 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 = _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 :: SyntaxChar syn seq => syn a -  > syn a
parens m = S.char '(' */ S.spaces_ */ m /* S.spaces_ /* S.char ')'

-- | 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

-- | 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.
--
-- 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 ()
main = do
    -- Load the standard input.
    t <- T.getContents

    -- Try to parse it.
    case AP.parseOnly (S.getParser expr <* AP.skipSpace <* AP.endOfInput) t of
      Left err  -> putStrLn err
      Right ast -> do
        -- If parsing succeeded print the AST.
        print ast

        -- Try to pretty print it.
        -- (Printing cannot really fail in this example)
        case S.runPrinter expr ast of
          Left err  -> putStrLn err
          Right doc -> putStrLn (P.render doc)

    return ()