{-# LINE 1 "System/Console/Readline.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Console.Readline
-- Copyright   :  (c) unknown
-- License     :  GPL (depends on libreadline, which is GPL)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires libreadline)
--
-- A Haskell binding to the GNU readline library.  The GNU Readline
-- library provides a set of functions for use by applications that
-- allow users to edit command lines as they are typed in.  By
-- default, the line editing commands are similar to those of
-- emacs.  A vi-style line editing interface is also available.
--
-- An example of a typical use of readline with history functionality
-- is illustrated in the following read, eval, print loop:
--
-- @
-- readEvalPrintLoop :: IO ()
-- readEvalPrintLoop = do
--   maybeLine <- readline \"% \"
--   case maybeLine of
--    Nothing     -> return () -- EOF \/ control-d
--    Just \"exit\" -> return ()
--    Just line -> do addHistory line
--                    putStrLn $ \"The user input: \" ++ (show line)
--                    readEvalPrintLoop
-- @
--

-----------------------------------------------------------------------------



module System.Console.Readline (
    --------------------------------------------------------------------
    -- Basic Behavior.

    readline,   -- :: String -> IO (Maybe String)
    addHistory, -- :: String -> IO ()

    --------------------------------------------------------------------
    -- Readline Variables.

    getLineBuffer,        -- :: IO String

{-# LINE 50 "System/Console/Readline.hsc" #-}
    setLineBuffer,        -- :: String -> IO ()

{-# LINE 52 "System/Console/Readline.hsc" #-}

    -- Functions involving point positions are meaningful only when string
    -- conversion between Haskell and C preserves the length.
    getPoint,             -- :: IO Int
    setPoint,             -- :: Int -> IO ()
    getEnd,               -- :: IO Int
    setEnd,               -- :: Int -> IO ()
    getMark,              -- :: IO Int
    setMark,              -- :: Int -> IO ()

    setDone,              -- :: Bool -> IO ()
    setPendingInput,      -- :: Char -> IO ()

{-# LINE 65 "System/Console/Readline.hsc" #-}
    setEraseEmptyLine,    -- :: Bool -> IO ()

{-# LINE 67 "System/Console/Readline.hsc" #-}
    getPrompt,            -- :: IO String

{-# LINE 69 "System/Console/Readline.hsc" #-}
    setAlreadyPrompted,   -- :: Bool -> IO ()

{-# LINE 71 "System/Console/Readline.hsc" #-}
    getLibraryVersion,    -- :: IO String
    getTerminalName,      -- :: IO String
    setReadlineName,      -- :: String -> IO ()
    getInStream,          -- :: IO Handle
    getOutStream,         -- :: IO Handle
    setStartupHook,       -- :: Maybe (IO ()) -> IO ()

{-# LINE 78 "System/Console/Readline.hsc" #-}
    setPreInputHook,      -- :: Maybe (IO ()) -> IO ()

{-# LINE 80 "System/Console/Readline.hsc" #-}
    setEventHook,         -- :: Maybe (IO ()) -> IO ()
    -- rl_getc_function wrapper is not provided because it uses FILE *
    -- and it would be too expensive to convert FILE * to Handle
    -- for each character.
    setRedisplayFunction, -- :: Maybe (IO ()) -> IO ()
    -- Nothing means the original: rl_redisplay.

    --------------------------------------------------------------------
    -- Selecting a Keymap.

    -- Keymaps are not garbage collected. They must be explicitly freed
    -- using freeKeymap.

    Keymap,             -- data Keymap
    newBareKeymap,      -- :: IO Keymap
    copyKeymap,         -- :: Keymap -> IO Keymap
    newKeymap,          -- :: IO Keymap
    freeKeymap,         -- :: Keymap -> IO ()
    getKeymap,          -- :: IO Keymap
    setKeymap,          -- :: Keymap -> IO ()
    getKeymapByName,    -- :: String -> IO Keymap
    getKeymapName,      -- :: Keymap -> IO (Maybe String)
    getExecutingKeymap, -- :: IO Keymap
    getBindingKeymap,   -- :: IO Keymap

    --------------------------------------------------------------------
    -- Binding Keys.

    Callback,           -- type Callback = Int -> Char -> IO Int
    addDefun,           -- :: String -> Callback -> Maybe Char -> IO ()
    bindKey,            -- :: Char -> Callback -> IO ()
    bindKeyInMap,       -- :: Char -> Callback -> Keymap -> IO ()
    unbindKey,          -- :: Char -> IO ()
    unbindKeyInMap,     -- :: Char -> Keymap -> IO ()
    -- rl_unbind_function_in_map is not provided because Haskell functions
    -- have no identity.
    unbindCommandInMap, -- :: String -> Keymap -> IO ()
    Entry(..),          -- data Entry
                        --     = Function Callback
                        --     | Macro    String
                        --     | Keymap   Keymap
    genericBind,        -- :: String -> Entry -> Keymap -> IO ()
    parseAndBind,       -- :: String -> IO ()
    readInitFile,       -- :: String -> IO ()

    --------------------------------------------------------------------
    -- Associating Function Names and Bindings.

    namedFunction,    -- :: String -> IO (Maybe Callback)
    functionOfKeyseq, -- :: String -> Maybe Keymap -> IO Entry
    -- rl_invoking_keyseqs and rl_invoking_keyseqs_in_map are not provided
    -- because Haskell functions have no identity.
    functionDumper,   -- :: Bool -> IO ()
    listFunmapNames,  -- :: IO ()

{-# LINE 135 "System/Console/Readline.hsc" #-}
    funmapNames,      -- :: IO [String]

{-# LINE 137 "System/Console/Readline.hsc" #-}

    --------------------------------------------------------------------
    -- Allowing Undoing.

    beginUndoGroup, endUndoGroup, -- :: IO ()
    UndoCode(..),   -- data UndoCode
                    --     = UndoDelete
                    --     | UndoInsert
                    --     | UndoBegin
                    --     | UndoEnd
    addUndo,        -- :: UndoCode -> Int -> Int -> String -> IO ()
    freeUndoList,   -- :: IO ()
    doUndo,         -- :: IO Bool
    modifying,      -- :: Int -> Int -> IO ()

    --------------------------------------------------------------------
    -- Redisplay.

    redisplay,                      -- :: IO ()
    forcedUpdateDisplay,            -- :: IO ()
    onNewLine,                      -- :: IO ()

{-# LINE 159 "System/Console/Readline.hsc" #-}
    onNewLineWithPrompt,            -- :: IO ()

{-# LINE 161 "System/Console/Readline.hsc" #-}
    resetLineState,                 -- :: IO ()
    message,                        -- :: String -> IO ()
    clearMessage,                   -- :: IO ()

{-# LINE 165 "System/Console/Readline.hsc" #-}
    savePrompt,                     -- :: IO ()
    restorePrompt,                  -- :: IO ()

{-# LINE 168 "System/Console/Readline.hsc" #-}

    --------------------------------------------------------------------
    -- Modifying Text.

    insertText, -- :: String -> IO ()
    deleteText, -- :: Int -> Int -> IO ()
    copyText,   -- :: Int -> Int -> IO String
    killText,   -- :: Int -> Int -> IO ()

    --------------------------------------------------------------------
    -- Utility functions.

    readKey,          -- :: IO Char
    stuffChar,        -- :: Char -> IO Bool
    initialize,       -- :: IO ()
    resetTerminal,    -- :: Maybe String -> IO ()
    ding,             -- :: IO Bool

{-# LINE 186 "System/Console/Readline.hsc" #-}
    displayMatchList, -- :: [String] -> IO ()

{-# LINE 188 "System/Console/Readline.hsc" #-}

    --------------------------------------------------------------------
    -- Alternate Interface.

    callbackHandlerInstall, -- :: String -> (String -> IO ()) -> IO (IO ())
    -- Returns the cleanup action.
    callbackReadChar,       -- :: IO ()

    --------------------------------------------------------------------
    -- Readline Signal Handling.


{-# LINE 200 "System/Console/Readline.hsc" #-}
    setCatchSignals,    -- :: Bool -> IO ()
    getCatchSignals,    -- :: IO Bool
    setCatchSigwinch,   -- :: Bool -> IO ()
    getCatchSigwinch,   -- :: IO Bool
    cleanupAfterSignal, -- :: IO ()
    freeLineState,      -- :: IO ()
    resetAfterSignal,   -- :: IO ()
    resizeTerminal,     -- :: IO ()

{-# LINE 209 "System/Console/Readline.hsc" #-}
    setSignals,         -- :: IO ()
    clearSignals,       -- :: IO ()

    --------------------------------------------------------------------
    -- Completion functions.

    completeInternal,                 -- :: Char -> IO ()
    complete,                         -- :: Int -> Char -> IO Int
    possibleCompletions,              -- :: Int -> Char -> IO Int
    insertCompletions,                -- :: Int -> Char -> IO Int
    -- readline uses functions that are called multiple times and
    -- return an entry at a time, maintaining their state at which
    -- point they are. This is silly in a functional language so here
    -- we work with functions String -> IO [String].
    completionMatches,
        -- :: String -> (String -> IO [String]) -> IO (Maybe (String, [String]))
    filenameCompletionFunction,       -- :: String -> IO [String]
    usernameCompletionFunction,       -- :: String -> IO [String]
    setCompletionEntryFunction,
        -- :: Maybe (String -> IO [String]) -> IO ()
    setAttemptedCompletionFunction,
        -- :: Maybe (String -> Int -> Int -> IO (Maybe (String, [String]))) -> IO ()
    setFilenameQuotingFunction,
        -- :: Maybe (String -> Bool -> Ptr CChar -> IO String) -> IO ()
    quoteFilename,
        -- :: String -> Bool -> Ptr CChar -> IO String
    setFilenameDequotingFunction,
        -- :: Maybe (String -> Maybe Char -> IO String) -> IO ()
    setCharIsQuotedP,
        -- :: Maybe (String -> Int -> IO Bool) -> IO ()
    getCompletionQueryItems,          -- :: IO Int
    setCompletionQueryItems,          -- :: Int -> IO ()
    getBasicWordBreakCharacters,      -- :: IO String
    setBasicWordBreakCharacters,      -- :: String -> IO ()
    getBasicQuoteCharacters,          -- :: IO String
    setBasicQuoteCharacters,          -- :: String -> IO ()
    getCompleterWordBreakCharacters,  -- :: IO String
    setCompleterWordBreakCharacters,  -- :: String -> IO ()
    getCompleterQuoteCharacters,      -- :: IO String
    setCompleterQuoteCharacters,      -- :: String -> IO ()
    getFilenameQuoteCharacters,       -- :: IO String
    setFilenameQuoteCharacters,       -- :: String -> IO ()
    getSpecialPrefixes,               -- :: IO String
    setSpecialPrefixes,               -- :: String -> IO ()
    getCompletionAppendCharacter,     -- :: IO (Maybe Char)
    setCompletionAppendCharacter,     -- :: Maybe Char -> IO ()
    setIgnoreCompletionDuplicates,    -- :: Bool -> IO ()
    getIgnoreCompletionDuplicates,    -- :: IO Bool
    setFilenameCompletionDesired,     -- :: Bool -> IO ()
    getFilenameCompletionDesired,     -- :: IO Bool
    setFilenameQuotingDesired,        -- :: Bool -> IO ()
    getFilenameQuotingDesired,        -- :: IO Bool
    setInhibitCompletion,             -- :: Bool -> IO ()
    getInhibitCompletion,             -- :: IO Bool
    setAttemptedCompletionOver,       -- :: Bool -> IO ()
    getAttemptedCompletionOver,       -- :: IO Bool
    setIgnoreSomeCompletionsFunction,
        -- :: Maybe ([String] -> IO [String]) -> IO ()
        -- The function may not make the list longer!
    setDirectoryCompletionHook
        -- :: Maybe (String -> IO String) -> IO ()

{-# LINE 271 "System/Console/Readline.hsc" #-}
    ,
    setCompletionWordBreakHook
        -- :: Maybe (IO (Maybe String)) -> IO ()

{-# LINE 275 "System/Console/Readline.hsc" #-}

{-# LINE 276 "System/Console/Readline.hsc" #-}
    ,
    setCompletionDisplayMatchesHook
        -- :: Maybe ([String] -> IO ()) -> IO ()

{-# LINE 280 "System/Console/Readline.hsc" #-}
    )

    where

------------------------------------------------------------------------

import Control.Monad	( liftM, when, unless )
import Data.Char	( chr, ord )
import Data.Maybe	( fromMaybe )
import System.IO	( Handle )
import System.IO.Unsafe ( unsafePerformIO )
import Data.IORef	( newIORef, readIORef, writeIORef )
import Foreign.Ptr	( Ptr, nullPtr, castPtr, castFunPtrToPtr,
			  FunPtr, nullFunPtr, freeHaskellFunPtr )
import Foreign.Storable	( Storable(..) )
import Foreign.Marshal.Utils ( maybePeek, maybeWith, withMany )
import Foreign.Marshal.Alloc ( alloca, free )
import Foreign.Marshal.Array ( mallocArray, peekArray0, pokeArray0, withArray0 )
import Foreign.C.Types	( CChar, CFile )
import Foreign.C.String	( newCString, peekCString, withCString,
			  castCharToCChar, castCCharToChar )
import GHC.IO.Handle.FD	( fdToHandle )


{-# LINE 304 "System/Console/Readline.hsc" #-}
import Foreign.C.Types(CInt(..))

{-# LINE 308 "System/Console/Readline.hsc" #-}

{-# CFILES HsReadline_cbits.c #-}

------------------------------------------------------------------------
-- Basic Behavior.

-- | readline is similar to 'System.IO.getLine', but with rich edit
-- functionality and history capability.  readline will read a line
-- from the terminal and return it, using /prompt/ as a prompt.  If
-- prompt is the empty string, no prompt is issued.  The line returned
-- has the final newline removed, so only the text of the line
-- remains.  A blank line returns the empty string.  If EOF is
-- encountered while reading a line, and the line is empty, Nothing is
-- returned.  If an EOF is read with a non-empty line, it is treated
-- as a newline.

readline :: String-- ^prompt
	 -> IO (Maybe String) -- ^returns the line the user input, or Nothing if EOF is encountered.
readline :: String -> IO (Maybe String)
readline String
prompt = do
    ptr <- String -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
prompt Ptr CChar -> IO (Ptr CChar)
readlineC
    flip maybePeek ptr $ \Ptr CChar
ptr' -> do
        line <- Ptr CChar -> IO String
peekCString Ptr CChar
ptr'
        free ptr'
        return line
foreign import ccall "readline" readlineC :: Ptr CChar -> IO (Ptr CChar)


-- |Add this command to the history.  This allows users to search backward
-- through history with C-r and step through with up and down arrows, among
-- other things.
addHistory :: String -> IO ()
addHistory :: String -> IO ()
addHistory String
line = String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
line Ptr CChar -> IO ()
add_history
foreign import ccall unsafe add_history :: Ptr CChar -> IO ()

------------------------------------------------------------------------
-- Readline Variables.

getLineBuffer :: IO String
getLineBuffer :: IO String
getLineBuffer = Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_line_buffer IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString


{-# LINE 349 "System/Console/Readline.hsc" #-}
setLineBuffer :: String -> IO ()
setLineBuffer :: String -> IO ()
setLineBuffer String
line = do
    -- TODO: Fix the next line when text conversions are available!
    let lineC :: [CChar]
lineC = (Char -> CChar) -> String -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Char -> CChar
castCharToCChar String
line
    CInt -> IO ()
rl_extend_line_buffer (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CChar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CChar]
lineC))
    ptr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_line_buffer
    pokeArray0 0 (castPtr ptr) lineC

{-# LINE 357 "System/Console/Readline.hsc" #-}

foreign import ccall "&"
  rl_line_buffer :: Ptr (Ptr CChar)

{-# LINE 361 "System/Console/Readline.hsc" #-}
-- The readline docs claim that rl_extend_line_buffer returns CInt,
-- but the header and source both say that it returns void.
foreign import ccall unsafe rl_extend_line_buffer :: CInt -> IO ()

{-# LINE 365 "System/Console/Readline.hsc" #-}

-- Functions involving point positions are meaningful only when string
-- conversion between Haskell and C preserves the length.

getPoint :: IO Int
getPoint :: IO Int
getPoint = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_point)

setPoint :: Int -> IO ()
setPoint :: Int -> IO ()
setPoint Int
p = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_point (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)

foreign import ccall "&" rl_point :: Ptr CInt

getEnd :: IO Int
getEnd :: IO Int
getEnd = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_end)

setEnd :: Int -> IO ()
setEnd :: Int -> IO ()
setEnd Int
p = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_end (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)

foreign import ccall "&" rl_end :: Ptr CInt

getMark :: IO Int
getMark :: IO Int
getMark = (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_mark)

setMark :: Int -> IO ()
setMark :: Int -> IO ()
setMark Int
p = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_mark (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
p)

foreign import ccall "&" rl_mark :: Ptr CInt

setDone :: Bool -> IO ()
setDone :: Bool -> IO ()
setDone Bool
done = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_done (if Bool
done then CInt
1 else CInt
0)
foreign import ccall "&" rl_done :: Ptr CInt

setPendingInput :: Char -> IO ()
setPendingInput :: Char -> IO ()
setPendingInput Char
key = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_pending_input (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key))
foreign import ccall "&" rl_pending_input :: Ptr CInt


{-# LINE 402 "System/Console/Readline.hsc" #-}
setEraseEmptyLine :: Bool -> IO ()
setEraseEmptyLine :: Bool -> IO ()
setEraseEmptyLine Bool
erase = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_erase_empty_line (if Bool
erase then CInt
1 else CInt
0)
foreign import ccall "&" rl_erase_empty_line :: Ptr CInt

{-# LINE 406 "System/Console/Readline.hsc" #-}

getPrompt :: IO String
getPrompt :: IO String
getPrompt = Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_prompt IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
foreign import ccall "&" rl_prompt :: Ptr (Ptr CChar)


{-# LINE 412 "System/Console/Readline.hsc" #-}
setAlreadyPrompted :: Bool -> IO ()
setAlreadyPrompted :: Bool -> IO ()
setAlreadyPrompted Bool
pr = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_already_prompted (if Bool
pr then CInt
1 else CInt
0)
foreign import ccall "&" rl_already_prompted :: Ptr CInt

{-# LINE 416 "System/Console/Readline.hsc" #-}

getLibraryVersion :: IO String
getLibraryVersion :: IO String
getLibraryVersion = Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_library_version IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
foreign import ccall "&" rl_library_version :: Ptr (Ptr CChar)

getTerminalName :: IO String
getTerminalName :: IO String
getTerminalName = Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_terminal_name IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
foreign import ccall "&" rl_terminal_name :: Ptr (Ptr CChar)

setReadlineName :: String -> IO ()
setReadlineName :: String -> IO ()
setReadlineName String
name = String -> IO (Ptr CChar)
newCString String
name IO (Ptr CChar) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
rl_readline_name
    -- The memory for name will never be freed. Otherwise we would
    -- have to recognize the original value which is a static string
    -- literal. This function is usually called only once anyway.
foreign import ccall "&" rl_readline_name :: Ptr (Ptr CChar)

getInStream :: IO Handle
getInStream :: IO Handle
getInStream = Ptr (Ptr CFile) -> IO (Ptr CFile)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CFile)
rl_instream IO (Ptr CFile) -> (Ptr CFile -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CFile -> IO CInt
hs_fileno IO CInt -> (CInt -> IO Handle) -> IO Handle
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO Handle
fdToHandle (CInt -> IO Handle) -> (CInt -> CInt) -> CInt -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral
foreign import ccall "&" rl_instream :: Ptr (Ptr CFile)

getOutStream :: IO Handle
getOutStream :: IO Handle
getOutStream = Ptr (Ptr CFile) -> IO (Ptr CFile)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CFile)
rl_outstream IO (Ptr CFile) -> (Ptr CFile -> IO CInt) -> IO CInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CFile -> IO CInt
hs_fileno IO CInt -> (CInt -> IO Handle) -> IO Handle
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO Handle
fdToHandle (CInt -> IO Handle) -> (CInt -> CInt) -> CInt -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral
foreign import ccall "&" rl_outstream :: Ptr (Ptr CFile)

foreign import ccall unsafe "__hscore_hs_fileno"
  hs_fileno :: Ptr CFile -> IO CInt

setStartupHook :: Maybe (IO ()) -> IO ()
setStartupHook :: Maybe (IO ()) -> IO ()
setStartupHook Maybe (IO ())
hook = Ptr (FunPtr (IO CInt))
-> Maybe (IO ()) -> (IO () -> IO (FunPtr (IO CInt))) -> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr (IO CInt))
rl_startup_hook Maybe (IO ())
hook IO () -> IO (FunPtr (IO CInt))
exportHookInt
foreign import ccall "&" rl_startup_hook :: Ptr (FunPtr (IO CInt))


{-# LINE 448 "System/Console/Readline.hsc" #-}
setPreInputHook :: Maybe (IO ()) -> IO ()
setPreInputHook :: Maybe (IO ()) -> IO ()
setPreInputHook Maybe (IO ())
hook = Ptr (FunPtr (IO CInt))
-> Maybe (IO ()) -> (IO () -> IO (FunPtr (IO CInt))) -> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr (IO CInt))
rl_pre_input_hook Maybe (IO ())
hook IO () -> IO (FunPtr (IO CInt))
exportHookInt
foreign import ccall "&" rl_pre_input_hook :: Ptr (FunPtr (IO CInt))

{-# LINE 452 "System/Console/Readline.hsc" #-}

setEventHook :: Maybe (IO ()) -> IO ()
setEventHook :: Maybe (IO ()) -> IO ()
setEventHook Maybe (IO ())
hook = Ptr (FunPtr (IO CInt))
-> Maybe (IO ()) -> (IO () -> IO (FunPtr (IO CInt))) -> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr (IO CInt))
rl_event_hook Maybe (IO ())
hook IO () -> IO (FunPtr (IO CInt))
exportHookInt
foreign import ccall "&" rl_event_hook :: Ptr (FunPtr (IO CInt))

-- rl_getc_function wrapper is not provided because it uses FILE *
-- and it would be too expensive to convert FILE * to Handle
-- for each character.

setRedisplayFunction :: Maybe (IO ()) -> IO ()
-- Nothing means the original: rl_redisplay.
setRedisplayFunction :: Maybe (IO ()) -> IO ()
setRedisplayFunction Maybe (IO ())
fun = do
    oldPtr <- Ptr (FunPtr (IO ())) -> IO (FunPtr (IO ()))
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr (IO ()))
rl_redisplay_function
    when (oldPtr /= nullFunPtr && oldPtr /= rl_redisplay) $
        freeHaskellFunPtr oldPtr
    newPtr <- case fun of
        Maybe (IO ())
Nothing -> FunPtr (IO ()) -> IO (FunPtr (IO ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr (IO ())
rl_redisplay
        Just IO ()
f  -> IO () -> IO (FunPtr (IO ()))
exportHookVoid IO ()
f
    poke rl_redisplay_function newPtr
foreign import ccall "&" rl_redisplay_function :: Ptr (FunPtr (IO ()))
foreign import ccall "&" rl_redisplay :: FunPtr (IO ())
-- rl_redisplay_function can never be NULL.

exportHookInt :: IO () -> IO (FunPtr (IO CInt))
exportHookInt :: IO () -> IO (FunPtr (IO CInt))
exportHookInt IO ()
hook = IO CInt -> IO (FunPtr (IO CInt))
exportHookIntC (IO ()
hook IO () -> IO CInt -> IO CInt
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0)
foreign import ccall "wrapper"
  exportHookIntC :: IO CInt -> IO (FunPtr (IO CInt))

foreign import ccall "wrapper"
  exportHookVoid :: IO () -> IO (FunPtr (IO ()))

setFunPtr_freeIf :: (FunPtr a -> Bool)
                 -> Ptr (FunPtr a)
                 -> Maybe b
                 -> (b -> IO (FunPtr a))
                 -> IO ()
setFunPtr_freeIf :: forall a b.
(FunPtr a -> Bool)
-> Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr_freeIf FunPtr a -> Bool
pred Ptr (FunPtr a)
variable Maybe b
newFun b -> IO (FunPtr a)
makeNewFun = do
    oldPtr <- Ptr (FunPtr a) -> IO (FunPtr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr a)
variable
    when (pred oldPtr) $ freeHaskellFunPtr oldPtr
    newPtr <- case newFun of
        Maybe b
Nothing -> FunPtr a -> IO (FunPtr a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr a
forall a. FunPtr a
nullFunPtr
        Just b
f  -> b -> IO (FunPtr a)
makeNewFun b
f
    poke variable newPtr

setFunPtr :: Ptr (FunPtr a)
          -> Maybe b
          -> (b -> IO (FunPtr a))
          -> IO ()
setFunPtr :: forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr = (FunPtr a -> Bool)
-> Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
forall a b.
(FunPtr a -> Bool)
-> Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr_freeIf (FunPtr a -> FunPtr a -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr a
forall a. FunPtr a
nullFunPtr)

------------------------------------------------------------------------
-- Selecting a Keymap.

-- Keymaps are not garbage collected. They must be explicitly freed
-- using freeKeymap.

data KeymapTag = KeymapTag
newtype Keymap = MkKeymap (Ptr KeymapTag)

foreign import ccall unsafe "rl_make_bare_keymap" newBareKeymap :: IO Keymap

foreign import ccall unsafe "rl_copy_keymap" copyKeymap :: Keymap -> IO Keymap

foreign import ccall unsafe "rl_make_keymap" newKeymap :: IO Keymap

freeKeymap :: Keymap -> IO ()
freeKeymap :: Keymap -> IO ()
freeKeymap k :: Keymap
k@(MkKeymap Ptr KeymapTag
km) = do
    Keymap -> IO ()
rl_discard_keymap Keymap
k
    Ptr KeymapTag -> IO ()
forall a. Ptr a -> IO ()
free Ptr KeymapTag
km

foreign import ccall unsafe "rl_discard_keymap"
  rl_discard_keymap :: Keymap -> IO ()

foreign import ccall unsafe "rl_get_keymap"
  getKeymap :: IO Keymap

foreign import ccall unsafe "rl_set_keymap"
  setKeymap :: Keymap -> IO ()

getKeymapByName :: String -> IO Keymap
getKeymapByName :: String -> IO Keymap
getKeymapByName String
name = String -> (Ptr CChar -> IO Keymap) -> IO Keymap
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
name Ptr CChar -> IO Keymap
rl_get_keymap_by_name
foreign import ccall unsafe
  rl_get_keymap_by_name :: Ptr CChar -> IO Keymap

getKeymapName :: Keymap -> IO (Maybe String)
getKeymapName :: Keymap -> IO (Maybe String)
getKeymapName Keymap
km = do
    ptr <- Keymap -> IO (Ptr CChar)
rl_get_keymap_name Keymap
km
    maybePeek peekCString ptr

foreign import ccall unsafe "rl_get_keymap_name"
  rl_get_keymap_name :: Keymap -> IO (Ptr CChar)

getExecutingKeymap :: IO Keymap
getExecutingKeymap :: IO Keymap
getExecutingKeymap = (Ptr KeymapTag -> Keymap) -> IO (Ptr KeymapTag) -> IO Keymap
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr KeymapTag -> Keymap
MkKeymap (IO (Ptr KeymapTag) -> IO Keymap)
-> IO (Ptr KeymapTag) -> IO Keymap
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr KeymapTag) -> IO (Ptr KeymapTag)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr KeymapTag)
rl_executing_keymap
foreign import ccall "&" rl_executing_keymap :: Ptr (Ptr KeymapTag)

getBindingKeymap :: IO Keymap
getBindingKeymap :: IO Keymap
getBindingKeymap = (Ptr KeymapTag -> Keymap) -> IO (Ptr KeymapTag) -> IO Keymap
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Ptr KeymapTag -> Keymap
MkKeymap (IO (Ptr KeymapTag) -> IO Keymap)
-> IO (Ptr KeymapTag) -> IO Keymap
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr KeymapTag) -> IO (Ptr KeymapTag)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr KeymapTag)
rl_binding_keymap
foreign import ccall "&" rl_binding_keymap :: Ptr (Ptr KeymapTag)

------------------------------------------------------------------------
-- Binding Keys.

type Callback = Int -> Char -> IO Int
type CallbackC = CInt -> CInt -> IO CInt

addDefun :: String -> Callback -> Maybe Char -> IO ()
addDefun :: String -> Callback -> Maybe Char -> IO ()
addDefun String
name Callback
cb Maybe Char
key = do
    namePtr <- String -> IO (Ptr CChar)
newCString String
name
    -- rl_add_defun does *not* make a copy of the function name.
    cbPtr <- exportCallback cb
    -- The memory will never be freed. But readline does not provide
    -- removing defuns anyway.
    rl_add_defun namePtr cbPtr (maybe (-1) (fromIntegral . ord) key)
    return ()
foreign import ccall unsafe "rl_add_defun"
    rl_add_defun :: Ptr CChar -> FunPtr CallbackC -> CInt -> IO CInt

bindKey :: Char -> Callback -> IO ()
bindKey :: Char -> Callback -> IO ()
bindKey Char
key Callback
cb = do
    cbPtr <- Callback -> IO (FunPtr CallbackC)
exportCallback Callback
cb
    -- The memory will never be freed. We should provide a way to
    -- free it, but it's complicated because of multiple keymaps.
    -- It should probably be done explicitly.
    rl_bind_key (fromIntegral (ord key)) cbPtr
    return ()
foreign import ccall unsafe "rl_bind_key"
  rl_bind_key :: CInt -> FunPtr CallbackC -> IO CInt

bindKeyInMap :: Char -> Callback -> Keymap -> IO ()
bindKeyInMap :: Char -> Callback -> Keymap -> IO ()
bindKeyInMap Char
key Callback
cb Keymap
km = do
    cbPtr <- Callback -> IO (FunPtr CallbackC)
exportCallback Callback
cb
    rl_bind_key_in_map (fromIntegral (ord key)) cbPtr km
    return ()
foreign import ccall unsafe "rl_bind_key_in_map"
    rl_bind_key_in_map :: CInt -> FunPtr CallbackC -> Keymap -> IO CInt

unbindKey :: Char -> IO ()
unbindKey :: Char -> IO ()
unbindKey Char
key = do
    CInt -> IO CInt
rl_unbind_key (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key))
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe rl_unbind_key :: CInt -> IO CInt

unbindKeyInMap :: Char -> Keymap -> IO ()
unbindKeyInMap :: Char -> Keymap -> IO ()
unbindKeyInMap Char
key Keymap
km = do
    CInt -> Keymap -> IO CInt
rl_unbind_key_in_map (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key)) Keymap
km
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_unbind_key_in_map"
  rl_unbind_key_in_map :: CInt -> Keymap -> IO CInt

-- rl_unbind_function_in_map is not provided because Haskell functions
-- have no identity.

unbindCommandInMap :: String -> Keymap -> IO ()
unbindCommandInMap :: String -> Keymap -> IO ()
unbindCommandInMap String
comm Keymap
km = do
    String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
comm ((Ptr CChar -> IO CInt) -> IO CInt)
-> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
commPtr -> Ptr CChar -> Keymap -> IO CInt
rl_unbind_command_in_map Ptr CChar
commPtr Keymap
km
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_unbind_command_in_map"
  rl_unbind_command_in_map :: Ptr CChar -> Keymap -> IO CInt

data Entry
    = Function Callback
    | Macro String
    | Keymap Keymap

genericBind :: String -> Entry -> Keymap -> IO ()
genericBind :: String -> Entry -> Keymap -> IO ()
genericBind String
keys (Function Callback
cb) Keymap
km = do
    cbPtr <- Callback -> IO (FunPtr CallbackC)
exportCallback Callback
cb
    genericBind' (0) keys (castFunPtrToPtr cbPtr) km
{-# LINE 621 "System/Console/Readline.hsc" #-}
genericBind keys (Macro s) km =
    withCString s $ \ptr -> genericBind' (2) keys ptr km
{-# LINE 623 "System/Console/Readline.hsc" #-}
genericBind keys (Keymap (MkKeymap km')) km =
    genericBind' (1) keys (castPtr km') km
{-# LINE 625 "System/Console/Readline.hsc" #-}

genericBind' :: CInt -> String -> Ptr CChar -> Keymap -> IO ()
genericBind' :: CInt -> String -> Ptr CChar -> Keymap -> IO ()
genericBind' CInt
typ String
keys Ptr CChar
dat Keymap
km = do
    String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
keys ((Ptr CChar -> IO CInt) -> IO CInt)
-> (Ptr CChar -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
keysPtr -> CInt -> Ptr CChar -> Ptr CChar -> Keymap -> IO CInt
rl_generic_bind CInt
typ Ptr CChar
keysPtr Ptr CChar
dat Keymap
km
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_generic_bind"
    rl_generic_bind :: CInt -> Ptr CChar -> Ptr CChar -> Keymap -> IO CInt

parseAndBind :: String -> IO ()
parseAndBind :: String -> IO ()
parseAndBind String
s = do
    ok <- String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
s Ptr CChar -> IO CInt
rl_parse_and_bind
    unless (ok == 0) $ ioError (userError "Parse error")
foreign import ccall unsafe "rl_parse_and_bind"
  rl_parse_and_bind :: Ptr CChar -> IO CInt

readInitFile :: String -> IO ()
readInitFile :: String -> IO ()
readInitFile String
name = do
    ok <- String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
name Ptr CChar -> IO CInt
rl_read_init_file
    unless (ok == 0) $ ioError (userError "Can't read file")
foreign import ccall unsafe "rl_read_init_file"
  rl_read_init_file :: Ptr CChar -> IO CInt

------------------------------------------------------------------------
-- Associating Function Names and Bindings.

namedFunction :: String -> IO (Maybe Callback)
namedFunction :: String -> IO (Maybe Callback)
namedFunction String
name = do
    ptr <- String
-> (Ptr CChar -> IO (FunPtr CallbackC)) -> IO (FunPtr CallbackC)
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
name Ptr CChar -> IO (FunPtr CallbackC)
rl_named_function
    return $ if ptr == nullFunPtr then Nothing else Just (importCallback ptr)
foreign import ccall unsafe "rl_named_function"
  rl_named_function :: Ptr CChar -> IO (FunPtr CallbackC)

functionOfKeyseq :: String -> Maybe Keymap -> IO Entry
functionOfKeyseq :: String -> Maybe Keymap -> IO Entry
functionOfKeyseq String
keys Maybe Keymap
km =
    String -> (Ptr CChar -> IO Entry) -> IO Entry
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
keys ((Ptr CChar -> IO Entry) -> IO Entry)
-> (Ptr CChar -> IO Entry) -> IO Entry
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
keysPtr -> (Ptr CInt -> IO Entry) -> IO Entry
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Entry) -> IO Entry)
-> (Ptr CInt -> IO Entry) -> IO Entry
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
typPtr -> do
        dat <- Ptr CChar -> Keymap -> Ptr CInt -> IO (FunPtr CallbackC)
rl_function_of_keyseq Ptr CChar
keysPtr (Keymap -> Maybe Keymap -> Keymap
forall a. a -> Maybe a -> a
fromMaybe (Ptr KeymapTag -> Keymap
MkKeymap Ptr KeymapTag
forall a. Ptr a
nullPtr) Maybe Keymap
km) Ptr CInt
typPtr
        typ <- peek typPtr
        case typ of
            (CInt
0) ->
{-# LINE 664 "System/Console/Readline.hsc" #-}
                Entry -> IO Entry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Callback -> Entry
Function (FunPtr CallbackC -> Callback
importCallback FunPtr CallbackC
dat))
            (CInt
2) ->
{-# LINE 666 "System/Console/Readline.hsc" #-}
                (String -> Entry) -> IO String -> IO Entry
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Entry
Macro (Ptr CChar -> IO String
peekCString (FunPtr CallbackC -> Ptr CChar
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr CallbackC
dat))
            (CInt
1) ->
{-# LINE 668 "System/Console/Readline.hsc" #-}
                Entry -> IO Entry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Keymap -> Entry
Keymap (Ptr KeymapTag -> Keymap
MkKeymap (FunPtr CallbackC -> Ptr KeymapTag
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr CallbackC
dat)))
            CInt
_ -> String -> IO Entry
forall a. HasCallStack => String -> a
error String
"functionOfKeyseq: unknown type"
foreign import ccall unsafe "rl_function_of_keyseq"
  rl_function_of_keyseq :: Ptr CChar -> Keymap -> Ptr CInt -> IO (FunPtr CallbackC)

-- rl_invoking_keyseqs and rl_invoking_keyseqs_in_map are not provided
-- because Haskell functions have no identity.

functionDumper :: Bool -> IO ()
functionDumper :: Bool -> IO ()
functionDumper Bool
readable = CInt -> IO ()
rl_function_dumper (if Bool
readable then CInt
1 else CInt
0)
foreign import ccall unsafe "rl_function_dumper"
  rl_function_dumper :: CInt -> IO ()

foreign import ccall unsafe "rl_list_funmap_names" listFunmapNames :: IO ()


{-# LINE 684 "System/Console/Readline.hsc" #-}
funmapNames :: IO [String]
funmapNames :: IO [String]
funmapNames = do
    namesPtr <- IO (Ptr (Ptr CChar))
rl_funmap_names
    namePtrs <- peekArray0 nullPtr namesPtr
    free namesPtr
    mapM peekCString namePtrs
foreign import ccall unsafe "rl_funmap_names"
  rl_funmap_names :: IO (Ptr (Ptr CChar))

{-# LINE 693 "System/Console/Readline.hsc" #-}

exportCallback :: Callback -> IO (FunPtr CallbackC)
exportCallback :: Callback -> IO (FunPtr CallbackC)
exportCallback Callback
cb =
    CallbackC -> IO (FunPtr CallbackC)
exportCallbackC (CallbackC -> IO (FunPtr CallbackC))
-> CallbackC -> IO (FunPtr CallbackC)
forall a b. (a -> b) -> a -> b
$ \CInt
n CInt
key ->
        (Int -> CInt) -> IO Int -> IO CInt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Callback
cb (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n) (Int -> Char
chr (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
key)))
foreign import ccall "wrapper"
  exportCallbackC :: CallbackC -> IO (FunPtr CallbackC)

importCallback :: FunPtr CallbackC -> Callback
importCallback :: FunPtr CallbackC -> Callback
importCallback FunPtr CallbackC
ptr Int
n Char
key =
    (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
        FunPtr CallbackC -> CallbackC
importCallbackC FunPtr CallbackC
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key))
foreign import ccall "dynamic"
  importCallbackC :: FunPtr CallbackC -> CallbackC

------------------------------------------------------------------------
-- Allowing Undoing.

beginUndoGroup :: IO ()
beginUndoGroup :: IO ()
beginUndoGroup = do IO CInt
rl_begin_undo_group; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_begin_undo_group"
  rl_begin_undo_group :: IO CInt

endUndoGroup :: IO ()
endUndoGroup :: IO ()
endUndoGroup = do IO CInt
rl_end_undo_group; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_end_undo_group"
  rl_end_undo_group :: IO CInt

data UndoCode = UndoDelete | UndoInsert | UndoBegin | UndoEnd

addUndo :: UndoCode -> Int -> Int -> String -> IO ()
addUndo :: UndoCode -> Int -> Int -> String -> IO ()
addUndo UndoCode
uc Int
start Int
end String
text =
    String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
text ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr ->
        CInt -> CInt -> CInt -> Ptr CChar -> IO ()
rl_add_undo CInt
uc' (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end) Ptr CChar
textPtr
    where
    uc' :: CInt
uc' = case UndoCode
uc of
        UndoCode
UndoDelete -> CInt
0
{-# LINE 730 "System/Console/Readline.hsc" #-}
        UndoCode
UndoInsert -> CInt
1
{-# LINE 731 "System/Console/Readline.hsc" #-}
        UndoCode
UndoBegin  -> CInt
2
{-# LINE 732 "System/Console/Readline.hsc" #-}
        UndoCode
UndoEnd    -> CInt
3
{-# LINE 733 "System/Console/Readline.hsc" #-}
foreign import ccall unsafe
  rl_add_undo :: CInt -> CInt -> CInt -> Ptr CChar -> IO ()


{-# LINE 737 "System/Console/Readline.hsc" #-}
foreign import ccall unsafe "rl_free_undo_list" freeUndoList :: IO ()

{-# LINE 741 "System/Console/Readline.hsc" #-}

doUndo :: IO Bool
doUndo :: IO Bool
doUndo = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) IO CInt
rl_do_undo
foreign import ccall unsafe "rl_do_undo"
  rl_do_undo :: IO CInt

modifying :: Int -> Int -> IO ()
modifying :: Int -> Int -> IO ()
modifying Int
start Int
end = do
    CallbackC
rl_modifying (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end)
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_modifying"
  rl_modifying :: CInt -> CInt -> IO CInt

------------------------------------------------------------------------
-- Redisplay.

foreign import ccall unsafe "rl_redisplay" redisplay :: IO ()

forcedUpdateDisplay :: IO ()
forcedUpdateDisplay :: IO ()
forcedUpdateDisplay = do IO CInt
rl_forced_update_display; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_forced_update_display"
  rl_forced_update_display :: IO CInt

onNewLine :: IO ()
onNewLine :: IO ()
onNewLine = do IO CInt
rl_on_new_line; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_on_new_line"
  rl_on_new_line :: IO CInt


{-# LINE 770 "System/Console/Readline.hsc" #-}
onNewLineWithPrompt :: IO ()
onNewLineWithPrompt :: IO ()
onNewLineWithPrompt = do IO CInt
rl_on_new_line_with_prompt; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_on_new_line_with_prompt"
  rl_on_new_line_with_prompt :: IO CInt

{-# LINE 775 "System/Console/Readline.hsc" #-}

resetLineState :: IO ()
resetLineState :: IO ()
resetLineState = do IO CInt
rl_reset_line_state; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_reset_line_state"
  rl_reset_line_state :: IO CInt

message :: String -> IO ()
message :: String -> IO ()
message String
s = String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
s Ptr CChar -> IO ()
hs_rl_message
foreign import ccall unsafe "hs_rl_message"
  hs_rl_message :: Ptr CChar -> IO ()

clearMessage :: IO ()
clearMessage :: IO ()
clearMessage = do IO CInt
rl_clear_message; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_clear_message"
  rl_clear_message :: IO CInt


{-# LINE 792 "System/Console/Readline.hsc" #-}
foreign import ccall unsafe "rl_save_prompt" savePrompt :: IO ()

foreign import ccall unsafe "rl_restore_prompt" restorePrompt :: IO ()

{-# LINE 796 "System/Console/Readline.hsc" #-}

------------------------------------------------------------------------
-- Modifying Text.

insertText :: String -> IO ()
insertText :: String -> IO ()
insertText String
s = do String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
s Ptr CChar -> IO CInt
rl_insert_text; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_insert_text"
  rl_insert_text :: Ptr CChar -> IO CInt

deleteText :: Int -> Int -> IO ()
deleteText :: Int -> Int -> IO ()
deleteText Int
start Int
end = do
    CallbackC
rl_delete_text (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end)
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_delete_text"
  rl_delete_text :: CInt -> CInt -> IO CInt

copyText :: Int -> Int -> IO String
copyText :: Int -> Int -> IO String
copyText Int
start Int
end = do
    ptr <- CInt -> CInt -> IO (Ptr CChar)
rl_copy_text (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end)
    text <- peekCString ptr
    free ptr
    return text
foreign import ccall unsafe "rl_copy_text"
  rl_copy_text :: CInt -> CInt -> IO (Ptr CChar)

killText :: Int -> Int -> IO ()
killText :: Int -> Int -> IO ()
killText Int
start Int
end = do
    CallbackC
rl_kill_text (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end)
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_kill_text"
  rl_kill_text :: CInt -> CInt -> IO CInt

------------------------------------------------------------------------
-- Utility functions.

readKey :: IO Char
readKey :: IO Char
readKey = (CInt -> Char) -> IO CInt -> IO Char
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Char
chr (Int -> Char) -> (CInt -> Int) -> CInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) IO CInt
rl_read_key
foreign import ccall unsafe "rl_read_key"
  rl_read_key :: IO CInt

stuffChar :: Char -> IO Bool
stuffChar :: Char -> IO Bool
stuffChar Char
key = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (CInt -> IO CInt
rl_stuff_char (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key)))
foreign import ccall unsafe "rl_stuff_char"
  rl_stuff_char :: CInt -> IO CInt

initialize :: IO ()
initialize :: IO ()
initialize = do IO CInt
rl_initialize; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_initialize"
  rl_initialize :: IO CInt

resetTerminal :: Maybe String -> IO ()
resetTerminal :: Maybe String -> IO ()
resetTerminal Maybe String
name = do
    (String -> (Ptr CChar -> IO CInt) -> IO CInt)
-> Maybe String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith String -> (Ptr CChar -> IO CInt) -> IO CInt
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString Maybe String
name Ptr CChar -> IO CInt
rl_reset_terminal
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_reset_terminal"
  rl_reset_terminal :: Ptr CChar -> IO CInt

ding :: IO Bool
ding :: IO Bool
ding = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) IO CInt
rl_ding

{-# LINE 856 "System/Console/Readline.hsc" #-}
foreign import ccall unsafe "rl_ding" rl_ding :: IO CInt

{-# LINE 860 "System/Console/Readline.hsc" #-}


{-# LINE 862 "System/Console/Readline.hsc" #-}
displayMatchList :: [String] -> IO ()
displayMatchList :: [String] -> IO ()
displayMatchList [String]
matches =
    (String -> (Ptr CChar -> IO ()) -> IO ())
-> [String] -> ([Ptr CChar] -> IO ()) -> IO ()
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString [String]
matches (([Ptr CChar] -> IO ()) -> IO ())
-> ([Ptr CChar] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
matchPtrs ->
        Ptr CChar -> [Ptr CChar] -> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 Ptr CChar
forall a. Ptr a
nullPtr (Ptr CChar
forall a. Ptr a
nullPtrPtr CChar -> [Ptr CChar] -> [Ptr CChar]
forall a. a -> [a] -> [a]
:[Ptr CChar]
matchPtrs) ((Ptr (Ptr CChar) -> IO ()) -> IO ())
-> (Ptr (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
matchesPtr ->
            Ptr (Ptr CChar) -> CInt -> CInt -> IO ()
rl_display_match_list
                Ptr (Ptr CChar)
matchesPtr
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
matches))
                (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
matches)))
foreign import ccall unsafe "rl_display_match_list"
  rl_display_match_list :: Ptr (Ptr CChar) -> CInt -> CInt -> IO ()

{-# LINE 873 "System/Console/Readline.hsc" #-}

------------------------------------------------------------------------
-- Alternate Interface.

type Handler = Ptr CChar -> IO ()

callbackHandlerInstall :: String -> (String -> IO ()) -> IO (IO ())
callbackHandlerInstall :: String -> (String -> IO ()) -> IO (IO ())
callbackHandlerInstall String
prompt String -> IO ()
lhandler = do
    lhandlerPtr <- (Ptr CChar -> IO ()) -> IO (FunPtr (Ptr CChar -> IO ()))
exportHandler ((Ptr CChar -> IO ()) -> IO (FunPtr (Ptr CChar -> IO ())))
-> (Ptr CChar -> IO ()) -> IO (FunPtr (Ptr CChar -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
linePtr -> Ptr CChar -> IO String
peekCString Ptr CChar
linePtr IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
lhandler
    withCString prompt $ \Ptr CChar
promptPtr -> do
        Ptr CChar -> FunPtr (Ptr CChar -> IO ()) -> IO ()
rl_callback_handler_install Ptr CChar
promptPtr FunPtr (Ptr CChar -> IO ())
lhandlerPtr
    return (do rl_callback_handler_remove; freeHaskellFunPtr lhandlerPtr)
foreign import ccall "wrapper"
  exportHandler :: Handler -> IO (FunPtr Handler)
foreign import ccall unsafe "rl_callback_handler_install"
  rl_callback_handler_install :: Ptr CChar -> FunPtr Handler -> IO ()
foreign import ccall unsafe "rl_callback_handler_remove"
  rl_callback_handler_remove :: IO ()

foreign import ccall "rl_callback_read_char"
  callbackReadChar :: IO ()

------------------------------------------------------------------------
-- Readline Signal Handling.


{-# LINE 899 "System/Console/Readline.hsc" #-}
setCatchSignals :: Bool -> IO ()
setCatchSignals :: Bool -> IO ()
setCatchSignals Bool
cat = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_catch_signals (if Bool
cat then CInt
1 else CInt
0)

getCatchSignals :: IO Bool
getCatchSignals :: IO Bool
getCatchSignals = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_catch_signals)

foreign import ccall "&" rl_catch_signals :: Ptr CInt

setCatchSigwinch :: Bool -> IO ()
setCatchSigwinch :: Bool -> IO ()
setCatchSigwinch Bool
cat = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_catch_sigwinch (if Bool
cat then CInt
1 else CInt
0)

getCatchSigwinch :: IO Bool
getCatchSigwinch :: IO Bool
getCatchSigwinch = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_catch_sigwinch)

foreign import ccall "&" rl_catch_sigwinch :: Ptr CInt

foreign import ccall unsafe "rl_cleanup_after_signal" cleanupAfterSignal :: IO ()

foreign import ccall unsafe "rl_free_line_state" freeLineState :: IO ()

foreign import ccall unsafe "rl_reset_after_signal" resetAfterSignal :: IO ()

foreign import ccall unsafe "rl_resize_terminal" resizeTerminal :: IO ()

{-# LINE 923 "System/Console/Readline.hsc" #-}

setSignals :: IO ()
setSignals :: IO ()
setSignals = do IO CInt
rl_set_signals; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_set_signals"
  rl_set_signals :: IO CInt

clearSignals :: IO ()
clearSignals :: IO ()
clearSignals = do IO CInt
rl_clear_signals; () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall unsafe "rl_clear_signals"
  rl_clear_signals :: IO CInt

------------------------------------------------------------------------
-- Completion functions.

completeInternal :: Char -> IO ()
completeInternal :: Char -> IO ()
completeInternal Char
what = do
    CInt -> IO CInt
rl_complete_internal (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
what))
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
foreign import ccall "rl_complete_internal"
  rl_complete_internal :: CInt -> IO CInt

complete :: Int -> Char -> IO Int
complete :: Callback
complete Int
n Char
key =
    (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
        CallbackC
rl_complete (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key))
foreign import ccall "rl_complete"
  rl_complete :: CInt -> CInt -> IO CInt

possibleCompletions :: Int -> Char -> IO Int
possibleCompletions :: Callback
possibleCompletions Int
n Char
key =
    (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
        CallbackC
rl_possible_completions (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key))
foreign import ccall "rl_possible_completions"
  rl_possible_completions :: CInt -> CInt -> IO CInt

insertCompletions :: Int -> Char -> IO Int
insertCompletions :: Callback
insertCompletions Int
n Char
key =
    (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
        CallbackC
rl_insert_completions (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key))
foreign import ccall "rl_insert_completions"
  rl_insert_completions :: CInt -> CInt -> IO CInt

type Generator = Ptr CChar -> CInt -> IO (Ptr CChar)

singleToWhole :: Generator -> String -> IO [String]
singleToWhole :: Generator -> String -> IO [String]
singleToWhole Generator
f String
text =
    String -> (Ptr CChar -> IO [String]) -> IO [String]
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
text ((Ptr CChar -> IO [String]) -> IO [String])
-> (Ptr CChar -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr -> let
        loop :: CInt -> IO [String]
loop CInt
n = do
            ptr <- Generator
f Ptr CChar
textPtr CInt
n
            if ptr == nullPtr
                then return []
                else do
                    str <- peekCString ptr
                    free ptr
                    rest <- loop (n+1)
                    return (str:rest)
        in CInt -> IO [String]
loop CInt
0

wholeToSingle :: (String -> IO [String]) -> IO Generator
wholeToSingle :: (String -> IO [String]) -> IO Generator
wholeToSingle String -> IO [String]
f = do
    ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
    return $ \Ptr CChar
textPtr CInt
state -> do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
state CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO String
peekCString Ptr CChar
textPtr IO String -> (String -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO [String]
f IO [String] -> ([String] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef [String] -> [String] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [String]
ref
        next <- IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref
        case next of
            []   -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
            String
x:[String]
xs -> do
                IORef [String] -> [String] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [String]
ref [String]
xs
                String -> IO (Ptr CChar)
newCString String
x

completionMatches
    :: String -> (String -> IO [String]) -> IO (Maybe (String, [String]))
completionMatches :: String -> (String -> IO [String]) -> IO (Maybe (String, [String]))
completionMatches String
text String -> IO [String]
entry =
    String
-> (Ptr CChar -> IO (Maybe (String, [String])))
-> IO (Maybe (String, [String]))
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
text ((Ptr CChar -> IO (Maybe (String, [String])))
 -> IO (Maybe (String, [String])))
-> (Ptr CChar -> IO (Maybe (String, [String])))
-> IO (Maybe (String, [String]))
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr -> do
        entryPtr <- (String -> IO [String]) -> IO Generator
wholeToSingle String -> IO [String]
entry IO Generator
-> (Generator -> IO (FunPtr Generator)) -> IO (FunPtr Generator)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Generator -> IO (FunPtr Generator)
exportGenerator
        matchesPtr <- rl_completion_matches textPtr entryPtr
        freeHaskellFunPtr entryPtr
        if matchesPtr == nullPtr then return Nothing else do
            matchPtrs <- peekArray0 nullPtr matchesPtr
            (text':matches) <- mapM peekCString matchPtrs
            mapM_ free matchPtrs
            free matchesPtr
            return (Just (text', matches))

{-# LINE 1007 "System/Console/Readline.hsc" #-}
foreign import ccall "rl_completion_matches"
    rl_completion_matches :: Ptr CChar -> FunPtr Generator -> IO (Ptr (Ptr CChar))

{-# LINE 1013 "System/Console/Readline.hsc" #-}

filenameCompletionFunction :: String -> IO [String]
filenameCompletionFunction :: String -> IO [String]
filenameCompletionFunction = Generator -> String -> IO [String]
singleToWhole Generator
rl_filename_completion_function

{-# LINE 1017 "System/Console/Readline.hsc" #-}
foreign import ccall unsafe "rl_filename_completion_function"
  rl_filename_completion_function :: Generator

{-# LINE 1023 "System/Console/Readline.hsc" #-}

usernameCompletionFunction :: String -> IO [String]
usernameCompletionFunction :: String -> IO [String]
usernameCompletionFunction = Generator -> String -> IO [String]
singleToWhole Generator
rl_username_completion_function

{-# LINE 1027 "System/Console/Readline.hsc" #-}
foreign import ccall unsafe "rl_username_completion_function"
  rl_username_completion_function :: Generator

{-# LINE 1033 "System/Console/Readline.hsc" #-}

setCompletionEntryFunction :: Maybe (String -> IO [String]) -> IO ()
setCompletionEntryFunction :: Maybe (String -> IO [String]) -> IO ()
setCompletionEntryFunction Maybe (String -> IO [String])
fun =
    Ptr (FunPtr Generator)
-> Maybe (String -> IO [String])
-> ((String -> IO [String]) -> IO (FunPtr Generator))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr Generator)
rl_completion_entry_function Maybe (String -> IO [String])
fun (((String -> IO [String]) -> IO (FunPtr Generator)) -> IO ())
-> ((String -> IO [String]) -> IO (FunPtr Generator)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String -> IO [String]
f ->
        (String -> IO [String]) -> IO Generator
wholeToSingle String -> IO [String]
f IO Generator
-> (Generator -> IO (FunPtr Generator)) -> IO (FunPtr Generator)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Generator -> IO (FunPtr Generator)
exportGenerator
foreign import ccall "&" rl_completion_entry_function :: Ptr (FunPtr Generator)

foreign import ccall "wrapper"
    exportGenerator :: Generator -> IO (FunPtr Generator)

type Completer = Ptr CChar -> CInt -> CInt -> IO (Ptr (Ptr CChar))

setAttemptedCompletionFunction
    :: Maybe (String -> Int -> Int -> IO (Maybe (String, [String]))) -> IO ()
setAttemptedCompletionFunction :: Maybe (String -> Int -> Int -> IO (Maybe (String, [String])))
-> IO ()
setAttemptedCompletionFunction Maybe (String -> Int -> Int -> IO (Maybe (String, [String])))
fun =
    Ptr (FunPtr Completer)
-> Maybe (String -> Int -> Int -> IO (Maybe (String, [String])))
-> ((String -> Int -> Int -> IO (Maybe (String, [String])))
    -> IO (FunPtr Completer))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr Completer)
rl_attempted_completion_function Maybe (String -> Int -> Int -> IO (Maybe (String, [String])))
fun (((String -> Int -> Int -> IO (Maybe (String, [String])))
  -> IO (FunPtr Completer))
 -> IO ())
-> ((String -> Int -> Int -> IO (Maybe (String, [String])))
    -> IO (FunPtr Completer))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String -> Int -> Int -> IO (Maybe (String, [String]))
f ->
        Completer -> IO (FunPtr Completer)
exportCompleter (Completer -> IO (FunPtr Completer))
-> Completer -> IO (FunPtr Completer)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr CInt
start CInt
end -> do
            text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            found <- f text (fromIntegral start) (fromIntegral end)
            case found of
                Maybe (String, [String])
Nothing -> Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
forall a. Ptr a
nullPtr
                Just (String
text', [String]
matches) -> do
                    matchPtrs <- (String -> IO (Ptr CChar)) -> [String] -> IO [Ptr CChar]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> IO (Ptr CChar)
newCString (String
text'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
matches)
                    matchesPtr <- mallocArray (length matchPtrs + 1)
                    pokeArray0 nullPtr matchesPtr matchPtrs
                    return matchesPtr

foreign import ccall "&"   rl_attempted_completion_function :: Ptr (FunPtr Completer)
foreign import ccall "wrapper"
    exportCompleter :: Completer -> IO (FunPtr Completer)


{-# LINE 1065 "System/Console/Readline.hsc" #-}
type StringFunc = IO (Ptr CChar)

foreign import ccall "&" rl_completion_word_break_hook
    :: Ptr (FunPtr StringFunc)

foreign import ccall "wrapper"
    exportStringFunc :: StringFunc -> IO (FunPtr StringFunc)

setCompletionWordBreakHook
    :: Maybe (IO (Maybe String)) -> IO ()
setCompletionWordBreakHook :: Maybe (IO (Maybe String)) -> IO ()
setCompletionWordBreakHook Maybe (IO (Maybe String))
fun =
    Ptr (FunPtr (IO (Ptr CChar)))
-> Maybe (IO (Maybe String))
-> (IO (Maybe String) -> IO (FunPtr (IO (Ptr CChar))))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr (IO (Ptr CChar)))
rl_completion_word_break_hook Maybe (IO (Maybe String))
fun ((IO (Maybe String) -> IO (FunPtr (IO (Ptr CChar)))) -> IO ())
-> (IO (Maybe String) -> IO (FunPtr (IO (Ptr CChar)))) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO (Maybe String)
f ->
        IO (Ptr CChar) -> IO (FunPtr (IO (Ptr CChar)))
exportStringFunc (IO (Ptr CChar) -> IO (FunPtr (IO (Ptr CChar))))
-> IO (Ptr CChar) -> IO (FunPtr (IO (Ptr CChar)))
forall a b. (a -> b) -> a -> b
$ do
            wordBreaks <- IO (Maybe String)
f
            case wordBreaks of
                Maybe String
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
                Just String
wordBreaksString -> String -> IO (Ptr CChar)
newCString String
wordBreaksString


{-# LINE 1084 "System/Console/Readline.hsc" #-}

type Quoter = Ptr CChar -> CInt -> Ptr CChar -> IO (Ptr CChar)

setFilenameQuotingFunction
    :: Maybe (String -> Bool -> Ptr CChar -> IO String) -> IO ()
setFilenameQuotingFunction :: Maybe (String -> Bool -> Ptr CChar -> IO String) -> IO ()
setFilenameQuotingFunction Maybe (String -> Bool -> Ptr CChar -> IO String)
fun =
    (FunPtr Quoter -> Bool)
-> Ptr (FunPtr Quoter)
-> Maybe (String -> Bool -> Ptr CChar -> IO String)
-> ((String -> Bool -> Ptr CChar -> IO String)
    -> IO (FunPtr Quoter))
-> IO ()
forall a b.
(FunPtr a -> Bool)
-> Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr_freeIf
        (\FunPtr Quoter
oldPtr -> FunPtr Quoter
oldPtr FunPtr Quoter -> FunPtr Quoter -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr Quoter
forall a. FunPtr a
nullFunPtr Bool -> Bool -> Bool
&& FunPtr Quoter
oldPtr FunPtr Quoter -> FunPtr Quoter -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr Quoter
rl_quote_filename)
        Ptr (FunPtr Quoter)
rl_filename_quoting_function Maybe (String -> Bool -> Ptr CChar -> IO String)
fun (((String -> Bool -> Ptr CChar -> IO String) -> IO (FunPtr Quoter))
 -> IO ())
-> ((String -> Bool -> Ptr CChar -> IO String)
    -> IO (FunPtr Quoter))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String -> Bool -> Ptr CChar -> IO String
f ->
        Quoter -> IO (FunPtr Quoter)
exportQuoter (Quoter -> IO (FunPtr Quoter)) -> Quoter -> IO (FunPtr Quoter)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr CInt
typ Ptr CChar
qp -> do
            text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            s <- f text (typ == (2)) qp
{-# LINE 1096 "System/Console/Readline.hsc" #-}
            newCString s
foreign import ccall "&"  rl_filename_quoting_function :: Ptr (FunPtr Quoter)
foreign import ccall "wrapper"
  exportQuoter :: Quoter -> IO (FunPtr Quoter)

-- We must not freeHaskellFunPtr the original value of the
-- rl_filename_quoting_function variable, because it's a native C
-- function. But this value, rl_quote_filename, is a static function,
-- not exported by readline. So we read it from the variable at the
-- beginning and store it in a Haskell's global variable. We also
-- export its Haskell translation to be able to restore its behavior
-- by setFilenameQuotingFunction.

{-# NOINLINE rl_quote_filename #-}
rl_quote_filename :: FunPtr Quoter
rl_quote_filename :: FunPtr Quoter
rl_quote_filename = IO (FunPtr Quoter) -> FunPtr Quoter
forall a. IO a -> a
unsafePerformIO (IO (FunPtr Quoter) -> FunPtr Quoter)
-> IO (FunPtr Quoter) -> FunPtr Quoter
forall a b. (a -> b) -> a -> b
$ Ptr (FunPtr Quoter) -> IO (FunPtr Quoter)
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr Quoter)
rl_filename_quoting_function

quoteFilename :: String -> Bool -> Ptr CChar -> IO String
quoteFilename :: String -> Bool -> Ptr CChar -> IO String
quoteFilename String
text Bool
typ Ptr CChar
qp = do
    ptr <- String -> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
text ((Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr CChar -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr ->
        FunPtr Quoter -> Quoter
importQuoter FunPtr Quoter
rl_quote_filename
            Ptr CChar
textPtr
            (if Bool
typ then (CInt
1) else (CInt
2))
{-# LINE 1119 "System/Console/Readline.hsc" #-}
            Ptr CChar
qp
    s <- peekCString ptr
    free ptr
    return s
foreign import ccall "dynamic" importQuoter :: FunPtr Quoter -> Quoter

type Dequoter = Ptr CChar -> CInt -> IO (Ptr CChar)

setFilenameDequotingFunction :: Maybe (String -> Maybe Char -> IO String) -> IO ()
setFilenameDequotingFunction :: Maybe (String -> Maybe Char -> IO String) -> IO ()
setFilenameDequotingFunction Maybe (String -> Maybe Char -> IO String)
fun =
    Ptr (FunPtr Generator)
-> Maybe (String -> Maybe Char -> IO String)
-> ((String -> Maybe Char -> IO String) -> IO (FunPtr Generator))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr Generator)
rl_filename_dequoting_function Maybe (String -> Maybe Char -> IO String)
fun (((String -> Maybe Char -> IO String) -> IO (FunPtr Generator))
 -> IO ())
-> ((String -> Maybe Char -> IO String) -> IO (FunPtr Generator))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \String -> Maybe Char -> IO String
f ->
        Generator -> IO (FunPtr Generator)
exportDequoter (Generator -> IO (FunPtr Generator))
-> Generator -> IO (FunPtr Generator)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr CInt
qc -> do
            text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            s <- f text (if qc==0 then Nothing else Just (chr (fromIntegral qc)))
            newCString s

foreign import ccall "&"rl_filename_dequoting_function :: Ptr (FunPtr Dequoter)

foreign import ccall "wrapper"
  exportDequoter :: Dequoter -> IO (FunPtr Dequoter)

type IsQuoted = Ptr CChar -> CInt -> IO CInt

setCharIsQuotedP :: Maybe (String -> Int -> IO Bool) -> IO ()
setCharIsQuotedP :: Maybe (String -> Int -> IO Bool) -> IO ()
setCharIsQuotedP Maybe (String -> Int -> IO Bool)
fun =
    Ptr (FunPtr IsQuoted)
-> Maybe (String -> Int -> IO Bool)
-> ((String -> Int -> IO Bool) -> IO (FunPtr IsQuoted))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr IsQuoted)
rl_char_is_quoted_p Maybe (String -> Int -> IO Bool)
fun (((String -> Int -> IO Bool) -> IO (FunPtr IsQuoted)) -> IO ())
-> ((String -> Int -> IO Bool) -> IO (FunPtr IsQuoted)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String -> Int -> IO Bool
f ->
        IsQuoted -> IO (FunPtr IsQuoted)
exportIsQuoted (IsQuoted -> IO (FunPtr IsQuoted))
-> IsQuoted -> IO (FunPtr IsQuoted)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr CInt
index -> do
            text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            quoted <- f text (fromIntegral index)
            return (if quoted then 1 else 0)
foreign import ccall "&" rl_char_is_quoted_p :: Ptr (FunPtr IsQuoted)

foreign import ccall "wrapper"
  exportIsQuoted :: IsQuoted -> IO (FunPtr IsQuoted)

getCompletionQueryItems :: IO Int
getCompletionQueryItems :: IO Int
getCompletionQueryItems =
    (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_completion_query_items)

setCompletionQueryItems :: Int -> IO ()
setCompletionQueryItems :: Int -> IO ()
setCompletionQueryItems Int
items =
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_completion_query_items (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
items)

foreign import ccall "&" rl_completion_query_items :: Ptr CInt

getBasicWordBreakCharacters :: IO String
getBasicWordBreakCharacters :: IO String
getBasicWordBreakCharacters = Ptr (Ptr CChar) -> IO String
getCharacters Ptr (Ptr CChar)
rl_basic_word_break_characters

setBasicWordBreakCharacters :: String -> IO ()
setBasicWordBreakCharacters :: String -> IO ()
setBasicWordBreakCharacters =
    (Ptr CChar -> Bool) -> Ptr (Ptr CChar) -> String -> IO ()
setCharacters_freeIf
        (Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
orig_rl_basic_word_break_characters)
        Ptr (Ptr CChar)
rl_basic_word_break_characters

foreign import ccall "&" rl_basic_word_break_characters :: Ptr (Ptr CChar)

-- Similarly to rl_quote_filename, we must be able to detect the
-- original pointer to a static char array.

{-# NOINLINE orig_rl_basic_word_break_characters #-}
orig_rl_basic_word_break_characters :: Ptr CChar
orig_rl_basic_word_break_characters :: Ptr CChar
orig_rl_basic_word_break_characters = IO (Ptr CChar) -> Ptr CChar
forall a. IO a -> a
unsafePerformIO (IO (Ptr CChar) -> Ptr CChar) -> IO (Ptr CChar) -> Ptr CChar
forall a b. (a -> b) -> a -> b
$
    Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_basic_word_break_characters

getBasicQuoteCharacters :: IO String
getBasicQuoteCharacters :: IO String
getBasicQuoteCharacters = Ptr (Ptr CChar) -> IO String
getCharacters Ptr (Ptr CChar)
rl_basic_quote_characters

setBasicQuoteCharacters :: String -> IO ()
setBasicQuoteCharacters :: String -> IO ()
setBasicQuoteCharacters =
    (Ptr CChar -> Bool) -> Ptr (Ptr CChar) -> String -> IO ()
setCharacters_freeIf
        (Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
orig_rl_basic_quote_characters)
        Ptr (Ptr CChar)
rl_basic_quote_characters

foreign import ccall "&" rl_basic_quote_characters :: Ptr (Ptr CChar)

{-# NOINLINE orig_rl_basic_quote_characters #-}
orig_rl_basic_quote_characters :: Ptr CChar
orig_rl_basic_quote_characters :: Ptr CChar
orig_rl_basic_quote_characters = IO (Ptr CChar) -> Ptr CChar
forall a. IO a -> a
unsafePerformIO (IO (Ptr CChar) -> Ptr CChar) -> IO (Ptr CChar) -> Ptr CChar
forall a b. (a -> b) -> a -> b
$
    Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_basic_quote_characters

getCompleterWordBreakCharacters :: IO String
getCompleterWordBreakCharacters :: IO String
getCompleterWordBreakCharacters = Ptr (Ptr CChar) -> IO String
getCharacters Ptr (Ptr CChar)
rl_completer_word_break_characters

setCompleterWordBreakCharacters :: String -> IO ()
setCompleterWordBreakCharacters :: String -> IO ()
setCompleterWordBreakCharacters =
    (Ptr CChar -> Bool) -> Ptr (Ptr CChar) -> String -> IO ()
setCharacters_freeIf
        (\Ptr CChar
oldPtr -> Ptr CChar
oldPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
forall a. Ptr a
nullPtr Bool -> Bool -> Bool
&&
                    Ptr CChar
oldPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
orig_rl_basic_word_break_characters)
        Ptr (Ptr CChar)
rl_completer_word_break_characters

foreign import ccall "&" rl_completer_word_break_characters :: Ptr (Ptr CChar)

getCompleterQuoteCharacters :: IO String
getCompleterQuoteCharacters :: IO String
getCompleterQuoteCharacters = Ptr (Ptr CChar) -> IO String
getCharacters Ptr (Ptr CChar)
rl_completer_quote_characters

setCompleterQuoteCharacters :: String -> IO ()
setCompleterQuoteCharacters :: String -> IO ()
setCompleterQuoteCharacters String
cs = do
    oldPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_completer_quote_characters
    when (oldPtr /= nullPtr) $ free oldPtr
    -- I think that rl_completer_quote_characters should never be empty
    -- but can be NULL.
    newPtr <- if null cs
        then return nullPtr
        else do
            ptr <- mallocArray (length cs + 1)
            pokeArray0 0 ptr (map castCharToCChar cs)
            return ptr
    poke rl_completer_quote_characters newPtr

foreign import ccall "&" rl_completer_quote_characters :: Ptr (Ptr CChar)

getFilenameQuoteCharacters :: IO String
getFilenameQuoteCharacters :: IO String
getFilenameQuoteCharacters = Ptr (Ptr CChar) -> IO String
getCharacters Ptr (Ptr CChar)
rl_filename_quote_characters

setFilenameQuoteCharacters :: String -> IO ()
setFilenameQuoteCharacters :: String -> IO ()
setFilenameQuoteCharacters = Ptr (Ptr CChar) -> String -> IO ()
setCharacters Ptr (Ptr CChar)
rl_filename_quote_characters

foreign import ccall "&" rl_filename_quote_characters :: Ptr (Ptr CChar)

getSpecialPrefixes :: IO String
getSpecialPrefixes :: IO String
getSpecialPrefixes = Ptr (Ptr CChar) -> IO String
getCharacters Ptr (Ptr CChar)
rl_special_prefixes

setSpecialPrefixes :: String -> IO ()
setSpecialPrefixes :: String -> IO ()
setSpecialPrefixes = Ptr (Ptr CChar) -> String -> IO ()
setCharacters Ptr (Ptr CChar)
rl_special_prefixes

foreign import ccall "&" rl_special_prefixes :: Ptr (Ptr CChar)

getCompletionAppendCharacter :: IO (Maybe Char)
getCompletionAppendCharacter :: IO (Maybe Char)
getCompletionAppendCharacter = do
    ch <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_completion_append_character
    return $ if ch == 0 then Nothing else Just (chr (fromIntegral ch))

setCompletionAppendCharacter :: Maybe Char -> IO ()
setCompletionAppendCharacter :: Maybe Char -> IO ()
setCompletionAppendCharacter Maybe Char
ch =
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_completion_append_character (CInt -> (Char -> CInt) -> Maybe Char -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CInt
0 (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Char -> Int) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) Maybe Char
ch)

foreign import ccall "&" rl_completion_append_character :: Ptr CInt

setIgnoreCompletionDuplicates :: Bool -> IO ()
setIgnoreCompletionDuplicates :: Bool -> IO ()
setIgnoreCompletionDuplicates Bool
ign =
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_ignore_completion_duplicates (if Bool
ign then CInt
1 else CInt
0)

getIgnoreCompletionDuplicates :: IO Bool
getIgnoreCompletionDuplicates :: IO Bool
getIgnoreCompletionDuplicates =
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_ignore_completion_duplicates)

foreign import ccall "&" rl_ignore_completion_duplicates :: Ptr CInt

setFilenameCompletionDesired :: Bool -> IO ()
setFilenameCompletionDesired :: Bool -> IO ()
setFilenameCompletionDesired Bool
comp =
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_filename_completion_desired (if Bool
comp then CInt
1 else CInt
0)

getFilenameCompletionDesired :: IO Bool
getFilenameCompletionDesired :: IO Bool
getFilenameCompletionDesired =
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_filename_completion_desired)

foreign import ccall "&" rl_filename_completion_desired :: Ptr CInt

setFilenameQuotingDesired :: Bool -> IO ()
setFilenameQuotingDesired :: Bool -> IO ()
setFilenameQuotingDesired Bool
quot =
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_filename_quoting_desired (if Bool
quot then CInt
1 else CInt
0)

getFilenameQuotingDesired :: IO Bool
getFilenameQuotingDesired :: IO Bool
getFilenameQuotingDesired =
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_filename_quoting_desired)

foreign import ccall "&" rl_filename_quoting_desired :: Ptr CInt

setInhibitCompletion :: Bool -> IO ()
setInhibitCompletion :: Bool -> IO ()
setInhibitCompletion Bool
inh = Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_inhibit_completion (if Bool
inh then CInt
1 else CInt
0)

getInhibitCompletion :: IO Bool
getInhibitCompletion :: IO Bool
getInhibitCompletion = (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_inhibit_completion)

foreign import ccall "&" rl_attempted_completion_over :: Ptr CInt

getAttemptedCompletionOver :: IO Bool
getAttemptedCompletionOver :: IO Bool
getAttemptedCompletionOver =
    (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=CInt
0) (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_attempted_completion_over)

setAttemptedCompletionOver :: Bool -> IO ()
setAttemptedCompletionOver :: Bool -> IO ()
setAttemptedCompletionOver Bool
over =
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
rl_attempted_completion_over (if Bool
over then CInt
1 else CInt
0)

foreign import ccall "&" rl_inhibit_completion :: Ptr CInt

type Ignorer = Ptr (Ptr CChar) -> IO CInt

setIgnoreSomeCompletionsFunction :: Maybe ([String] -> IO [String]) -> IO ()
-- The function may not make the list longer!
setIgnoreSomeCompletionsFunction :: Maybe ([String] -> IO [String]) -> IO ()
setIgnoreSomeCompletionsFunction Maybe ([String] -> IO [String])
fun =
    Ptr (FunPtr Ignorer)
-> Maybe ([String] -> IO [String])
-> (([String] -> IO [String]) -> IO (FunPtr Ignorer))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr Ignorer)
rl_ignore_some_completions_function Maybe ([String] -> IO [String])
fun ((([String] -> IO [String]) -> IO (FunPtr Ignorer)) -> IO ())
-> (([String] -> IO [String]) -> IO (FunPtr Ignorer)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[String] -> IO [String]
f ->
        Ignorer -> IO (FunPtr Ignorer)
exportIgnorer (Ignorer -> IO (FunPtr Ignorer)) -> Ignorer -> IO (FunPtr Ignorer)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
matchesPtr -> do
            matchPtrs <- Ptr CChar -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
matchesPtr
            matches <- mapM peekCString matchPtrs
            mapM_ free matchPtrs
            f matches >>= mapM newCString >>= pokeArray0 nullPtr matchesPtr
            return 0
foreign import ccall "&" rl_ignore_some_completions_function :: Ptr (FunPtr Ignorer)

foreign import ccall "wrapper"
  exportIgnorer :: Ignorer -> IO (FunPtr Ignorer)

type DirCompleter = Ptr (Ptr CChar) -> IO CInt

setDirectoryCompletionHook :: Maybe (String -> IO String) -> IO ()
setDirectoryCompletionHook :: Maybe (String -> IO String) -> IO ()
setDirectoryCompletionHook Maybe (String -> IO String)
fun =
    Ptr (FunPtr Ignorer)
-> Maybe (String -> IO String)
-> ((String -> IO String) -> IO (FunPtr Ignorer))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr Ignorer)
rl_directory_completion_hook Maybe (String -> IO String)
fun (((String -> IO String) -> IO (FunPtr Ignorer)) -> IO ())
-> ((String -> IO String) -> IO (FunPtr Ignorer)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String -> IO String
f ->
        Ignorer -> IO (FunPtr Ignorer)
exportDirCompleter (Ignorer -> IO (FunPtr Ignorer)) -> Ignorer -> IO (FunPtr Ignorer)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
dirPtrPtr -> do
            oldDirPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dirPtrPtr
            oldDir <- peekCString oldDirPtr
            free oldDirPtr
            newDirPtr <- f oldDir >>= newCString
            poke dirPtrPtr newDirPtr
            return 0
foreign import ccall "&" rl_directory_completion_hook :: Ptr (FunPtr DirCompleter)
foreign import ccall "wrapper"
    exportDirCompleter :: DirCompleter -> IO (FunPtr DirCompleter)


{-# LINE 1339 "System/Console/Readline.hsc" #-}
type Displayer = Ptr (Ptr CChar) -> CInt -> CInt -> IO ()

setCompletionDisplayMatchesHook :: Maybe ([String] -> IO ()) -> IO ()
setCompletionDisplayMatchesHook :: Maybe ([String] -> IO ()) -> IO ()
setCompletionDisplayMatchesHook Maybe ([String] -> IO ())
fun =
    Ptr (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ()))
-> Maybe ([String] -> IO ())
-> (([String] -> IO ())
    -> IO (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ())))
-> IO ()
forall a b.
Ptr (FunPtr a) -> Maybe b -> (b -> IO (FunPtr a)) -> IO ()
setFunPtr Ptr (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ()))
rl_completion_display_matches_hook Maybe ([String] -> IO ())
fun ((([String] -> IO ())
  -> IO (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ())))
 -> IO ())
-> (([String] -> IO ())
    -> IO (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ())))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String] -> IO ()
f ->
        (Ptr (Ptr CChar) -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ()))
exportDisplayHook ((Ptr (Ptr CChar) -> CInt -> CInt -> IO ())
 -> IO (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ())))
-> (Ptr (Ptr CChar) -> CInt -> CInt -> IO ())
-> IO (FunPtr (Ptr (Ptr CChar) -> CInt -> CInt -> IO ()))
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
matchesPtr CInt
_ CInt
_ ->
            Ptr CChar -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
matchesPtr IO [Ptr CChar] -> ([Ptr CChar] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Ptr CChar -> IO String) -> [Ptr CChar] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Ptr CChar -> IO String
peekCString IO [String] -> ([String] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO ()
f
foreign import ccall "&" rl_completion_display_matches_hook :: Ptr (FunPtr Displayer)
foreign import ccall "wrapper"
    exportDisplayHook :: Displayer -> IO (FunPtr Displayer)

{-# LINE 1350 "System/Console/Readline.hsc" #-}

setCharacters_freeIf :: (Ptr CChar -> Bool) -> Ptr (Ptr CChar) -> String -> IO ()
setCharacters_freeIf :: (Ptr CChar -> Bool) -> Ptr (Ptr CChar) -> String -> IO ()
setCharacters_freeIf Ptr CChar -> Bool
pred Ptr (Ptr CChar)
variable String
chars = do
    oldPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
variable
    when (pred oldPtr) $ free oldPtr
    newPtr <- mallocArray (length chars + 1)
    pokeArray0 0 newPtr (map castCharToCChar chars)
    poke variable newPtr

setCharacters :: Ptr (Ptr CChar) -> String -> IO ()
setCharacters :: Ptr (Ptr CChar) -> String -> IO ()
setCharacters = (Ptr CChar -> Bool) -> Ptr (Ptr CChar) -> String -> IO ()
setCharacters_freeIf (Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
forall a. Ptr a
nullPtr)

getCharacters :: Ptr (Ptr CChar) -> IO String
getCharacters :: Ptr (Ptr CChar) -> IO String
getCharacters Ptr (Ptr CChar)
variable = do
    ptr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
variable
    if ptr == nullPtr then return "" else do
        cs <- peekArray0 0 ptr
        return (map castCCharToChar cs)