Sign Up
Log In
Log In
or
Sign Up
Places
All Projects
Status Monitor
Collapse sidebar
openSUSE:Leap:42.2:Ports
ghc
u_haskeline_update.patch
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File u_haskeline_update.patch of Package ghc
diff --git a/ghc-7.10.3.orig/libraries/haskeline/Changelog b/ghc-7.10.3/libraries/haskeline/Changelog index 5cb7cc5..7b1f5e2 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/Changelog +++ b/ghc-7.10.3/libraries/haskeline/Changelog @@ -1,3 +1,15 @@ +Changed in version 0.7.2.3: + * Fix hsc2hs-related warning on ghc-8 + * Fix the behavior of ctrl-W in the emacs bindings + * Point to github instead of trac + +Changed in version 0.7.2.2: + * Fix Linux to Windows cross-compile + * Canonicalize AMP instances to make the code more future proof + * Generalize constraints for InputT instances + * Bump upper bounds on base and transformers + * Make Haskeline `-Wtabs` clean + Changed in version 0.7.2.1: * Fix build on Windows. diff --git a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Backend/Win32.hsc b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Backend/Win32.hsc index 61c9ab2..d9c0934 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Backend/Win32.hsc +++ b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Backend/Win32.hsc @@ -1,546 +1,548 @@ -module System.Console.Haskeline.Backend.Win32( - win32Term, - win32TermStdin, - fileRunTerm - )where - - -import System.IO -import Foreign -import Foreign.C -import System.Win32 hiding (multiByteToWideChar) -import Graphics.Win32.Misc(getStdHandle, sTD_OUTPUT_HANDLE) -import Data.List(intercalate) -import Control.Concurrent hiding (throwTo) -import Data.Char(isPrint) -import Data.Maybe(mapMaybe) -import Control.Applicative -import Control.Monad - -import System.Console.Haskeline.Key -import System.Console.Haskeline.Monads hiding (Handler) -import System.Console.Haskeline.LineState -import System.Console.Haskeline.Term -import System.Console.Haskeline.Backend.WCWidth - -import Data.ByteString.Internal (createAndTrim) -import qualified Data.ByteString as B - -##if defined(i386_HOST_ARCH) -## define WINDOWS_CCONV stdcall -##elif defined(x86_64_HOST_ARCH) -## define WINDOWS_CCONV ccall -##else -## error Unknown mingw32 arch -##endif - -#include "win_console.h" - -foreign import WINDOWS_CCONV "windows.h ReadConsoleInputW" c_ReadConsoleInput - :: HANDLE -> Ptr () -> DWORD -> Ptr DWORD -> IO Bool - -foreign import WINDOWS_CCONV "windows.h WaitForSingleObject" c_WaitForSingleObject - :: HANDLE -> DWORD -> IO DWORD - -foreign import WINDOWS_CCONV "windows.h GetNumberOfConsoleInputEvents" - c_GetNumberOfConsoleInputEvents :: HANDLE -> Ptr DWORD -> IO Bool - -getNumberOfEvents :: HANDLE -> IO Int -getNumberOfEvents h = alloca $ \numEventsPtr -> do - failIfFalse_ "GetNumberOfConsoleInputEvents" - $ c_GetNumberOfConsoleInputEvents h numEventsPtr - fmap fromEnum $ peek numEventsPtr - -getEvent :: HANDLE -> Chan Event -> IO Event -getEvent h = keyEventLoop (eventReader h) - -eventReader :: HANDLE -> IO [Event] -eventReader h = do - let waitTime = 500 -- milliseconds - ret <- c_WaitForSingleObject h waitTime - yield -- otherwise, the above foreign call causes the loop to never - -- respond to the killThread - if ret /= (#const WAIT_OBJECT_0) - then eventReader h - else do - es <- readEvents h - return $ mapMaybe processEvent es - -consoleHandles :: MaybeT IO Handles -consoleHandles = do - h_in <- open "CONIN$" - h_out <- open "CONOUT$" - return Handles { hIn = h_in, hOut = h_out } - where - open file = handle (\(_::IOException) -> mzero) $ liftIO - $ createFile file (gENERIC_READ .|. gENERIC_WRITE) - (fILE_SHARE_READ .|. fILE_SHARE_WRITE) Nothing - oPEN_EXISTING 0 Nothing - - -processEvent :: InputEvent -> Maybe Event -processEvent KeyEvent {keyDown = True, unicodeChar = c, virtualKeyCode = vc, - controlKeyState = cstate} - = fmap (\e -> KeyInput [Key modifier' e]) $ keyFromCode vc `mplus` simpleKeyChar - where - simpleKeyChar = guard (c /= '\NUL') >> return (KeyChar c) - testMod ck = (cstate .&. ck) /= 0 - modifier' = if hasMeta modifier && hasControl modifier - then noModifier {hasShift = hasShift modifier} - else modifier - modifier = Modifier {hasMeta = testMod ((#const RIGHT_ALT_PRESSED) - .|. (#const LEFT_ALT_PRESSED)) - ,hasControl = testMod ((#const RIGHT_CTRL_PRESSED) - .|. (#const LEFT_CTRL_PRESSED)) - && not (c > '\NUL' && c <= '\031') - ,hasShift = testMod (#const SHIFT_PRESSED) - && not (isPrint c) - } - -processEvent WindowEvent = Just WindowResize -processEvent _ = Nothing - -keyFromCode :: WORD -> Maybe BaseKey -keyFromCode (#const VK_BACK) = Just Backspace -keyFromCode (#const VK_LEFT) = Just LeftKey -keyFromCode (#const VK_RIGHT) = Just RightKey -keyFromCode (#const VK_UP) = Just UpKey -keyFromCode (#const VK_DOWN) = Just DownKey -keyFromCode (#const VK_DELETE) = Just Delete -keyFromCode (#const VK_HOME) = Just Home -keyFromCode (#const VK_END) = Just End -keyFromCode (#const VK_PRIOR) = Just PageUp -keyFromCode (#const VK_NEXT) = Just PageDown --- The Windows console will return '\r' when return is pressed. -keyFromCode (#const VK_RETURN) = Just (KeyChar '\n') --- TODO: KillLine? --- TODO: function keys. -keyFromCode _ = Nothing - -data InputEvent = KeyEvent {keyDown :: BOOL, - repeatCount :: WORD, - virtualKeyCode :: WORD, - virtualScanCode :: WORD, - unicodeChar :: Char, - controlKeyState :: DWORD} - -- TODO: WINDOW_BUFFER_SIZE_RECORD - -- I cant figure out how the user generates them. - | WindowEvent - | OtherEvent - deriving Show - -peekEvent :: Ptr () -> IO InputEvent -peekEvent pRecord = do - eventType :: WORD <- (#peek INPUT_RECORD, EventType) pRecord - let eventPtr = (#ptr INPUT_RECORD, Event) pRecord - case eventType of - (#const KEY_EVENT) -> getKeyEvent eventPtr - (#const WINDOW_BUFFER_SIZE_EVENT) -> return WindowEvent - _ -> return OtherEvent - -readEvents :: HANDLE -> IO [InputEvent] -readEvents h = do - n <- getNumberOfEvents h - alloca $ \numEventsPtr -> - allocaBytes (n * #size INPUT_RECORD) $ \pRecord -> do - failIfFalse_ "ReadConsoleInput" - $ c_ReadConsoleInput h pRecord (toEnum n) numEventsPtr - numRead <- fmap fromEnum $ peek numEventsPtr - forM [0..toEnum numRead-1] $ \i -> peekEvent - $ pRecord `plusPtr` (i * #size INPUT_RECORD) - -getKeyEvent :: Ptr () -> IO InputEvent -getKeyEvent p = do - kDown' <- (#peek KEY_EVENT_RECORD, bKeyDown) p - repeat' <- (#peek KEY_EVENT_RECORD, wRepeatCount) p - keyCode <- (#peek KEY_EVENT_RECORD, wVirtualKeyCode) p - scanCode <- (#peek KEY_EVENT_RECORD, wVirtualScanCode) p - char :: CWchar <- (#peek KEY_EVENT_RECORD, uChar) p - state <- (#peek KEY_EVENT_RECORD, dwControlKeyState) p - return KeyEvent {keyDown = kDown', - repeatCount = repeat', - virtualKeyCode = keyCode, - virtualScanCode = scanCode, - unicodeChar = toEnum (fromEnum char), - controlKeyState = state} - -data Coord = Coord {coordX, coordY :: Int} - deriving Show - -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) -instance Storable Coord where - sizeOf _ = (#size COORD) - alignment _ = (#alignment COORD) - peek p = do - x :: CShort <- (#peek COORD, X) p - y :: CShort <- (#peek COORD, Y) p - return Coord {coordX = fromEnum x, coordY = fromEnum y} - poke p c = do - (#poke COORD, X) p (toEnum (coordX c) :: CShort) - (#poke COORD, Y) p (toEnum (coordY c) :: CShort) - - -foreign import ccall "haskeline_SetPosition" - c_SetPosition :: HANDLE -> Ptr Coord -> IO Bool - -setPosition :: HANDLE -> Coord -> IO () -setPosition h c = with c $ failIfFalse_ "SetConsoleCursorPosition" - . c_SetPosition h - -foreign import WINDOWS_CCONV "windows.h GetConsoleScreenBufferInfo" - c_GetScreenBufferInfo :: HANDLE -> Ptr () -> IO Bool - -getPosition :: HANDLE -> IO Coord -getPosition = withScreenBufferInfo $ - (#peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) - -withScreenBufferInfo :: (Ptr () -> IO a) -> HANDLE -> IO a -withScreenBufferInfo f h = allocaBytes (#size CONSOLE_SCREEN_BUFFER_INFO) - $ \infoPtr -> do - failIfFalse_ "GetConsoleScreenBufferInfo" - $ c_GetScreenBufferInfo h infoPtr - f infoPtr - -getBufferSize :: HANDLE -> IO Layout -getBufferSize = withScreenBufferInfo $ \p -> do - c <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwSize) p - return Layout {width = coordX c, height = coordY c} - -foreign import WINDOWS_CCONV "windows.h WriteConsoleW" c_WriteConsoleW - :: HANDLE -> Ptr TCHAR -> DWORD -> Ptr DWORD -> Ptr () -> IO Bool - -writeConsole :: HANDLE -> String -> IO () --- For some reason, Wine returns False when WriteConsoleW is called on an empty --- string. Easiest fix: just don't call that function. -writeConsole _ "" = return () -writeConsole h str = writeConsole' >> writeConsole h ys - where - (xs,ys) = splitAt limit str - -- WriteConsoleW has a buffer limit which is documented as 32768 word8's, - -- but bug reports from online suggest that the limit may be lower (~25000). - -- To be safe, we pick a round number we know to be less than the limit. - limit = 20000 -- known to be less than WriteConsoleW's buffer limit - writeConsole' - = withArray (map (toEnum . fromEnum) xs) - $ \t_arr -> alloca $ \numWritten -> do - failIfFalse_ "WriteConsoleW" - $ c_WriteConsoleW h t_arr (toEnum $ length xs) - numWritten nullPtr - -foreign import WINDOWS_CCONV "windows.h MessageBeep" c_messageBeep :: UINT -> IO Bool - -messageBeep :: IO () -messageBeep = c_messageBeep (-1) >> return ()-- intentionally ignore failures. - - ----------- --- Console mode -foreign import WINDOWS_CCONV "windows.h GetConsoleMode" c_GetConsoleMode - :: HANDLE -> Ptr DWORD -> IO Bool - -foreign import WINDOWS_CCONV "windows.h SetConsoleMode" c_SetConsoleMode - :: HANDLE -> DWORD -> IO Bool - -withWindowMode :: MonadException m => Handles -> m a -> m a -withWindowMode hs f = do - let h = hIn hs - bracket (getConsoleMode h) (setConsoleMode h) - $ \m -> setConsoleMode h (m .|. (#const ENABLE_WINDOW_INPUT)) >> f - where - getConsoleMode h = liftIO $ alloca $ \p -> do - failIfFalse_ "GetConsoleMode" $ c_GetConsoleMode h p - peek p - setConsoleMode h m = liftIO $ failIfFalse_ "SetConsoleMode" $ c_SetConsoleMode h m - ----------------------------- --- Drawing - -data Handles = Handles { hIn, hOut :: HANDLE } - -closeHandles :: Handles -> IO () -closeHandles hs = closeHandle (hIn hs) >> closeHandle (hOut hs) - -newtype Draw m a = Draw {runDraw :: ReaderT Handles m a} - deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadReader Handles) - -type DrawM a = forall m . (MonadIO m, MonadReader Layout m) => Draw m a - -instance MonadTrans Draw where - lift = Draw . lift - -getPos :: MonadIO m => Draw m Coord -getPos = asks hOut >>= liftIO . getPosition - -setPos :: Coord -> DrawM () -setPos c = do - h <- asks hOut - -- SetPosition will fail if you give it something out of bounds of - -- the window buffer (i.e., the input line doesn't fit in the window). - -- So we do a simple guard against that uncommon case. - -- However, we don't throw away the x coord since it produces sensible - -- results for some cases. - maxY <- liftM (subtract 1) $ asks height - liftIO $ setPosition h c { coordY = max 0 $ min maxY $ coordY c } - -printText :: MonadIO m => String -> Draw m () -printText txt = do - h <- asks hOut - liftIO (writeConsole h txt) - -printAfter :: [Grapheme] -> DrawM () -printAfter gs = do - -- NOTE: you may be tempted to write - -- do {p <- getPos; printText (...); setPos p} - -- Unfortunately, that would be WRONG, because if printText wraps - -- a line at the bottom of the window, causing the window to scroll, - -- then the old value of p will be incorrect. - printText (graphemesToString gs) - movePosLeft gs - -drawLineDiffWin :: LineChars -> LineChars -> DrawM () -drawLineDiffWin (xs1,ys1) (xs2,ys2) = case matchInit xs1 xs2 of - ([],[]) | ys1 == ys2 -> return () - (xs1',[]) | xs1' ++ ys1 == ys2 -> movePosLeft xs1' - ([],xs2') | ys1 == xs2' ++ ys2 -> movePosRight xs2' - (xs1',xs2') -> do - movePosLeft xs1' - let m = gsWidth xs1' + gsWidth ys1 - (gsWidth xs2' + gsWidth ys2) - let deadText = stringToGraphemes $ replicate m ' ' - printText (graphemesToString xs2') - printAfter (ys2 ++ deadText) - -movePosRight, movePosLeft :: [Grapheme] -> DrawM () -movePosRight str = do - p <- getPos - w <- asks width - setPos $ moveCoord w p str - where - moveCoord _ p [] = p - moveCoord w p cs = case splitAtWidth (w - coordX p) cs of - (_,[],len) | len < w - coordX p -- stayed on same line - -> Coord { coordY = coordY p, - coordX = coordX p + len - } - (_,cs',_) -- moved to next line - -> moveCoord w Coord { - coordY = coordY p + 1, - coordX = 0 - } cs' - -movePosLeft str = do - p <- getPos - w <- asks width - setPos $ moveCoord w p str - where - moveCoord _ p [] = p - moveCoord w p cs = case splitAtWidth (coordX p) cs of - (_,[],len) -- stayed on same line - -> Coord { coordY = coordY p, - coordX = coordX p - len - } - (_,_:cs',_) -- moved to previous line - -> moveCoord w Coord { - coordY = coordY p - 1, - coordX = w-1 - } cs' - -crlf :: String -crlf = "\r\n" - -instance (MonadException m, MonadReader Layout m) => Term (Draw m) where - drawLineDiff (xs1,ys1) (xs2,ys2) = let - fixEsc = filter ((/= '\ESC') . baseChar) - in drawLineDiffWin (fixEsc xs1, fixEsc ys1) (fixEsc xs2, fixEsc ys2) - -- TODO now that we capture resize events. - -- first, looks like the cursor stays on the same line but jumps - -- to the beginning if cut off. - reposition _ _ = return () - - printLines [] = return () - printLines ls = printText $ intercalate crlf ls ++ crlf - - clearLayout = clearScreen - - moveToNextLine s = do - movePosRight (snd s) - printText "\r\n" -- make the console take care of creating a new line - - ringBell True = liftIO messageBeep - ringBell False = return () -- TODO - -win32TermStdin :: MaybeT IO RunTerm -win32TermStdin = do - liftIO (hIsTerminalDevice stdin) >>= guard - win32Term - -win32Term :: MaybeT IO RunTerm -win32Term = do - hs <- consoleHandles - ch <- liftIO newChan - fileRT <- liftIO $ fileRunTerm stdin - return fileRT { - termOps = Left TermOps { - getLayout = getBufferSize (hOut hs) - , withGetEvent = withWindowMode hs - . win32WithEvent hs ch - , saveUnusedKeys = saveKeys ch - , evalTerm = EvalTerm (runReaderT' hs . runDraw) - (Draw . lift) - }, - closeTerm = closeHandles hs - } - -win32WithEvent :: MonadException m => Handles -> Chan Event - -> (m Event -> m a) -> m a -win32WithEvent h eventChan f = f $ liftIO $ getEvent (hIn h) eventChan - --- stdin is not a terminal, but we still need to check the right way to output unicode to stdout. -fileRunTerm :: Handle -> IO RunTerm -fileRunTerm h_in = do - putter <- putOut - cp <- getCodePage - return RunTerm { - closeTerm = return (), - putStrOut = putter, - wrapInterrupt = withCtrlCHandler, - termOps = Right FileOps - { inputHandle = h_in - , wrapFileInput = hWithBinaryMode h_in - , getLocaleChar = getMultiByteChar cp h_in - , maybeReadNewline = hMaybeReadNewline h_in - , getLocaleLine = hGetLocaleLine h_in - >>= liftIO . codePageToUnicode cp - } - - } - --- On Windows, Unicode written to the console must be written with the WriteConsole API call. --- And to make the API cross-platform consistent, Unicode to a file should be UTF-8. -putOut :: IO (String -> IO ()) -putOut = do - outIsTerm <- hIsTerminalDevice stdout - if outIsTerm - then do - h <- getStdHandle sTD_OUTPUT_HANDLE - return (writeConsole h) - else do - cp <- getCodePage - return $ \str -> unicodeToCodePage cp str >>= B.putStr >> hFlush stdout - - -type Handler = DWORD -> IO BOOL - -foreign import ccall "wrapper" wrapHandler :: Handler -> IO (FunPtr Handler) - -foreign import WINDOWS_CCONV "windows.h SetConsoleCtrlHandler" c_SetConsoleCtrlHandler - :: FunPtr Handler -> BOOL -> IO BOOL - --- sets the tv to True when ctrl-c is pressed. -withCtrlCHandler :: MonadException m => m a -> m a -withCtrlCHandler f = bracket (liftIO $ do - tid <- myThreadId - fp <- wrapHandler (handler tid) - -- don't fail if we can't set the ctrl-c handler - -- for example, we might not be attached to a console? - _ <- c_SetConsoleCtrlHandler fp True - return fp) - (\fp -> liftIO $ c_SetConsoleCtrlHandler fp False) - (const f) - where - handler tid (#const CTRL_C_EVENT) = do - throwTo tid Interrupt - return True - handler _ _ = return False - - - ------------------------- --- Multi-byte conversion - -foreign import WINDOWS_CCONV "WideCharToMultiByte" wideCharToMultiByte - :: CodePage -> DWORD -> LPCWSTR -> CInt -> LPCSTR -> CInt - -> LPCSTR -> LPBOOL -> IO CInt - -unicodeToCodePage :: CodePage -> String -> IO B.ByteString -unicodeToCodePage cp wideStr = withCWStringLen wideStr $ \(wideBuff, wideLen) -> do - -- first, ask for the length without filling the buffer. - outSize <- wideCharToMultiByte cp 0 wideBuff (toEnum wideLen) - nullPtr 0 nullPtr nullPtr - -- then, actually perform the encoding. - createAndTrim (fromEnum outSize) $ \outBuff -> - fmap fromEnum $ wideCharToMultiByte cp 0 wideBuff (toEnum wideLen) - (castPtr outBuff) outSize nullPtr nullPtr - -foreign import WINDOWS_CCONV "MultiByteToWideChar" multiByteToWideChar - :: CodePage -> DWORD -> LPCSTR -> CInt -> LPWSTR -> CInt -> IO CInt - -codePageToUnicode :: CodePage -> B.ByteString -> IO String -codePageToUnicode cp bs = B.useAsCStringLen bs $ \(inBuff, inLen) -> do - -- first ask for the size without filling the buffer. - outSize <- multiByteToWideChar cp 0 inBuff (toEnum inLen) nullPtr 0 - -- then, actually perform the decoding. - allocaArray0 (fromEnum outSize) $ \outBuff -> do - outSize' <- multiByteToWideChar cp 0 inBuff (toEnum inLen) outBuff outSize - peekCWStringLen (outBuff, fromEnum outSize') - - -getCodePage :: IO CodePage -getCodePage = do - conCP <- getConsoleCP - if conCP > 0 - then return conCP - else getACP - -foreign import WINDOWS_CCONV "IsDBCSLeadByteEx" c_IsDBCSLeadByteEx - :: CodePage -> BYTE -> BOOL - -getMultiByteChar :: CodePage -> Handle -> MaybeT IO Char -getMultiByteChar cp h = do - b1 <- hGetByte h - bs <- if c_IsDBCSLeadByteEx cp b1 - then hGetByte h >>= \b2 -> return [b1,b2] - else return [b1] - cs <- liftIO $ codePageToUnicode cp (B.pack bs) - case cs of - [] -> getMultiByteChar cp h - (c:_) -> return c - ----------------------------------- --- Clearing screen --- WriteConsole has a limit of ~20,000-30000 characters, which is --- less than a 200x200 window, for example. --- So we'll use other Win32 functions to clear the screen. - -getAttribute :: HANDLE -> IO WORD -getAttribute = withScreenBufferInfo $ - (#peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes) - -fillConsoleChar :: HANDLE -> Char -> Int -> Coord -> IO () -fillConsoleChar h c n start = with start $ \startPtr -> alloca $ \numWritten -> do - failIfFalse_ "FillConsoleOutputCharacter" - $ c_FillConsoleCharacter h (toEnum $ fromEnum c) - (toEnum n) startPtr numWritten - -foreign import ccall "haskeline_FillConsoleCharacter" c_FillConsoleCharacter - :: HANDLE -> TCHAR -> DWORD -> Ptr Coord -> Ptr DWORD -> IO BOOL - -fillConsoleAttribute :: HANDLE -> WORD -> Int -> Coord -> IO () -fillConsoleAttribute h a n start = with start $ \startPtr -> alloca $ \numWritten -> do - failIfFalse_ "FillConsoleOutputAttribute" - $ c_FillConsoleAttribute h a - (toEnum n) startPtr numWritten - -foreign import ccall "haskeline_FillConsoleAttribute" c_FillConsoleAttribute - :: HANDLE -> WORD -> DWORD -> Ptr Coord -> Ptr DWORD -> IO BOOL - -clearScreen :: DrawM () -clearScreen = do - lay <- ask - h <- asks hOut - let windowSize = width lay * height lay - let origin = Coord 0 0 - attr <- liftIO $ getAttribute h - liftIO $ fillConsoleChar h ' ' windowSize origin - liftIO $ fillConsoleAttribute h attr windowSize origin - setPos origin - +module System.Console.Haskeline.Backend.Win32( + win32Term, + win32TermStdin, + fileRunTerm + )where + + +import System.IO +import Foreign +import Foreign.C +import System.Win32 hiding (multiByteToWideChar) +import Graphics.Win32.Misc(getStdHandle, sTD_OUTPUT_HANDLE) +import Data.List(intercalate) +import Control.Concurrent hiding (throwTo) +import Data.Char(isPrint) +import Data.Maybe(mapMaybe) +import Control.Applicative +import Control.Monad + +import System.Console.Haskeline.Key +import System.Console.Haskeline.Monads hiding (Handler) +import System.Console.Haskeline.LineState +import System.Console.Haskeline.Term +import System.Console.Haskeline.Backend.WCWidth + +import Data.ByteString.Internal (createAndTrim) +import qualified Data.ByteString as B + +##if defined(i386_HOST_ARCH) +## define WINDOWS_CCONV stdcall +##elif defined(x86_64_HOST_ARCH) +## define WINDOWS_CCONV ccall +##else +## error Unknown mingw32 arch +##endif + +#include "win_console.h" + +foreign import WINDOWS_CCONV "windows.h ReadConsoleInputW" c_ReadConsoleInput + :: HANDLE -> Ptr () -> DWORD -> Ptr DWORD -> IO Bool + +foreign import WINDOWS_CCONV "windows.h WaitForSingleObject" c_WaitForSingleObject + :: HANDLE -> DWORD -> IO DWORD + +foreign import WINDOWS_CCONV "windows.h GetNumberOfConsoleInputEvents" + c_GetNumberOfConsoleInputEvents :: HANDLE -> Ptr DWORD -> IO Bool + +getNumberOfEvents :: HANDLE -> IO Int +getNumberOfEvents h = alloca $ \numEventsPtr -> do + failIfFalse_ "GetNumberOfConsoleInputEvents" + $ c_GetNumberOfConsoleInputEvents h numEventsPtr + fmap fromEnum $ peek numEventsPtr + +getEvent :: HANDLE -> Chan Event -> IO Event +getEvent h = keyEventLoop (eventReader h) + +eventReader :: HANDLE -> IO [Event] +eventReader h = do + let waitTime = 500 -- milliseconds + ret <- c_WaitForSingleObject h waitTime + yield -- otherwise, the above foreign call causes the loop to never + -- respond to the killThread + if ret /= (#const WAIT_OBJECT_0) + then eventReader h + else do + es <- readEvents h + return $ mapMaybe processEvent es + +consoleHandles :: MaybeT IO Handles +consoleHandles = do + h_in <- open "CONIN$" + h_out <- open "CONOUT$" + return Handles { hIn = h_in, hOut = h_out } + where + open file = handle (\(_::IOException) -> mzero) $ liftIO + $ createFile file (gENERIC_READ .|. gENERIC_WRITE) + (fILE_SHARE_READ .|. fILE_SHARE_WRITE) Nothing + oPEN_EXISTING 0 Nothing + + +processEvent :: InputEvent -> Maybe Event +processEvent KeyEvent {keyDown = True, unicodeChar = c, virtualKeyCode = vc, + controlKeyState = cstate} + = fmap (\e -> KeyInput [Key modifier' e]) $ keyFromCode vc `mplus` simpleKeyChar + where + simpleKeyChar = guard (c /= '\NUL') >> return (KeyChar c) + testMod ck = (cstate .&. ck) /= 0 + modifier' = if hasMeta modifier && hasControl modifier + then noModifier {hasShift = hasShift modifier} + else modifier + modifier = Modifier {hasMeta = testMod ((#const RIGHT_ALT_PRESSED) + .|. (#const LEFT_ALT_PRESSED)) + ,hasControl = testMod ((#const RIGHT_CTRL_PRESSED) + .|. (#const LEFT_CTRL_PRESSED)) + && not (c > '\NUL' && c <= '\031') + ,hasShift = testMod (#const SHIFT_PRESSED) + && not (isPrint c) + } + +processEvent WindowEvent = Just WindowResize +processEvent _ = Nothing + +keyFromCode :: WORD -> Maybe BaseKey +keyFromCode (#const VK_BACK) = Just Backspace +keyFromCode (#const VK_LEFT) = Just LeftKey +keyFromCode (#const VK_RIGHT) = Just RightKey +keyFromCode (#const VK_UP) = Just UpKey +keyFromCode (#const VK_DOWN) = Just DownKey +keyFromCode (#const VK_DELETE) = Just Delete +keyFromCode (#const VK_HOME) = Just Home +keyFromCode (#const VK_END) = Just End +keyFromCode (#const VK_PRIOR) = Just PageUp +keyFromCode (#const VK_NEXT) = Just PageDown +-- The Windows console will return '\r' when return is pressed. +keyFromCode (#const VK_RETURN) = Just (KeyChar '\n') +-- TODO: KillLine? +-- TODO: function keys. +keyFromCode _ = Nothing + +data InputEvent = KeyEvent {keyDown :: BOOL, + repeatCount :: WORD, + virtualKeyCode :: WORD, + virtualScanCode :: WORD, + unicodeChar :: Char, + controlKeyState :: DWORD} + -- TODO: WINDOW_BUFFER_SIZE_RECORD + -- I cant figure out how the user generates them. + | WindowEvent + | OtherEvent + deriving Show + +peekEvent :: Ptr () -> IO InputEvent +peekEvent pRecord = do + eventType :: WORD <- (#peek INPUT_RECORD, EventType) pRecord + let eventPtr = (#ptr INPUT_RECORD, Event) pRecord + case eventType of + (#const KEY_EVENT) -> getKeyEvent eventPtr + (#const WINDOW_BUFFER_SIZE_EVENT) -> return WindowEvent + _ -> return OtherEvent + +readEvents :: HANDLE -> IO [InputEvent] +readEvents h = do + n <- getNumberOfEvents h + alloca $ \numEventsPtr -> + allocaBytes (n * #size INPUT_RECORD) $ \pRecord -> do + failIfFalse_ "ReadConsoleInput" + $ c_ReadConsoleInput h pRecord (toEnum n) numEventsPtr + numRead <- fmap fromEnum $ peek numEventsPtr + forM [0..toEnum numRead-1] $ \i -> peekEvent + $ pRecord `plusPtr` (i * #size INPUT_RECORD) + +getKeyEvent :: Ptr () -> IO InputEvent +getKeyEvent p = do + kDown' <- (#peek KEY_EVENT_RECORD, bKeyDown) p + repeat' <- (#peek KEY_EVENT_RECORD, wRepeatCount) p + keyCode <- (#peek KEY_EVENT_RECORD, wVirtualKeyCode) p + scanCode <- (#peek KEY_EVENT_RECORD, wVirtualScanCode) p + char :: CWchar <- (#peek KEY_EVENT_RECORD, uChar) p + state <- (#peek KEY_EVENT_RECORD, dwControlKeyState) p + return KeyEvent {keyDown = kDown', + repeatCount = repeat', + virtualKeyCode = keyCode, + virtualScanCode = scanCode, + unicodeChar = toEnum (fromEnum char), + controlKeyState = state} + +data Coord = Coord {coordX, coordY :: Int} + deriving Show + +#if __GLASGOW_HASKELL__ < 711 +#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) +#endif +instance Storable Coord where + sizeOf _ = (#size COORD) + alignment _ = (#alignment COORD) + peek p = do + x :: CShort <- (#peek COORD, X) p + y :: CShort <- (#peek COORD, Y) p + return Coord {coordX = fromEnum x, coordY = fromEnum y} + poke p c = do + (#poke COORD, X) p (toEnum (coordX c) :: CShort) + (#poke COORD, Y) p (toEnum (coordY c) :: CShort) + + +foreign import ccall "haskeline_SetPosition" + c_SetPosition :: HANDLE -> Ptr Coord -> IO Bool + +setPosition :: HANDLE -> Coord -> IO () +setPosition h c = with c $ failIfFalse_ "SetConsoleCursorPosition" + . c_SetPosition h + +foreign import WINDOWS_CCONV "windows.h GetConsoleScreenBufferInfo" + c_GetScreenBufferInfo :: HANDLE -> Ptr () -> IO Bool + +getPosition :: HANDLE -> IO Coord +getPosition = withScreenBufferInfo $ + (#peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition) + +withScreenBufferInfo :: (Ptr () -> IO a) -> HANDLE -> IO a +withScreenBufferInfo f h = allocaBytes (#size CONSOLE_SCREEN_BUFFER_INFO) + $ \infoPtr -> do + failIfFalse_ "GetConsoleScreenBufferInfo" + $ c_GetScreenBufferInfo h infoPtr + f infoPtr + +getBufferSize :: HANDLE -> IO Layout +getBufferSize = withScreenBufferInfo $ \p -> do + c <- (#peek CONSOLE_SCREEN_BUFFER_INFO, dwSize) p + return Layout {width = coordX c, height = coordY c} + +foreign import WINDOWS_CCONV "windows.h WriteConsoleW" c_WriteConsoleW + :: HANDLE -> Ptr TCHAR -> DWORD -> Ptr DWORD -> Ptr () -> IO Bool + +writeConsole :: HANDLE -> String -> IO () +-- For some reason, Wine returns False when WriteConsoleW is called on an empty +-- string. Easiest fix: just don't call that function. +writeConsole _ "" = return () +writeConsole h str = writeConsole' >> writeConsole h ys + where + (xs,ys) = splitAt limit str + -- WriteConsoleW has a buffer limit which is documented as 32768 word8's, + -- but bug reports from online suggest that the limit may be lower (~25000). + -- To be safe, we pick a round number we know to be less than the limit. + limit = 20000 -- known to be less than WriteConsoleW's buffer limit + writeConsole' + = withArray (map (toEnum . fromEnum) xs) + $ \t_arr -> alloca $ \numWritten -> do + failIfFalse_ "WriteConsoleW" + $ c_WriteConsoleW h t_arr (toEnum $ length xs) + numWritten nullPtr + +foreign import WINDOWS_CCONV "windows.h MessageBeep" c_messageBeep :: UINT -> IO Bool + +messageBeep :: IO () +messageBeep = c_messageBeep (-1) >> return ()-- intentionally ignore failures. + + +---------- +-- Console mode +foreign import WINDOWS_CCONV "windows.h GetConsoleMode" c_GetConsoleMode + :: HANDLE -> Ptr DWORD -> IO Bool + +foreign import WINDOWS_CCONV "windows.h SetConsoleMode" c_SetConsoleMode + :: HANDLE -> DWORD -> IO Bool + +withWindowMode :: MonadException m => Handles -> m a -> m a +withWindowMode hs f = do + let h = hIn hs + bracket (getConsoleMode h) (setConsoleMode h) + $ \m -> setConsoleMode h (m .|. (#const ENABLE_WINDOW_INPUT)) >> f + where + getConsoleMode h = liftIO $ alloca $ \p -> do + failIfFalse_ "GetConsoleMode" $ c_GetConsoleMode h p + peek p + setConsoleMode h m = liftIO $ failIfFalse_ "SetConsoleMode" $ c_SetConsoleMode h m + +---------------------------- +-- Drawing + +data Handles = Handles { hIn, hOut :: HANDLE } + +closeHandles :: Handles -> IO () +closeHandles hs = closeHandle (hIn hs) >> closeHandle (hOut hs) + +newtype Draw m a = Draw {runDraw :: ReaderT Handles m a} + deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadReader Handles) + +type DrawM a = forall m . (MonadIO m, MonadReader Layout m) => Draw m a + +instance MonadTrans Draw where + lift = Draw . lift + +getPos :: MonadIO m => Draw m Coord +getPos = asks hOut >>= liftIO . getPosition + +setPos :: Coord -> DrawM () +setPos c = do + h <- asks hOut + -- SetPosition will fail if you give it something out of bounds of + -- the window buffer (i.e., the input line doesn't fit in the window). + -- So we do a simple guard against that uncommon case. + -- However, we don't throw away the x coord since it produces sensible + -- results for some cases. + maxY <- liftM (subtract 1) $ asks height + liftIO $ setPosition h c { coordY = max 0 $ min maxY $ coordY c } + +printText :: MonadIO m => String -> Draw m () +printText txt = do + h <- asks hOut + liftIO (writeConsole h txt) + +printAfter :: [Grapheme] -> DrawM () +printAfter gs = do + -- NOTE: you may be tempted to write + -- do {p <- getPos; printText (...); setPos p} + -- Unfortunately, that would be WRONG, because if printText wraps + -- a line at the bottom of the window, causing the window to scroll, + -- then the old value of p will be incorrect. + printText (graphemesToString gs) + movePosLeft gs + +drawLineDiffWin :: LineChars -> LineChars -> DrawM () +drawLineDiffWin (xs1,ys1) (xs2,ys2) = case matchInit xs1 xs2 of + ([],[]) | ys1 == ys2 -> return () + (xs1',[]) | xs1' ++ ys1 == ys2 -> movePosLeft xs1' + ([],xs2') | ys1 == xs2' ++ ys2 -> movePosRight xs2' + (xs1',xs2') -> do + movePosLeft xs1' + let m = gsWidth xs1' + gsWidth ys1 - (gsWidth xs2' + gsWidth ys2) + let deadText = stringToGraphemes $ replicate m ' ' + printText (graphemesToString xs2') + printAfter (ys2 ++ deadText) + +movePosRight, movePosLeft :: [Grapheme] -> DrawM () +movePosRight str = do + p <- getPos + w <- asks width + setPos $ moveCoord w p str + where + moveCoord _ p [] = p + moveCoord w p cs = case splitAtWidth (w - coordX p) cs of + (_,[],len) | len < w - coordX p -- stayed on same line + -> Coord { coordY = coordY p, + coordX = coordX p + len + } + (_,cs',_) -- moved to next line + -> moveCoord w Coord { + coordY = coordY p + 1, + coordX = 0 + } cs' + +movePosLeft str = do + p <- getPos + w <- asks width + setPos $ moveCoord w p str + where + moveCoord _ p [] = p + moveCoord w p cs = case splitAtWidth (coordX p) cs of + (_,[],len) -- stayed on same line + -> Coord { coordY = coordY p, + coordX = coordX p - len + } + (_,_:cs',_) -- moved to previous line + -> moveCoord w Coord { + coordY = coordY p - 1, + coordX = w-1 + } cs' + +crlf :: String +crlf = "\r\n" + +instance (MonadException m, MonadReader Layout m) => Term (Draw m) where + drawLineDiff (xs1,ys1) (xs2,ys2) = let + fixEsc = filter ((/= '\ESC') . baseChar) + in drawLineDiffWin (fixEsc xs1, fixEsc ys1) (fixEsc xs2, fixEsc ys2) + -- TODO now that we capture resize events. + -- first, looks like the cursor stays on the same line but jumps + -- to the beginning if cut off. + reposition _ _ = return () + + printLines [] = return () + printLines ls = printText $ intercalate crlf ls ++ crlf + + clearLayout = clearScreen + + moveToNextLine s = do + movePosRight (snd s) + printText "\r\n" -- make the console take care of creating a new line + + ringBell True = liftIO messageBeep + ringBell False = return () -- TODO + +win32TermStdin :: MaybeT IO RunTerm +win32TermStdin = do + liftIO (hIsTerminalDevice stdin) >>= guard + win32Term + +win32Term :: MaybeT IO RunTerm +win32Term = do + hs <- consoleHandles + ch <- liftIO newChan + fileRT <- liftIO $ fileRunTerm stdin + return fileRT { + termOps = Left TermOps { + getLayout = getBufferSize (hOut hs) + , withGetEvent = withWindowMode hs + . win32WithEvent hs ch + , saveUnusedKeys = saveKeys ch + , evalTerm = EvalTerm (runReaderT' hs . runDraw) + (Draw . lift) + }, + closeTerm = closeHandles hs + } + +win32WithEvent :: MonadException m => Handles -> Chan Event + -> (m Event -> m a) -> m a +win32WithEvent h eventChan f = f $ liftIO $ getEvent (hIn h) eventChan + +-- stdin is not a terminal, but we still need to check the right way to output unicode to stdout. +fileRunTerm :: Handle -> IO RunTerm +fileRunTerm h_in = do + putter <- putOut + cp <- getCodePage + return RunTerm { + closeTerm = return (), + putStrOut = putter, + wrapInterrupt = withCtrlCHandler, + termOps = Right FileOps + { inputHandle = h_in + , wrapFileInput = hWithBinaryMode h_in + , getLocaleChar = getMultiByteChar cp h_in + , maybeReadNewline = hMaybeReadNewline h_in + , getLocaleLine = hGetLocaleLine h_in + >>= liftIO . codePageToUnicode cp + } + + } + +-- On Windows, Unicode written to the console must be written with the WriteConsole API call. +-- And to make the API cross-platform consistent, Unicode to a file should be UTF-8. +putOut :: IO (String -> IO ()) +putOut = do + outIsTerm <- hIsTerminalDevice stdout + if outIsTerm + then do + h <- getStdHandle sTD_OUTPUT_HANDLE + return (writeConsole h) + else do + cp <- getCodePage + return $ \str -> unicodeToCodePage cp str >>= B.putStr >> hFlush stdout + + +type Handler = DWORD -> IO BOOL + +foreign import ccall "wrapper" wrapHandler :: Handler -> IO (FunPtr Handler) + +foreign import WINDOWS_CCONV "windows.h SetConsoleCtrlHandler" c_SetConsoleCtrlHandler + :: FunPtr Handler -> BOOL -> IO BOOL + +-- sets the tv to True when ctrl-c is pressed. +withCtrlCHandler :: MonadException m => m a -> m a +withCtrlCHandler f = bracket (liftIO $ do + tid <- myThreadId + fp <- wrapHandler (handler tid) + -- don't fail if we can't set the ctrl-c handler + -- for example, we might not be attached to a console? + _ <- c_SetConsoleCtrlHandler fp True + return fp) + (\fp -> liftIO $ c_SetConsoleCtrlHandler fp False) + (const f) + where + handler tid (#const CTRL_C_EVENT) = do + throwTo tid Interrupt + return True + handler _ _ = return False + + + +------------------------ +-- Multi-byte conversion + +foreign import WINDOWS_CCONV "WideCharToMultiByte" wideCharToMultiByte + :: CodePage -> DWORD -> LPCWSTR -> CInt -> LPCSTR -> CInt + -> LPCSTR -> LPBOOL -> IO CInt + +unicodeToCodePage :: CodePage -> String -> IO B.ByteString +unicodeToCodePage cp wideStr = withCWStringLen wideStr $ \(wideBuff, wideLen) -> do + -- first, ask for the length without filling the buffer. + outSize <- wideCharToMultiByte cp 0 wideBuff (toEnum wideLen) + nullPtr 0 nullPtr nullPtr + -- then, actually perform the encoding. + createAndTrim (fromEnum outSize) $ \outBuff -> + fmap fromEnum $ wideCharToMultiByte cp 0 wideBuff (toEnum wideLen) + (castPtr outBuff) outSize nullPtr nullPtr + +foreign import WINDOWS_CCONV "MultiByteToWideChar" multiByteToWideChar + :: CodePage -> DWORD -> LPCSTR -> CInt -> LPWSTR -> CInt -> IO CInt + +codePageToUnicode :: CodePage -> B.ByteString -> IO String +codePageToUnicode cp bs = B.useAsCStringLen bs $ \(inBuff, inLen) -> do + -- first ask for the size without filling the buffer. + outSize <- multiByteToWideChar cp 0 inBuff (toEnum inLen) nullPtr 0 + -- then, actually perform the decoding. + allocaArray0 (fromEnum outSize) $ \outBuff -> do + outSize' <- multiByteToWideChar cp 0 inBuff (toEnum inLen) outBuff outSize + peekCWStringLen (outBuff, fromEnum outSize') + + +getCodePage :: IO CodePage +getCodePage = do + conCP <- getConsoleCP + if conCP > 0 + then return conCP + else getACP + +foreign import WINDOWS_CCONV "IsDBCSLeadByteEx" c_IsDBCSLeadByteEx + :: CodePage -> BYTE -> BOOL + +getMultiByteChar :: CodePage -> Handle -> MaybeT IO Char +getMultiByteChar cp h = do + b1 <- hGetByte h + bs <- if c_IsDBCSLeadByteEx cp b1 + then hGetByte h >>= \b2 -> return [b1,b2] + else return [b1] + cs <- liftIO $ codePageToUnicode cp (B.pack bs) + case cs of + [] -> getMultiByteChar cp h + (c:_) -> return c + +---------------------------------- +-- Clearing screen +-- WriteConsole has a limit of ~20,000-30000 characters, which is +-- less than a 200x200 window, for example. +-- So we'll use other Win32 functions to clear the screen. + +getAttribute :: HANDLE -> IO WORD +getAttribute = withScreenBufferInfo $ + (#peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes) + +fillConsoleChar :: HANDLE -> Char -> Int -> Coord -> IO () +fillConsoleChar h c n start = with start $ \startPtr -> alloca $ \numWritten -> do + failIfFalse_ "FillConsoleOutputCharacter" + $ c_FillConsoleCharacter h (toEnum $ fromEnum c) + (toEnum n) startPtr numWritten + +foreign import ccall "haskeline_FillConsoleCharacter" c_FillConsoleCharacter + :: HANDLE -> TCHAR -> DWORD -> Ptr Coord -> Ptr DWORD -> IO BOOL + +fillConsoleAttribute :: HANDLE -> WORD -> Int -> Coord -> IO () +fillConsoleAttribute h a n start = with start $ \startPtr -> alloca $ \numWritten -> do + failIfFalse_ "FillConsoleOutputAttribute" + $ c_FillConsoleAttribute h a + (toEnum n) startPtr numWritten + +foreign import ccall "haskeline_FillConsoleAttribute" c_FillConsoleAttribute + :: HANDLE -> WORD -> DWORD -> Ptr Coord -> Ptr DWORD -> IO BOOL + +clearScreen :: DrawM () +clearScreen = do + lay <- ask + h <- asks hOut + let windowSize = width lay * height lay + let origin = Coord 0 0 + attr <- liftIO $ getAttribute h + liftIO $ fillConsoleChar h ' ' windowSize origin + liftIO $ fillConsoleAttribute h attr windowSize origin + setPos origin + diff --git a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Command/Completion.hs b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Command/Completion.hs index 97a887b..71a0f12 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Command/Completion.hs +++ b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Command/Completion.hs @@ -21,7 +21,7 @@ useCompletion im c = insertString r im where r | isFinished c = replacement c ++ " " | otherwise = replacement c -askIMCompletions :: CommandMonad m => +askIMCompletions :: CommandMonad m => Command m InsertMode (InsertMode, [Completion]) askIMCompletions (IMode xs ys) = do (rest, completions) <- lift $ runCompletion (withRev graphemesToString xs, @@ -72,7 +72,7 @@ pagingCompletion :: MonadReader Layout m => Key -> Prefs pagingCompletion k prefs completions = \im -> do ls <- asks $ makeLines (map display completions) let pageAction = do - askFirst prefs (length completions) $ + askFirst prefs (length completions) $ if completionPaging prefs then printPage ls else effect (PrintLines ls) @@ -134,7 +134,7 @@ padWords :: Int -> [String] -> String padWords _ [x] = x padWords _ [] = "" padWords len (x:xs) = x ++ replicate (len - glength x) ' ' - ++ padWords len xs + ++ padWords len xs where -- kludge: compute the length in graphemes, not chars. -- but don't use graphemes for the max length, since I'm not convinced @@ -159,5 +159,3 @@ splitIntoGroups n xs = transpose $ unfoldr f xs ceilDiv :: Integral a => a -> a -> a ceilDiv m n | m `rem` n == 0 = m `div` n | otherwise = m `div` n + 1 - - diff --git a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Command.hs b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Command.hs index 986fd42..1a0d915 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Command.hs +++ b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Command.hs @@ -66,11 +66,11 @@ instance Monad m => Functor (CmdM m) where fmap = liftM instance Monad m => Applicative (CmdM m) where - pure = return + pure = Result (<*>) = ap instance Monad m => Monad (CmdM m) where - return = Result + return = pure GetKey km >>= g = GetKey $ fmap (>>= g) km DoEffect e f >>= g = DoEffect e (f >>= g) diff --git a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Directory.hsc b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Directory.hsc index b2deb22..9eb0952 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Directory.hsc +++ b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Directory.hsc @@ -19,7 +19,7 @@ import qualified System.Directory #endif #include <windows.h> -#include <Shlobj.h> +#include <shlobj.h> ##if defined(i386_HOST_ARCH) ## define WINDOWS_CCONV stdcall diff --git a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Emacs.hs b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Emacs.hs index d5e0622..66d3297 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Emacs.hs +++ b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Emacs.hs @@ -89,7 +89,7 @@ rotatePaste im = get >>= loop wordRight, wordLeft, bigWordLeft :: InsertMode -> InsertMode wordRight = goRightUntil (atStart (not . isAlphaNum)) wordLeft = goLeftUntil (atStart isAlphaNum) -bigWordLeft = goLeftUntil (atStart isSpace) +bigWordLeft = goLeftUntil (atStart (not . isSpace)) modifyWord :: ([Grapheme] -> [Grapheme]) -> InsertMode -> InsertMode modifyWord f im = IMode (reverse (f ys1) ++ xs) ys2 diff --git a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/InputT.hs b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/InputT.hs index 383cf5f..c1ee55e 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/InputT.hs +++ b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/InputT.hs @@ -47,19 +47,12 @@ newtype InputT m a = InputT {unInputT :: (ReaderT (IORef KillRing) (ReaderT Prefs (ReaderT (Settings m) m)))) a} - deriving (Monad, MonadIO, MonadException) + deriving (Functor, Applicative, Monad, MonadIO, MonadException) -- NOTE: we're explicitly *not* making InputT an instance of our -- internal MonadState/MonadReader classes. Otherwise haddock -- displays those instances to the user, and it makes it seem like -- we implement the mtl versions of those classes. -instance Monad m => Functor (InputT m) where - fmap = liftM - -instance Monad m => Applicative (InputT m) where - pure = return - (<*>) = ap - instance MonadTrans InputT where lift = InputT . lift . lift . lift . lift . lift diff --git a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Monads.hs b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Monads.hs index 6668e96..d5fc1bb 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/System/Console/Haskeline/Monads.hs +++ b/ghc-7.10.3/libraries/haskeline/System/Console/Haskeline/Monads.hs @@ -77,11 +77,11 @@ instance Monad m => Functor (StateT s m) where fmap = liftM instance Monad m => Applicative (StateT s m) where - pure = return + pure x = StateT $ \s -> return $ \f -> f x s (<*>) = ap instance Monad m => Monad (StateT s m) where - return x = StateT $ \s -> return $ \f -> f x s + return = pure StateT f >>= g = StateT $ \s -> do useX <- f s useX $ \x s' -> getStateTFunc (g x) s' diff --git a/ghc-7.10.3.orig/libraries/haskeline/haskeline.cabal b/ghc-7.10.3/libraries/haskeline/haskeline.cabal index b709ee3..35ecb26 100644 --- a/ghc-7.10.3.orig/libraries/haskeline/haskeline.cabal +++ b/ghc-7.10.3/libraries/haskeline/haskeline.cabal @@ -1,6 +1,6 @@ Name: haskeline Cabal-Version: >=1.10 -Version: 0.7.2.1 +Version: 0.7.2.3 Category: User Interfaces License: BSD3 License-File: LICENSE @@ -16,7 +16,8 @@ Description: Haskell programs. . Haskeline runs both on POSIX-compatible systems and on Windows. -Homepage: http://trac.haskell.org/haskeline +Homepage: https://github.com/judah/haskeline +Bug-Reports: https://github.com/judah/haskeline/issues Stability: Experimental Build-Type: Custom extra-source-files: examples/Test.hs Changelog @@ -50,9 +51,9 @@ flag legacy-encoding Default: False Library - Build-depends: base >=4.3 && < 4.9, containers>=0.4 && < 0.6, + Build-depends: base >=4.3 && < 4.10, containers>=0.4 && < 0.6, directory>=1.1 && < 1.3, bytestring>=0.9 && < 0.11, - filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.5 + filepath >= 1.2 && < 1.5, transformers >= 0.2 && < 0.6 Default-Language: Haskell98 Default-Extensions: ForeignFunctionInterface, Rank2Types, FlexibleInstances,
Locations
Projects
Search
Status Monitor
Help
OpenBuildService.org
Documentation
API Documentation
Code of Conduct
Contact
Support
@OBShq
Terms
openSUSE Build Service is sponsored by
The Open Build Service is an
openSUSE project
.
Sign Up
Log In
Places
Places
All Projects
Status Monitor
