[commit: haskeline] master: Refactor: move all terminfo output encoding into a single place. (e269604)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/haskeline

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/e269604b33b44d9a02d172f31e07d57f77929cc2

>---------------------------------------------------------------

commit e269604b33b44d9a02d172f31e07d57f77929cc2
Author: Judah Jacobson <judah.jacobson at gmail.com>
Date:   Fri Mar 23 18:59:45 2012 +0000

    Refactor: move all terminfo output encoding into a single place.

>---------------------------------------------------------------

 System/Console/Haskeline/Backend/Terminfo.hs |   62 ++++++++++++--------------
 1 files changed, 29 insertions(+), 33 deletions(-)

diff --git a/System/Console/Haskeline/Backend/Terminfo.hs b/System/Console/Haskeline/Backend/Terminfo.hs
index 4f77704..1b180cf 100644
--- a/System/Console/Haskeline/Backend/Terminfo.hs
+++ b/System/Console/Haskeline/Backend/Terminfo.hs
@@ -6,7 +6,7 @@ module System.Console.Haskeline.Backend.Terminfo(
 
 import System.Console.Terminfo
 import Control.Monad
-import Data.List(intersperse, foldl')
+import Data.List(foldl')
 import System.IO
 import qualified Control.Exception as Exception
 import qualified Data.ByteString.Char8 as B
@@ -68,30 +68,6 @@ getWrapLine left1 = (do
     return (termText " " <#> left1)
     ) `mplus` return mempty
 
-type TermAction = Actions -> TermOutput
-    
-text :: B.ByteString -> TermAction
-text str _ = termText $ B.unpack str
-
-left,right,up :: Int -> TermAction
-left = flip leftA
-right = flip rightA
-up = flip upA
-
-clearAll :: LinesAffected -> TermAction
-clearAll = flip clearAllA
-
-mreplicate :: Monoid m => Int -> m -> m
-mreplicate n m
-    | n <= 0    = mempty
-    | otherwise = m `mappend` mreplicate (n-1) m
-
--- We don't need to bother encoding the spaces.
-spaces :: Int -> TermAction
-spaces 0 = mempty
-spaces 1 = const $ termText " " -- share when possible
-spaces n = const $ termText $ replicate n ' '
-
 ----------------------------------------------------------------
 -- The Draw monad
 
@@ -205,6 +181,8 @@ terminfoKeys term = mapMaybe getSequence keyCapabilities
 -- This prevents flicker, i.e., the cursor appearing briefly
 -- in an intermediate position.
 
+type TermAction = Actions -> TermOutput
+
 type ActionT = Writer.WriterT TermAction
 
 type ActionM a = forall m . (MonadReader Layout m, MonadIO m) => ActionT (Draw m) a
@@ -221,6 +199,28 @@ runActionT m = do
 output :: TermAction -> ActionM ()
 output = Writer.tell
 
+outputText :: String -> ActionM ()
+outputText str = posixEncode str >>= output . const . termText . B.unpack
+
+left,right,up :: Int -> TermAction
+left = flip leftA
+right = flip rightA
+up = flip upA
+
+clearAll :: LinesAffected -> TermAction
+clearAll = flip clearAllA
+
+mreplicate :: Monoid m => Int -> m -> m
+mreplicate n m
+    | n <= 0    = mempty
+    | otherwise = m `mappend` mreplicate (n-1) m
+
+-- We don't need to bother encoding the spaces.
+spaces :: Int -> TermAction
+spaces 0 = mempty
+spaces 1 = const $ termText " " -- share when possible
+spaces n = const $ termText $ replicate n ' '
+
 
 changePos :: TermPos -> TermPos -> TermAction
 changePos TermPos {termRow=r1, termCol=c1} TermPos {termRow=r2, termCol=c2}
@@ -279,7 +279,7 @@ printText gs = do
     let (thisLine,rest,thisWidth) = splitAtWidth (w-c) gs
     let lineWidth = c + thisWidth
     -- Finally, actually print out the relevant text.
-    outputGraphemes thisLine
+    outputText (graphemesToString thisLine)
     modify $ setRow r lineWidth
     if null rest && lineWidth < w
         then  -- everything fits on one line without wrapping
@@ -288,9 +288,6 @@ printText gs = do
             put TermPos {termRow=r+1,termCol=0}
             output $ if lineWidth == w then wrapLine else spaces (w-lineWidth)
             printText rest
-  where
-    outputGraphemes thisLine = posixEncode (graphemesToString thisLine)
-                            >>= output . text
 
 ----------------------------------------------------------------
 -- High-level Term implementation
@@ -356,10 +353,9 @@ instance (MonadException m, MonadReader Layout m) => Term (Draw m) where
     drawLineDiff xs ys = runActionT $ drawLineDiffT xs ys
     reposition layout lc = runActionT $ repositionT layout lc
     
-    printLines [] = return ()
-    printLines ls = do
-        bls <- mapM posixEncode ls
-        runActionT $ output $ mconcat $ intersperse nl (map text bls) ++ [nl]
+    printLines = mapM_ $ \line -> runActionT $ do
+                                    outputText line
+                                    output nl
     clearLayout = runActionT clearLayoutT
     moveToNextLine _ = runActionT moveToNextLineT
     ringBell True = runActionT $ output bellAudible