1 -- this is from ghc/syslib-ghc originally, 
    2 
    3 
    4 
    5 
    6 
    7 
    8 
    9 
   10 
   11 
   12 
   13 
   14 
   15 module CharSeq (
   16         CSeq,
   17         cNil, cAppend, cIndent, cNL, cStr, cPStr, cCh, cInt,
   18 
   19         cLength,
   20         cShows,
   21 
   22         cShow
   23 
   24 
   25    ) where
   26 
   27 
   28 cShow   :: CSeq -> [Char]
   29 
   30 
   31 -- not used in GHC
   32 cShows  :: CSeq -> ShowS
   33 cLength :: CSeq -> Int
   34 
   35 
   36 cNil    :: CSeq
   37 cAppend :: CSeq -> CSeq -> CSeq
   38 cIndent :: Int -> CSeq -> CSeq
   39 cNL     :: CSeq
   40 cStr    :: [Char] -> CSeq
   41 cPStr   :: String -> CSeq
   42 cCh     :: Char -> CSeq
   43 cInt    :: Int -> CSeq
   44 
   45 
   46 
   47 data CSeq
   48   = CNil
   49   | CAppend     CSeq CSeq
   50   | CIndent     Int  CSeq
   51   | CNewline         -- Move to start of next line, unless we're
   52                           -- already at the start of a line.
   53   | CStr        [Char]
   54   | CCh         Char
   55   | CInt        Int    -- equiv to "CStr (show the_int)"
   56 
   57 
   58 cNil = CNil
   59 
   60 -- cAppend CNil cs2  = cs2
   61 -- cAppend cs1  CNil = cs1
   62 
   63 cAppend cs1 cs2 = CAppend cs1 cs2
   64 
   65 cIndent n cs = CIndent n cs
   66 
   67 cNL     = CNewline
   68 cStr    = CStr
   69 cCh     = CCh
   70 cInt    = CInt
   71 
   72 
   73 cPStr   = CStr
   74 
   75 
   76 cShow  seq      = flatten (0) True seq []
   77 
   78 
   79 cShows seq rest = cShow seq ++ rest
   80 cLength seq = length (cShow seq) -- *not* the best way to do this!
   81 
   82 
   83 data WorkItem = WI Int CSeq -- indentation, and sequence
   84 
   85 flatten :: Int  -- Indentation
   86         -> Bool        -- True => just had a newline
   87         -> CSeq               -- Current seq to flatten
   88         -> [WorkItem]  -- Work list with indentation
   89         -> String
   90 
   91 flatten n nlp CNil seqs = flattenS nlp seqs
   92 
   93 flatten n nlp (CAppend seq1 seq2) seqs = flatten n nlp seq1 ((WI n seq2) : seqs)
   94 flatten n nlp (CIndent (n2) seq) seqs = flatten (n2 + n) nlp seq seqs
   95 
   96 flatten n False CNewline seqs = '\n' : flattenS True seqs
   97 flatten n True  CNewline seqs = flattenS True seqs      -- Already at start of line
   98 
   99 flatten n False (CStr s) seqs = s ++ flattenS False seqs
  100 flatten n False (CCh  c) seqs = c :  flattenS False seqs
  101 flatten n False (CInt i) seqs = show i ++ flattenS False seqs
  102 
  103 
  104 flatten n True  (CStr s) seqs = mkIndent n (s ++ flattenS False seqs)
  105 flatten n True  (CCh  c) seqs = mkIndent n (c :  flattenS False seqs)
  106 flatten n True  (CInt i) seqs = mkIndent n (show i ++ flattenS False seqs)
  107 
  108 
  109 flattenS :: Bool -> [WorkItem] -> String
  110 flattenS nlp [] = ""
  111 flattenS nlp ((WI col seq):seqs) = flatten col nlp seq seqs
  112 
  113 mkIndent :: Int -> String -> String
  114 mkIndent (0) s = s
  115 mkIndent n       s
  116   = if (n >= (8))
  117     then '\t' : mkIndent (n - (8)) s
  118     else ' '  : mkIndent (n - (1)) s
  119     -- Hmm.. a little Unix-y.
  120 
  121 
  122