{-# 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 CChar
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
    ((Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String))
-> Ptr CChar -> (Ptr CChar -> IO String) -> IO (Maybe String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar
ptr ((Ptr CChar -> IO String) -> IO (Maybe String))
-> (Ptr CChar -> IO String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
ptr' -> do
        String
line <- Ptr CChar -> IO String
peekCString Ptr CChar
ptr'
        Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
ptr'
        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
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 CChar
ptr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_line_buffer
    CChar -> Ptr CChar -> [CChar] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 CChar
0 (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
ptr) [CChar]
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
    FunPtr (IO ())
oldPtr <- Ptr (FunPtr (IO ())) -> IO (FunPtr (IO ()))
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr (IO ()))
rl_redisplay_function
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr (IO ())
oldPtr FunPtr (IO ()) -> FunPtr (IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (IO ())
forall a. FunPtr a
nullFunPtr Bool -> Bool -> Bool
&& FunPtr (IO ())
oldPtr FunPtr (IO ()) -> FunPtr (IO ()) -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr (IO ())
rl_redisplay) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        FunPtr (IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr (IO ())
oldPtr
    FunPtr (IO ())
newPtr <- case Maybe (IO ())
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
    Ptr (FunPtr (IO ())) -> FunPtr (IO ()) -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr (IO ()))
rl_redisplay_function FunPtr (IO ())
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
    FunPtr a
oldPtr <- Ptr (FunPtr a) -> IO (FunPtr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (FunPtr a)
variable
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr a -> Bool
pred FunPtr a
oldPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr a -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr a
oldPtr
    FunPtr a
newPtr <- case Maybe b
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
    Ptr (FunPtr a) -> FunPtr a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr a)
variable FunPtr a
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 CChar
ptr <- Keymap -> IO (Ptr CChar)
rl_get_keymap_name Keymap
km
    (Ptr CChar -> IO String) -> Ptr CChar -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek Ptr CChar -> IO String
peekCString Ptr CChar
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
    Ptr CChar
namePtr <- String -> IO (Ptr CChar)
newCString String
name
    -- rl_add_defun does *not* make a copy of the function name.
    FunPtr CallbackC
cbPtr <- Callback -> IO (FunPtr CallbackC)
exportCallback Callback
cb
    -- The memory will never be freed. But readline does not provide
    -- removing defuns anyway.
    Ptr CChar -> FunPtr CallbackC -> CInt -> IO CInt
rl_add_defun Ptr CChar
namePtr FunPtr CallbackC
cbPtr (CInt -> (Char -> CInt) -> Maybe Char -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
1) (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
key)
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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
    FunPtr CallbackC
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.
    CInt -> FunPtr CallbackC -> IO CInt
rl_bind_key (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key)) FunPtr CallbackC
cbPtr
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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
    FunPtr CallbackC
cbPtr <- Callback -> IO (FunPtr CallbackC)
exportCallback Callback
cb
    CInt -> FunPtr CallbackC -> Keymap -> IO CInt
rl_bind_key_in_map (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
key)) FunPtr CallbackC
cbPtr Keymap
km
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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
    FunPtr CallbackC
cbPtr <- Callback -> IO (FunPtr CallbackC)
exportCallback Callback
cb
    CInt -> String -> Ptr CChar -> Keymap -> IO ()
genericBind' (CInt
0) String
keys (FunPtr CallbackC -> Ptr CChar
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr CallbackC
cbPtr) Keymap
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
    CInt
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
ok CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall a. IOError -> IO a
ioError (String -> IOError
userError String
"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
    CInt
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CInt
ok CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall a. IOError -> IO a
ioError (String -> IOError
userError String
"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
    FunPtr CallbackC
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
    Maybe Callback -> IO (Maybe Callback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Callback -> IO (Maybe Callback))
-> Maybe Callback -> IO (Maybe Callback)
forall a b. (a -> b) -> a -> b
$ if FunPtr CallbackC
ptr FunPtr CallbackC -> FunPtr CallbackC -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr CallbackC
forall a. FunPtr a
nullFunPtr then Maybe Callback
forall a. Maybe a
Nothing else Callback -> Maybe Callback
forall a. a -> Maybe a
Just (FunPtr CallbackC -> Callback
importCallback FunPtr CallbackC
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
        FunPtr CallbackC
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
        CInt
typ <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
typPtr
        case CInt
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
    Ptr (Ptr CChar)
namesPtr <- IO (Ptr (Ptr CChar))
rl_funmap_names
    [Ptr CChar]
namePtrs <- 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)
namesPtr
    Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
namesPtr
    (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 [Ptr CChar]
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 CChar
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)
    String
text <- Ptr CChar -> IO String
peekCString Ptr CChar
ptr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
ptr
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
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
    FunPtr (Ptr CChar -> IO ())
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
    String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
prompt ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
promptPtr -> do
        Ptr CChar -> FunPtr (Ptr CChar -> IO ()) -> IO ()
rl_callback_handler_install Ptr CChar
promptPtr FunPtr (Ptr CChar -> IO ())
lhandlerPtr
    IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (do IO ()
rl_callback_handler_remove; FunPtr (Ptr CChar -> IO ()) -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr (Ptr CChar -> IO ())
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 CChar
ptr <- Generator
f Ptr CChar
textPtr CInt
n
            if Ptr CChar
ptr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
                then [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                else do
                    String
str <- Ptr CChar -> IO String
peekCString Ptr CChar
ptr
                    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
ptr
                    [String]
rest <- CInt -> IO [String]
loop (CInt
nCInt -> CInt -> CInt
forall a. Num a => a -> a -> a
+CInt
1)
                    [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
strString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
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
    IORef [String]
ref <- [String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef []
    Generator -> IO Generator
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Generator -> IO Generator) -> Generator -> IO Generator
forall a b. (a -> b) -> a -> b
$ \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
        [String]
next <- IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref
        case [String]
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
        FunPtr Generator
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
        Ptr (Ptr CChar)
matchesPtr <- Ptr CChar -> FunPtr Generator -> IO (Ptr (Ptr CChar))
rl_completion_matches Ptr CChar
textPtr FunPtr Generator
entryPtr
        FunPtr Generator -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr Generator
entryPtr
        if Ptr (Ptr CChar)
matchesPtr Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr (Ptr CChar)
forall a. Ptr a
nullPtr then Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, [String])
forall a. Maybe a
Nothing else do
            [Ptr CChar]
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
            (String
text':[String]
matches) <- (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 [Ptr CChar]
matchPtrs
            (Ptr CChar -> IO ()) -> [Ptr CChar] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free [Ptr CChar]
matchPtrs
            Ptr (Ptr CChar) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr CChar)
matchesPtr
            Maybe (String, [String]) -> IO (Maybe (String, [String]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, [String]) -> Maybe (String, [String])
forall a. a -> Maybe a
Just (String
text', [String]
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
            String
text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            Maybe (String, [String])
found <- String -> Int -> Int -> IO (Maybe (String, [String]))
f String
text (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
start) (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
end)
            case Maybe (String, [String])
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
                    [Ptr CChar]
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)
                    Ptr (Ptr CChar)
matchesPtr <- Int -> IO (Ptr (Ptr CChar))
forall a. Storable a => Int -> IO (Ptr a)
mallocArray ([Ptr CChar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ptr CChar]
matchPtrs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                    Ptr CChar -> Ptr (Ptr CChar) -> [Ptr CChar] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
matchesPtr [Ptr CChar]
matchPtrs
                    Ptr (Ptr CChar) -> IO (Ptr (Ptr CChar))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr (Ptr CChar)
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
            Maybe String
wordBreaks <- IO (Maybe String)
f
            case Maybe String
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
            String
text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            String
s <- String -> Bool -> Ptr CChar -> IO String
f String
text (CInt
typ CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== (CInt
2)) Ptr CChar
qp
{-# LINE 1096 "System/Console/Readline.hsc" #-}
            String -> IO (Ptr CChar)
newCString String
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 CChar
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
    String
s <- Ptr CChar -> IO String
peekCString Ptr CChar
ptr
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
ptr
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
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
            String
text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            String
s <- String -> Maybe Char -> IO String
f String
text (if CInt
qcCInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
==CInt
0 then Maybe Char
forall a. Maybe a
Nothing else Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
qc)))
            String -> IO (Ptr CChar)
newCString String
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
            String
text <- Ptr CChar -> IO String
peekCString Ptr CChar
textPtr
            Bool
quoted <- String -> Int -> IO Bool
f String
text (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
index)
            CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
quoted then CInt
1 else CInt
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
    Ptr CChar
oldPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
rl_completer_quote_characters
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr CChar
oldPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr CChar
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
oldPtr
    -- I think that rl_completer_quote_characters should never be empty
    -- but can be NULL.
    Ptr CChar
newPtr <- if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cs
        then 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
        else do
            Ptr CChar
ptr <- Int -> IO (Ptr CChar)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            CChar -> Ptr CChar -> [CChar] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 CChar
0 Ptr CChar
ptr ((Char -> CChar) -> String -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Char -> CChar
castCharToCChar String
cs)
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
ptr
    Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
rl_completer_quote_characters Ptr CChar
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
    CInt
ch <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
rl_completion_append_character
    Maybe Char -> IO (Maybe Char)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Char -> IO (Maybe Char)) -> Maybe Char -> IO (Maybe Char)
forall a b. (a -> b) -> a -> b
$ if CInt
ch CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then Maybe Char
forall a. Maybe a
Nothing else Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
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
            [Ptr CChar]
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
            [String]
matches <- (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 [Ptr CChar]
matchPtrs
            (Ptr CChar -> IO ()) -> [Ptr CChar] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free [Ptr CChar]
matchPtrs
            [String] -> IO [String]
f [String]
matches IO [String] -> ([String] -> IO [Ptr CChar]) -> IO [Ptr CChar]
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 (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 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 CChar -> Ptr (Ptr CChar) -> [Ptr CChar] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 Ptr CChar
forall a. Ptr a
nullPtr Ptr (Ptr CChar)
matchesPtr
            CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
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
            Ptr CChar
oldDirPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
dirPtrPtr
            String
oldDir <- Ptr CChar -> IO String
peekCString Ptr CChar
oldDirPtr
            Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
oldDirPtr
            Ptr CChar
newDirPtr <- String -> IO String
f String
oldDir IO String -> (String -> IO (Ptr CChar)) -> IO (Ptr CChar)
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 (Ptr CChar)
newCString
            Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
dirPtrPtr Ptr CChar
newDirPtr
            CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
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
    Ptr CChar
oldPtr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
variable
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr CChar -> Bool
pred Ptr CChar
oldPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
oldPtr
    Ptr CChar
newPtr <- Int -> IO (Ptr CChar)
forall a. Storable a => Int -> IO (Ptr a)
mallocArray (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
chars Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    CChar -> Ptr CChar -> [CChar] -> IO ()
forall a. Storable a => a -> Ptr a -> [a] -> IO ()
pokeArray0 CChar
0 Ptr CChar
newPtr ((Char -> CChar) -> String -> [CChar]
forall a b. (a -> b) -> [a] -> [b]
map Char -> CChar
castCharToCChar String
chars)
    Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr CChar)
variable Ptr CChar
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 CChar
ptr <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
variable
    if Ptr CChar
ptr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr then String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"" else do
        [CChar]
cs <- CChar -> Ptr CChar -> IO [CChar]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
peekArray0 CChar
0 Ptr CChar
ptr
        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((CChar -> Char) -> [CChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Char
castCCharToChar [CChar]
cs)