[Haskell-cafe] Re: Knot tying vs monads

[ChrisK]

John D. Ramsdell wrote:
 On Nov 17, 2007 3:04 PM, apfelmus <apfelmus at quantentunnel.de
 <mailto:apfelmus at quantentunnel.de>> wrote:

     Unfortunately, I don't have Paulson's book (or any other ML book :) at
     home. I'm too lazy to figure out the specification from the source code,

 I guess the code is too opaque, as my colleague claimed.

Yes, a bit opaque.  The variable names are not descriptive enough and not
documented.  I have just rewritten your code with mostly trivial changes all of
which clarify what the code is doing in each expression.

For instance, blocksize and space* were both measured relative to "margin"
instead of simply using the column number.

The file is both att

> {-# LANGUAGE BangPatterns #-}
> 
> -- Author: Chris Kuklewicz
> --
> -- This is a rewrite of John D. Ramsdell Pretty.hs code on
> -- haskell-cafe mailing list
> 
> -- Changelog from Pretty.hs
> -- All Pretty elements have a length field (lazy at the moment)
> -- Inlined logic of 'blanks' and used new 'prepend' instead
> -- Replaced blocksize by startColumn == margin - blocksize
> -- Replaced space by colunmIn == margin-space
> -- Documented what 'after' means
> module Blocks(Pretty,str,brk,spc,blo,cat,pr) where
> 
> -- All of the len's are non-negative, guaranteed by smart constructors
> data Pretty = Str { len :: Int, string :: String}
>             | Brk { len :: Int }
>             | Blo { len :: Int,  indentBy :: Int, parts :: [Pretty] }
> 
> str s = Str (length s) s
> 
> brk n | n < 0 = error ("Cannot have negative width brk! n = " ++ show n)
>       | otherwise = Brk n
> 
> spc = brk 1
> 
> blo indent es | indent < 0 = error ("Cannot have negative width blo! indent = " ++ show indent)
>               | otherwise = Blo (sum (map len es)) indent es
> 
> cat = blo 0
> 
> {-# INLINE pr #-}
> pr :: Int -> Pretty -> (String->String)
> pr margin e sRest  = let {startColumn = 0; after = 0; columnIn = 0}
>                      in snd (printing margin startColumn after [e] (columnIn, sRest))
> 
> {-# INLINE printing #-}
> printing :: Int -> Int -> Int -> [Pretty] -> (Int,String) -> (Int,String)
> -- margin is the desired maximum line length and must be non-negative
> -- startColumn, columnIn, column', and columnOut are all non-negative,
> -- but any of them may be greater than margin
> printing margin | margin < 0 = error ("Cannot have non-positive margin! margin == "++show margin)
>                 | otherwise = block where
> 
>   -- startColumn is the "current amount of indent after newline"
>   -- after is how much must be laid after the (e:es) and before the next break, non-negative
>   block !startColumn !after = layout where
> 
>     -- (e:es) are the items to layout before 'sIn'
>     -- columnIn is the starting column for laying out 'e'
>     -- columnOut is the column after the (e:es) have been laid out
>     layout [] columnIn'sIn'pair = columnIn'sIn'pair
>     layout (e:es) (!columnIn,sIn) = (columnOut,sOut)  where
> 
>       (columnOut,s') = layout es (column',sIn)
> 
>       -- column' is the column to use after when laying out es, after laying out e
>       (column',sOut) =
>         case e of
>           Str n str -> (columnIn+n, showString str s')
>           Brk n | columnIn + n + breakDist es after <= margin -> (columnIn+n, prepend n ' ' s')
>                 | 0 <= startColumn -> (startColumn, '\n':prepend startColumn ' ' s')
>                 | otherwise -> (0, '\n':s')
>           Blo _n  indent es' -> let startColumn' = indent + columnIn
>                                     after' = breakDist es after
>                                 in block startColumn' after' es' (columnIn,s')
> 
> -- Trivial helper function to prepend 'n' copies of character 'c'
> {-# INLINE prepend #-}
> prepend n c s | n < 0 = error ("prepend called with "++show n++" < 0 !")
>               | otherwise = loop n where loop 0 = s
>                                          loop n = c : loop (pred n)
> 
> -- after >=0 implies breakDist _ after >= 0
> -- Note that contained Blo's are assumed to layout in one line without using any internal breaks.
> breakDist :: [Pretty] -> Int -> Int
> breakDist esIn !after = accum esIn 0 where
>   accum []         beforeBrk = beforeBrk + after
>   accum (Brk {}:_) beforeBrk = beforeBrk
>   accum (e : es)   beforeBrk = accum es (beforeBrk + len e)
> 
> test1 = putStrLn $
>   pr 5 (blo 3 [str "Hello",spc,str "World!"
>               ,blo 3 [str "Goodbye",spc,str "Space!"]
>               ,spc,cat [str "The",spc,str "End"]]) ""
> 
> test2 = putStrLn $
>   pr 12 (blo 3 [str "Hello",spc,str "World!",spc
>                ,blo 3 [str "Goodbye",spc,str "Space!"]
>                ,spc,cat [str "The",spc,str "End"]]) ""
> 
> test3 = putStrLn $
>   pr 12 (blo 3 [str "Hello",spc,str "World!"
>                ,blo 3 [str "Goodbye",spc,str "Space!"]
>                ,spc,cat [str "The",spc,str "End"]]) ""
> 
> 
> {-
> *Blocks> test1
> Hello
>    World!Goodbye
>             Space!
>    The
>    End
> *Blocks> test2
> Hello World!
>    Goodbye
>       Space!
>    The End
> *Blocks> test3
> Hello
>    World!Goodbye
>             Space!
>    The End
> -}