packages feed

haskeline 0.6.4.6 → 0.6.4.7

raw patch · 10 files changed

+111/−114 lines, 10 filesdep ~bytestringdep ~containersdep ~mtlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, containers, mtl

API changes (from Hackage documentation)

Files

System/Console/Haskeline/Backend/IConv.hsc view
@@ -91,7 +91,7 @@ type IConvT = ForeignPtr () type IConvTPtr = Ptr () -foreign import ccall "h_iconv_open" iconv_open+foreign import ccall "haskeline_iconv_open" iconv_open     :: CString -> CString -> IO IConvTPtr  iconvOpen :: String -> String -> IO IConvT@@ -105,9 +105,9 @@                                     else newForeignPtr iconv_close res  -- really this returns a CInt, but it's easiest to just ignore that, I think.-foreign import ccall "& h_iconv_close" iconv_close :: FunPtr (IConvTPtr -> IO ())+foreign import ccall "& haskeline_iconv_close" iconv_close :: FunPtr (IConvTPtr -> IO ()) -foreign import ccall "h_iconv" c_iconv :: IConvTPtr -> Ptr CString -> Ptr CSize+foreign import ccall "haskeline_iconv" c_iconv :: IConvTPtr -> Ptr CString -> Ptr CSize                             -> Ptr CString -> Ptr CSize -> IO CSize  data Result = Successful
System/Console/Haskeline/Backend/Terminfo.hs view
@@ -6,7 +6,7 @@  import System.Console.Terminfo import Control.Monad-import Data.List(intersperse, foldl')+import Data.List(foldl') import System.IO import qualified Control.Exception.Extensible as Exception import qualified Data.ByteString.Char8 as B@@ -21,6 +21,8 @@ import System.Console.Haskeline.Backend.WCWidth import System.Console.Haskeline.Key +import qualified Control.Monad.Writer as Writer+ ---------------------------------------------------------------- -- Low-level terminal output @@ -66,30 +68,6 @@     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 @@ -121,8 +99,6 @@ lookupCells :: TermRows -> Int -> Int lookupCells (TermRows rc _) r = Map.findWithDefault 0 r rc -sum' :: [Int] -> Int- newtype Draw m a = Draw {unDraw :: (ReaderT Actions                                     (ReaderT Terminal                                     (StateT TermRows@@ -133,8 +109,6 @@               MonadState TermRows,               MonadReader Handles, MonadReader Encoders) -type DrawM a = forall m . (MonadReader Layout m, MonadIO m) => Draw m a- instance MonadTrans Draw where     lift = Draw . lift . lift . lift . lift . lift . lift     @@ -198,41 +172,80 @@                 ]      -output :: MonadIO m => TermAction -> Draw m ()-output f = do-    toutput <- asks f++----------------------------------------------------------------+-- Terminal output actions+--+-- We combine all of the drawing commands into one big TermAction,+-- via a writer monad, and then output them all at once.+-- 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++runActionT :: MonadIO m => ActionT (Draw m) a -> Draw m a+runActionT m = do+    (x,action) <- Writer.runWriterT m+    toutput <- asks action     term <- ask     ttyh <- liftM hOut ask     liftIO $ hRunTermOutput ttyh term toutput+    return x +output :: TermAction -> ActionM ()+output = Writer.tell -------------------------------------------------------------------- Movement actions+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}     | r1 == r2 = if c1 < c2 then right (c2-c1) else left (c1-c2)     | r1 > r2 = cr <#> up (r1-r2) <#> right c2     | otherwise = cr <#> mreplicate (r2-r1) nl <#> right c2 --- TODO: when drawLineDiffT calls this, shouldn't move if same.-moveToPos :: TermPos -> DrawM TermAction+moveToPos :: TermPos -> ActionM () moveToPos p = do     oldP <- get     put p-    return $ changePos oldP p+    output $ changePos oldP p -moveRelative :: Int -> DrawM ()+moveRelative :: Int -> ActionM () moveRelative n = liftM3 (advancePos n) ask get get-                    >>= moveToPos >>= output+                    >>= moveToPos  -- Note that these move by a certain number of cells, not graphemes.-changeRight, changeLeft :: Int -> DrawM ()+changeRight, changeLeft :: Int -> ActionM () changeRight n   | n <= 0 = return ()                 | otherwise = moveRelative n changeLeft n    | n <= 0 = return ()                 | otherwise = moveRelative (negate n) + -- TODO: this could be more efficient by only checking intermediate rows. -- TODO: this is worth handling with QuickCheck. advancePos :: Int -> Layout -> TermRows -> TermPos -> TermPos@@ -250,98 +263,83 @@                 then TermPos {termRow=r, termCol=m}                 else loopFindRow (r+1) (m-thisRowSize) +sum' :: [Int] -> Int sum' = foldl' (+) 0  ---------------------------------------------------------------- -- Text printing actions -encodeGraphemes :: MonadIO m => [Grapheme] -> Draw m TermAction-encodeGraphemes = liftM text . posixEncode . graphemesToString--printText :: [Grapheme] -> DrawM TermAction-printText = textAction mempty--textAction :: TermAction -> [Grapheme] -> DrawM TermAction-textAction prevOutput [] = return prevOutput-textAction prevOutput gs = do+printText :: [Grapheme] -> ActionM ()+printText [] = return ()+printText gs = do     -- First, get the monadic parameters:     w <- asks width     TermPos {termRow=r, termCol=c} <- get     -- Now, split off as much as will fit on the rest of this row:     let (thisLine,rest,thisWidth) = splitAtWidth (w-c) gs     let lineWidth = c + thisWidth-    ts <- encodeGraphemes thisLine     -- Finally, actually print out the relevant text.+    outputText (graphemesToString thisLine)     modify $ setRow r lineWidth     if null rest && lineWidth < w-        then do -- everything fits on one line without wrapping+        then  -- everything fits on one line without wrapping             put TermPos {termRow=r, termCol=lineWidth}-            return (prevOutput <#> ts)         else do -- Must wrap to the next line             put TermPos {termRow=r+1,termCol=0}-            let wrap = if lineWidth == w then wrapLine else spaces (w-lineWidth)-            textAction (prevOutput <#> ts <#> wrap) rest+            output $ if lineWidth == w then wrapLine else spaces (w-lineWidth)+            printText rest  ---------------------------------------------------------------- -- High-level Term implementation------ To prevent flicker, we combine all of the drawing commands into one big--- TermAction, and output them all at once. -drawLineDiffT :: LineChars -> LineChars -> DrawM ()+drawLineDiffT :: LineChars -> LineChars -> ActionM () drawLineDiffT (xs1,ys1) (xs2,ys2) = case matchInit xs1 xs2 of     ([],[])     | ys1 == ys2            -> return ()     (xs1',[])   | xs1' ++ ys1 == ys2    -> changeLeft (gsWidth xs1')     ([],xs2')   | ys1 == xs2' ++ ys2    -> changeRight (gsWidth xs2')     (xs1',xs2')                         -> do         oldRS <- get-        -- TODO: this changeLeft could be merged with the rest of the output.-        -- For now, we'll leave it separate since xs1' is often empty-        -- (e.g. when typing new characters).         changeLeft (gsWidth xs1')-        xsOut <- printText xs2'+        printText xs2'         p <- get-        restOut <- liftM mconcat $ sequence-                        [ printText ys2-                        , clearDeadText oldRS-                        , moveToPos p-                        ]-        output (xsOut <#> restOut)+        printText ys2+        clearDeadText oldRS+        moveToPos p  -- The number of nonempty lines after the current row position.-getLinesLeft :: DrawM Int+getLinesLeft :: ActionM Int getLinesLeft = do     p <- get     rc <- get     return $ max 0 (lastRow rc - termRow p) -clearDeadText :: TermRows -> DrawM TermAction+clearDeadText :: TermRows -> ActionM () clearDeadText oldRS = do     TermPos {termRow = r, termCol = c} <- get     let extraRows = lastRow oldRS - r     if extraRows < 0             || (extraRows == 0 && lookupCells oldRS r <= c)-        then return mempty+        then return ()         else do             modify $ setRow r c             when (extraRows /= 0)                 $ put TermPos {termRow = r + extraRows, termCol=0}-            return $ clearToLineEnd <#> mreplicate extraRows (nl <#> clearToLineEnd)+            output $ clearToLineEnd <#> mreplicate extraRows (nl <#> clearToLineEnd) -clearLayoutT :: DrawM ()+clearLayoutT :: ActionM () clearLayoutT = do     h <- asks height     output (clearAll h)     put initTermPos -moveToNextLineT :: LineChars -> DrawM ()-moveToNextLineT _ = do+moveToNextLineT :: ActionM ()+moveToNextLineT = do     lleft <- getLinesLeft     output $ mreplicate (lleft+1) nl     put initTermPos     put initTermRows -repositionT :: Layout -> LineChars -> DrawM ()+repositionT :: Layout -> LineChars -> ActionM () repositionT _ s = do     oldPos <- get     l <- getLinesLeft@@ -352,14 +350,13 @@     drawLineDiffT ([],[]) s  instance (MonadException m, MonadReader Layout m) => Term (Draw m) where-    drawLineDiff = drawLineDiffT-    reposition = repositionT+    drawLineDiff xs ys = runActionT $ drawLineDiffT xs ys+    reposition layout lc = runActionT $ repositionT layout lc     -    printLines [] = return ()-    printLines ls = do-        bls <- mapM posixEncode ls-        output $ mconcat $ intersperse nl (map text bls) ++ [nl]-    clearLayout = clearLayoutT-    moveToNextLine = moveToNextLineT-    ringBell True = output bellAudible-    ringBell False = output bellVisual+    printLines = mapM_ $ \line -> runActionT $ do+                                    outputText line+                                    output nl+    clearLayout = runActionT clearLayoutT+    moveToNextLine _ = runActionT moveToNextLineT+    ringBell True = runActionT $ output bellAudible+    ringBell False = runActionT $ output bellVisual
System/Console/Haskeline/Backend/WCWidth.hs view
@@ -13,10 +13,10 @@ import Data.List import Foreign.C.Types -foreign import ccall unsafe mk_wcwidth :: CWchar -> CInt+foreign import ccall unsafe haskeline_mk_wcwidth :: CWchar -> CInt  wcwidth :: Char -> Int-wcwidth c = case mk_wcwidth $ toEnum $ fromEnum c of+wcwidth c = case haskeline_mk_wcwidth $ toEnum $ fromEnum c of                 -1 -> 0 -- Control characters have zero width.  (Used by the                         -- "\SOH...\STX" hack in LineState.stringToGraphemes.)                 w -> fromIntegral w
System/Console/Haskeline/Backend/Win32.hsc view
@@ -170,7 +170,7 @@         (#poke COORD, Y) p (toEnum (coordY c) :: CShort)
                 
                             
-foreign import ccall "SetPosition"
+foreign import ccall "haskeline_SetPosition"
     c_SetPosition :: HANDLE -> Ptr Coord -> IO Bool
     
 setPosition :: HANDLE -> Coord -> IO ()
cbits/h_iconv.c view
@@ -1,15 +1,15 @@ #include "h_iconv.h"  // Wrapper functions, since iconv_open et al are macros in libiconv.-iconv_t h_iconv_open(const char *tocode, const char *fromcode) {+iconv_t haskeline_iconv_open(const char *tocode, const char *fromcode) {     return iconv_open(tocode, fromcode); } -void h_iconv_close(iconv_t cd) {+void haskeline_iconv_close(iconv_t cd) {     iconv_close(cd); } -size_t h_iconv(iconv_t cd, char **inbuf, size_t *inbytesleft,+size_t haskeline_iconv(iconv_t cd, char **inbuf, size_t *inbytesleft,                 char **outbuf, size_t *outbytesleft) {     // Cast inbuf to (void*) so that it works both on Solaris, which expects     // a (const char**), and on other platforms (e.g. Linux), which expect
cbits/h_wcwidth.c view
@@ -67,7 +67,7 @@ };  /* auxiliary function for binary search in interval table */-static int bisearch(wchar_t ucs, const struct interval *table, int max) {+static int haskeline_bisearch(wchar_t ucs, const struct interval *table, int max) {   int min = 0;   int mid; @@ -119,7 +119,7 @@  * in ISO 10646.  */ -int mk_wcwidth(wchar_t ucs)+int haskeline_mk_wcwidth(wchar_t ucs) {   /* sorted list of non-overlapping intervals of non-spacing characters */   /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */@@ -181,7 +181,7 @@     return -1;    /* binary search in table of non-spacing characters */-  if (bisearch(ucs, combining,+  if (haskeline_bisearch(ucs, combining, 	       sizeof(combining) / sizeof(struct interval) - 1))     return 0; @@ -204,12 +204,12 @@ }  -int mk_wcswidth(const wchar_t *pwcs, size_t n)+int haskeline_mk_wcswidth(const wchar_t *pwcs, size_t n) {   int w, width = 0;    for (;*pwcs && n-- > 0; pwcs++)-    if ((w = mk_wcwidth(*pwcs)) < 0)+    if ((w = haskeline_mk_wcwidth(*pwcs)) < 0)       return -1;     else       width += w;@@ -227,7 +227,7 @@  * the traditional terminal character-width behaviour. It is not  * otherwise recommended for general use.  */-int mk_wcwidth_cjk(wchar_t ucs)+int haskeline_mk_wcwidth_cjk(wchar_t ucs) {   /* sorted list of non-overlapping intervals of East Asian Ambiguous    * characters, generated by "uniset +WIDTH-A -cat=Me -cat=Mn -cat=Cf c" */@@ -287,20 +287,20 @@   };    /* binary search in table of non-spacing characters */-  if (bisearch(ucs, ambiguous,+  if (haskeline_bisearch(ucs, ambiguous, 	       sizeof(ambiguous) / sizeof(struct interval) - 1))     return 2; -  return mk_wcwidth(ucs);+  return haskeline_mk_wcwidth(ucs); }  -int mk_wcswidth_cjk(const wchar_t *pwcs, size_t n)+int haskeline_mk_wcswidth_cjk(const wchar_t *pwcs, size_t n) {   int w, width = 0;    for (;*pwcs && n-- > 0; pwcs++)-    if ((w = mk_wcwidth_cjk(*pwcs)) < 0)+    if ((w = haskeline_mk_wcwidth_cjk(*pwcs)) < 0)       return -1;     else       width += w;
cbits/win_console.c view
@@ -1,5 +1,5 @@ #include "win_console.h" -BOOL SetPosition(HANDLE h, COORD* c) {+BOOL haskeline_SetPosition(HANDLE h, COORD* c) {     return SetConsoleCursorPosition(h,*c); }
haskeline.cabal view
@@ -1,6 +1,6 @@ Name:           haskeline Cabal-Version:  >=1.6-Version:        0.6.4.6+Version:        0.6.4.7 Category:       User Interfaces License:        BSD3 License-File:   LICENSE@@ -50,15 +50,15 @@     }     else {         if impl(ghc>=6.11) {-            Build-depends: base >=4.1 && < 4.6, containers>=0.1 && < 0.5, directory>=1.0 && < 1.2,-                           bytestring==0.9.*+            Build-depends: base >=4.1 && < 4.6, containers>=0.1 && < 0.6, directory>=1.0 && < 1.2,+                           bytestring>=0.9 && < 0.11         }         else {             Build-depends: base>=3 && <4.1 , containers>=0.1 && < 0.3, directory==1.0.*,                            bytestring==0.9.*         }     }-    Build-depends:  filepath >= 1.1 && < 1.4, mtl >= 1.1 && < 2.1,+    Build-depends:  filepath >= 1.1 && < 1.4, mtl >= 1.1 && < 2.2,                     utf8-string==0.3.* && >=0.3.6,                     extensible-exceptions==0.1.* && >=0.1.1.0     Extensions:     ForeignFunctionInterface, Rank2Types, FlexibleInstances,
includes/h_iconv.h view
@@ -1,9 +1,9 @@ #include <iconv.h> -iconv_t h_iconv_open(const char *tocode, const char *fromcode);+iconv_t haskeline_iconv_open(const char *tocode, const char *fromcode); -void h_iconv_close(iconv_t cd);+void haskeline_iconv_close(iconv_t cd); -size_t h_iconv(iconv_t cd, char **inbuf, size_t *inbytesleft,+size_t haskeline_iconv(iconv_t cd, char **inbuf, size_t *inbytesleft,                 char **outbuf, size_t *outbytesleft);
includes/win_console.h view
@@ -2,6 +2,6 @@ #define _WIN_CONSOLE_H #include <windows.h> -BOOL SetPosition(HANDLE h, COORD* c);+BOOL haskeline_SetPosition(HANDLE h, COORD* c);  #endif