1 module CharSeq (
    2       CSeq,
    3       cNil, cAppend, cIndent, cNL, cStr, cCh, -- cAbove, cBeside, cConcat,
    4       cShow
    5 )  where
    6 
    7 cShow   :: CSeq -> [Char]
    8 cNil    :: CSeq
    9 cAppend :: CSeq -> CSeq -> CSeq
   10 -- UNUSED: cConcat :: [CSeq] -> CSeq
   11 cIndent :: Int -> CSeq -> CSeq
   12 cNL     :: CSeq
   13 cStr    :: [Char] -> CSeq
   14 cCh     :: Char -> CSeq
   15 {- old:
   16 cAbove  :: CSeq -> CSeq -> CSeq       -- Separate them with a newline unless
   17                                 -- one or t'other is empty.
   18 cBeside :: CSeq -> CSeq -> CSeq       -- Similar; separates with a space.
   19 -}
   20 data CSeq = CNil
   21           | CAppend CSeq CSeq
   22           | CIndent Int CSeq
   23           | CNewline
   24           | CStr [Char]
   25           | CCh Char
   26           deriving ()
   27 cNil      = CNil
   28 -- cAppend CNil cs2  = cs2
   29 -- cAppend cs1  CNil = cs1
   30 cAppend cs1  cs2  = CAppend cs1 cs2
   31 -- cIndent n CNil = CNil
   32 cIndent n cs   = CIndent n cs
   33 
   34 cNL       = CNewline
   35 cStr      = CStr
   36 cCh       = CCh
   37 -- UNUSED: cConcat   = foldr cAppend CNil
   38 {- old:
   39 cAbove CNil cs2  = cs2
   40 cAbove cs1  cs2  = CAppend cs1 (case cs2 of CNil -> CNil; other -> CAppend CNewline cs2)
   41 -}
   42 {- old:
   43 cBeside CNil cs2
   44   = case cs2 of
   45       CIndent n cs3 -> CIndent (n-1) cs3
   46       other ->         cs2    -- oh well...
   47 
   48 cBeside cs1  cs2 = CAppend cs1 (case cs2 of CNil -> CNil; other -> CAppend (CCh ' ') cs2)
   49 -}
   50 cShow seq = flatten 0 True seq []
   51 flatten :: Int                -- Indentation
   52         -> Bool               -- True => just had a newline
   53         -> CSeq               -- Current seq to flatten
   54         -> [(Int,CSeq)]       -- Work list with indentation
   55         -> String
   56 flatten n nlp CNil seqs = flattenS nlp seqs
   57 flatten n nlp (CAppend seq1 seq2) seqs = flatten n nlp seq1 ((n,seq2) : seqs)
   58 flatten n nlp (CIndent n' seq) seqs = flatten (n'+n) nlp seq seqs
   59 flatten n nlp CNewline seqs = '\n' : flattenS True seqs
   60 flatten n False (CStr s) seqs = s ++ flattenS False seqs
   61 flatten n False (CCh c)  seqs = c :  flattenS False seqs
   62 flatten n True  (CStr s) seqs = mkIndent n (s ++ flattenS False seqs)
   63 flatten n True  (CCh c)  seqs = mkIndent n (c :  flattenS False seqs)
   64 flattenS :: Bool -> [(Int, CSeq)] -> String
   65 flattenS nlp [] = ""
   66 flattenS nlp ((col,seq):seqs) = flatten col nlp seq seqs
   67 mkIndent :: Int -> String -> String
   68 mkIndent 0 s = s
   69 mkIndent n s
   70  = if (n >= 8) then '\t' : mkIndent (n-8) s
   71                else ' '  : mkIndent (n-1) s
   72 -- A little Unix-y; ToDo: something?