-----------------------------------------------------------------------------
-- |
-- Module : Main
-- Copyright : (c) Brent Yorgey 2011
-- License : BSD-style (see LICENSE)
-- Maintainer : Brent Yorgey <byorgey@cis.upenn.edu>
-- Stability : experimental
--
-- Ott (<http://www.cl.cam.ac.uk/~pes20/ott/>) is a tool for writing
-- formal definitions of programming languages and calculi. Often the
-- Ott grammars one defines end up being ambiguous, and Ott signals
-- its displeasure by spewing forth several massive parse trees in a
-- format requiring formidable patience to read. Finding the slight
-- differences between two such parse trees is an exercise in
-- seizure-inducing tedium.
--
-- To the rescue comes ottparse-pretty! Simply paste in each parse
-- and it is shown to you in a nicely formatted tree form with all the
-- extra meaningless cruft removed.
--
-- For example, it turns this:
--
-- @
-- (St_node :formula:formula_judgement: (Ste_st (St_node :judgement:judgement_Jtype: (Ste_st (St_node :Jtype:coerce: (Ste_st (St_nonterm G)) (Ste_st (St_nonterm g)) (Ste_st (St_node :s:T_MultiTypeApp: (Ste_st (St_node :s:T_EqTy: (Ste_st (St_node :s:T_MultiTypeApp: (Ste_st (St_node :s:T_MultiKindApp: (Ste_st (St_node :s:T_Cons: (Ste_st (St_nonterm H)))) (Ste_st (St_nonterm k)))) (Ste_st (St_nonterm t)))) (Ste_st (St_node :s:T_MultiKindApp: (Ste_st (St_node :s:T_Cons: (Ste_st (St_nonterm H)))) (Ste_st (St_nonterm k)))))) (Ste_st (St_nonterm t')))))))))
-- @
--
-- into this:
--
-- @
-- formula_judgement
-- |
-- `- judgement_Jtype
-- |
-- `- coerce
-- |
-- +- G
-- |
-- +- g
-- |
-- `- T_MultiTypeApp
-- |
-- +- T_EqTy
-- | |
-- | +- T_MultiTypeApp
-- | | |
-- | | +- T_MultiKindApp
-- | | | |
-- | | | +- T_Cons
-- | | | | |
-- | | | | `- H
-- | | | |
-- | | | `- k
-- | | |
-- | | `- t
-- | |
-- | `- T_MultiKindApp
-- | |
-- | +- T_Cons
-- | | |
-- | | `- H
-- | |
-- | `- k
-- |
-- `- t'
-- @
--
-----------------------------------------------------------------------------
import Text.Ott.Pretty
import System.IO (hSetBuffering, BufferMode(..), stdout)
import Control.Monad (forever)
import Text.Parsec (runParser)
import Data.Tree (drawTree)
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
forever interpTree
interpTree :: IO ()
interpTree = do
putStr "> "
tStr <- getLine
case runParser parseTree () "" tStr of
Left err -> print err
Right t -> putStr $ drawTree (normalizeTree t)