[project @ 2003-07-31 17:45:22 by ross]

[ghc-base.git] / Text / ParserCombinators / Parsec / examples / Mondrian / Pretty.hs

diff --git a/Text/ParserCombinators/Parsec/examples/Mondrian/Pretty.hs b/Text/ParserCombinators/Parsec/examples/Mondrian/Pretty.hs
deleted file mode 100644 (file)
index 5b399e8..0000000
--- a/Text/ParserCombinators/Parsec/examples/Mondrian/Pretty.hs
+++ /dev/null
@@ -1,161 +0,0 @@
-{-
-Copyright(C) 1999 Erik Meijer
--}
-module Pretty where
-
-{-
-
-Quick reference for the simple Pretty-print Combinators
-
-  |---|     |----|   |-------|
-  |koe| <|> |beer| = |koebeer|
-  |---|     |----|   |-------|
-
-  |---|     |----|   |--------|
-  |koe| <+> |beer| = |koe beer|
-  |---|     |----|   |--------|
-
-  |---|     |----|   |----|
-  |koe| <-> |beer| = |koe |
-  |---|     |----|   |beer|
-                     |----|
-
-  |---|            |----|   |-------|
-  |koe| <|> nest 2 |beer| = |koebeer|
-  |---|            |----|   |-------|
-
-  |---|            |----|   |------|
-  |koe| <-> nest 2 |beer| = |koe   |
-  |---|            |----|   |  beer|
-                            |------|
-                            
-  empty =                            
--}
-
-{-
-
-Extremely simplified version of John Hughes' combinators, 
-without (sep), but with (empty).
-
-TODO: use Okasaki-style catenable dequeues to represent Doc
-
-(c) Erik Meijer and Arjan van IJzendoorn
-
-October 199
-
--}
-
-infixl 7 <+>
-infixl 6 <|>
-infixr 5 <->
-  
-instance Show Doc where
-  { showsPrec = showsPrecDoc }
-
-showsPrecDoc i = \d ->
-  case d of
-    { Empty -> id
-    ; Doc ds -> layout ds
-    }
- 
-data Doc
-  = Doc [(Int,ShowS)]
-  | Empty
-  
-layout :: [(Int,ShowS)] -> ShowS
-layout = \ds ->
-  case ds of
-    { []       -> showString ""
-    ; [(n,s)]  -> indent n.s
-    ; (n,s):ds -> indent n.s.showString "\n".layout ds
-    }
-
-width :: Doc -> Int
-width = \d ->
-  case d of
-    { Empty -> 0
-    ; Doc ds -> maximum [ i + length (s "") | (i,s) <- ds ]
-    }
-  
-text :: String -> Doc
-text = \s -> Doc [(0,showString s)]
-
-nest :: Int -> Doc -> Doc
-nest n = \d ->
-  case d of
-    { Empty -> Empty
-    ; Doc ds -> Doc [ (i+n,d) | (i,d) <- ds ]
-    }
-
-(<->) :: Doc -> Doc -> Doc
-Empty <-> Empty = Empty
-Empty <-> (Doc d2) = Doc d2
-(Doc d1) <-> Empty = Doc d1
-(Doc d1) <-> (Doc d2) = Doc (d1++d2)
-
-(<+>) :: Doc -> Doc -> Doc
-a <+> b = a <|> (text " ") <|> b
-
-(<|>) :: Doc -> Doc -> Doc
-Empty <|> Empty = Empty
-Empty <|> (Doc d2) = Doc d2
-(Doc d1) <|> Empty = Doc d1
-(Doc d1) <|> (Doc d2) =
-  let 
-    { (d,(i,s)) = (init d1,last d1)
-    ; ((j,t),e) = (head d2,tail d2)
-    }
-  in
-    (    Doc d 
-     <-> Doc [(i,s.t)] 
-     <-> nest (i + length (s "") - j) (Doc e)
-    )
-    
--- Derived operations
-
-empty :: Doc
-empty = Empty
-
-{-
-
-horizontal s [a,b,c] =
-  a <|> (s <|> b) <|> (s <|> c)
-
--}
-
-horizontal :: Doc -> [Doc] -> Doc
-horizontal s = \ds ->
-  case ds of
-    { [] -> empty
-    ; ds -> foldr1 (\d -> \ds -> d <|> s <|> ds) ds
-    }
-
-{-
-
-vertical s [a,b,c] =
-  a
-  <->
-  (s <|> b)
-  <->
-  (s <|> c)
-
--}
-
-vertical :: [Doc] -> Doc
-vertical = \ds ->
-  case ds of
-    { [] -> empty
-    ; d:ds -> d <-> vertical ds
-    }
-
-block (o,s,c) = \ds ->
-  case ds of
-    { [] -> o<|>c
-    ; [d] -> o<|>d<|>c\r    ; d:ds -> (vertical ((o <|> d):[s <|> d | d <- ds ])) <-> c
-    }
-    
--- Helper function
-
-indent :: Int -> ShowS
-indent = \n ->
-  showString [ ' ' | i <- [1..n] ]