{- ----------------------------------------------------------------------------
  Copyright (c) 2021, Daan Leijen
  This is free software; you can redistribute it and/or modify it
  under the terms of the MIT License. A copy of the license can be
  found in the "LICENSE" file at the root of this distribution.
---------------------------------------------------------------------------- -}
{-|
Description : Binding to the Isocline library, a portable alternative to GNU Readline
Copyright   : (c) 2021, Daan Leijen
License     : MIT
Maintainer  : daan@effp.org
Stability   : Experimental

![logo](https://raw.githubusercontent.com/daanx/isocline/main/doc/isocline-inline.svg) 
A Haskell wrapper around the [Isocline C library](https://github.com/daanx/isocline#readme) 
which can provide an alternative to GNU Readline.
(The Isocline library is included whole and there are no runtime dependencies).

Isocline works across Unix, Windows, and macOS, and relies on a minimal subset of ANSI escape sequences.
It has a good multi-line editing mode (use shift/ctrl-enter) which is nice for inputting small functions etc.
Other features include support for colors, history, completion, unicode, undo/redo, 
incremental history search, inline hints, brace matching, syntax highlighting, rich text using bbcode
formatting, etc.

Minimal example with history:

@
import System.Console.Isocline

main :: IO ()
main  = do putStrLn \"Welcome\"
           `setHistory` \"history.txt\" 200
           input \<- `readline` \"myprompt\"     -- full prompt becomes \"myprompt> \"
           `putFmtLn` (\"[gray]You wrote:[\/gray]\\n\" ++ input)
@

Or using custom completions with an interactive loop:

@
import System.Console.Isocline
import Data.Char( toLower )

main :: IO ()
main 
  = do `styleDef' "ic-prompt" "ansi-maroon"
       `setHistory` "history.txt" 200
       `enableAutoTab` `True`
       interaction

interaction :: IO ()
interaction 
  = do s <- `readlineEx` \"hαskell\" (Just completer) Nothing 
       putStrLn (\"You wrote:\\n\" ++ s)
       if (s == \"\" || s == \"exit\") then return () else interaction
                     
completer :: `CompletionEnv` -> String -> IO () 
completer cenv input
  = do `completeFileName` cenv input Nothing [\".\",\"\/usr\/local\"] [\".hs\"]  -- use [] for any extension
       `completeWord` cenv input Nothing wcompleter

wcompleter :: String -> [`Completion`]
wcompleter input
  = `completionsFor` (map toLower input) 
      [\"print\",\"println\",\"prints\",\"printsln\",\"prompt\"]      
@

See a larger [example](https://github.com/daanx/isocline/blob/main/test/Example.hs) 
with syntax highlighting and more extenstive custom completion 
in the [Github repository](https://github.com/daanx/isocline).

Enjoy,
-- Daan
-}
module System.Console.Isocline( 
      -- * Readline

      readline, 
      readlineEx,      
      
      -- * History

      setHistory,
      historyClear,
      historyRemoveLast,
      historyAdd,

      -- * Completion

      CompletionEnv,      
      completeFileName,
      completeWord,
      completeQuotedWord,
      completeQuotedWordEx,

      Completion(..),
      completion,
      isPrefix,
      completionsFor,
      wordCompleter,

      -- * Syntax Highlighting 

      highlightFmt,

      -- * Rich text

      Style, Fmt,      
      style,
      plain,
      pre,
      
      putFmt,
      putFmtLn,

      styleDef,
      styleOpen,
      styleClose,
      withStyle,

      -- * Configuration

      setPromptMarker,
      enableAutoTab,
      enableColor,
      enableBeep,
      enableMultiline,
      enableHistoryDuplicates,
      enableCompletionPreview,
      enableMultilineIndent,
      enableHighlight,
      enableInlineHelp,
      enableHint,
      setHintDelay,
      enableBraceMatching,
      enableBraceInsertion,
      setMatchingBraces,
      setInsertionBraces,    
            
      -- * Advanced

      setDefaultCompleter,      
      addCompletion,
      addCompletionPrim,
      addCompletions,
      completeWordPrim,
      completeQuotedWordPrim,
      completeQuotedWordPrimEx,

      readlineMaybe,
      readlineExMaybe,
      readlinePrim,
      readlinePrimMaybe,

      getPromptMarker,
      getContinuationPromptMarker,
      stopCompleting,
      hasCompletions,

      asyncStop,

      -- * Low-level highlighting

      HighlightEnv,      
      setDefaultHighlighter,      
      setDefaultFmtHighlighter,
      
      -- * Low-level Terminal

      termInit, 
      termDone,
      withTerm,
      termFlush,
      termWrite,
      termWriteLn,
      termColor,
      termBgColor,
      termColorAnsi,
      termBgColorAnsi,
      termUnderline,
      termReverse,
      termReset      

    ) where


import Data.List( intersperse, isPrefixOf )
import Control.Monad( when, foldM )
import Control.Exception( bracket )
import Foreign.C.String( CString, peekCString, peekCStringLen, withCString, castCharToCChar )
import Foreign.Ptr
import Foreign.C.Types

-- the following are used for utf8 encoding.

import qualified Data.ByteString as B ( useAsCString, packCString )
import qualified Data.Text as T  ( pack, unpack )
import Data.Text.Encoding as TE  ( decodeUtf8With, encodeUtf8)
import Data.Text.Encoding.Error  ( lenientDecode )


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

-- C Types

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


data IcCompletionEnv  

-- | Abstract list of current completions.

newtype CompletionEnv = CompletionEnv (Ptr IcCompletionEnv)

type CCompleterFun = Ptr IcCompletionEnv -> CString -> IO ()
type CompleterFun  = CompletionEnv -> String -> IO ()


data IcHighlightEnv

-- | Abstract highlight environment

newtype HighlightEnv = HighlightEnv (Ptr IcHighlightEnv)    

type CHighlightFun = Ptr IcHighlightEnv -> CString -> Ptr () -> IO ()
type HighlightFun  = HighlightEnv -> String -> IO ()



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

-- Basic readline

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


foreign import ccall ic_free        :: (Ptr a) -> IO () 
foreign import ccall ic_malloc      :: CSize -> IO (Ptr a)
foreign import ccall ic_strdup      :: CString -> IO CString
foreign import ccall ic_readline    :: CString -> IO CString
foreign import ccall ic_readline_ex :: CString -> FunPtr CCompleterFun -> (Ptr ()) -> FunPtr CHighlightFun -> (Ptr ()) -> IO CString
foreign import ccall ic_async_stop  :: IO CCBool

unmaybe :: IO (Maybe String) -> IO String
unmaybe :: IO (Maybe String) -> IO String
unmaybe IO (Maybe String)
action
  = do Maybe String
mb <- IO (Maybe String)
action
       case Maybe String
mb of
         Maybe String
Nothing -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         Just String
s  -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

-- | @readline prompt@: Read (multi-line) input from the user with rich editing abilities. 

-- Takes the prompt text as an argument. The full prompt is the combination

-- of the given prompt and the prompt marker (@\"> \"@ by default) .

-- See also 'readlineEx', 'readlineMaybe', 'enableMultiline', and 'setPromptMarker'.

readline :: String -> IO String  
readline :: String -> IO String
readline String
prompt
  = IO (Maybe String) -> IO String
unmaybe (IO (Maybe String) -> IO String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
readlineMaybe String
prompt

-- | As 'readline' but returns 'Nothing' on end-of-file or other errors (ctrl-C/ctrl-D).

readlineMaybe:: String -> IO (Maybe String)
readlineMaybe :: String -> IO (Maybe String)
readlineMaybe String
prompt
  = String -> (CString -> IO (Maybe String)) -> IO (Maybe String)
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
prompt ((CString -> IO (Maybe String)) -> IO (Maybe String))
-> (CString -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \CString
cprompt ->
    do CString
cres <- CString -> IO CString
ic_readline CString
cprompt
       Maybe String
res  <- CString -> IO (Maybe String)
peekUTF8StringMaybe CString
cres
       CString -> IO ()
forall a. Ptr a -> IO ()
ic_free CString
cres
       Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
res

-- | @readlineEx prompt mbCompleter mbHighlighter@: as 'readline' but

-- uses the given @mbCompleter@ function to complete words on @tab@ (instead of the default completer). 

-- and the given @mbHighlighter@ function to highlight the input (instead of the default highlighter).

-- See also 'readline' and 'readlineExMaybe'.

readlineEx :: String -> Maybe (CompletionEnv -> String -> IO ()) -> Maybe (String -> Fmt) -> IO String
readlineEx :: String
-> Maybe (CompletionEnv -> String -> IO ())
-> Maybe (String -> String)
-> IO String
readlineEx String
prompt Maybe (CompletionEnv -> String -> IO ())
completer Maybe (String -> String)
highlighter
  = IO (Maybe String) -> IO String
unmaybe (IO (Maybe String) -> IO String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> a -> b
$ String
-> Maybe (CompletionEnv -> String -> IO ())
-> Maybe (String -> String)
-> IO (Maybe String)
readlineExMaybe String
prompt Maybe (CompletionEnv -> String -> IO ())
completer Maybe (String -> String)
highlighter

-- | As 'readlineEx' but returns 'Nothing' on end-of-file or other errors (ctrl-C/ctrl-D).

-- See also 'readlineMaybe'.

readlineExMaybe :: String -> Maybe (CompletionEnv -> String -> IO ()) -> Maybe (String -> Fmt) -> IO (Maybe String) 
readlineExMaybe :: String
-> Maybe (CompletionEnv -> String -> IO ())
-> Maybe (String -> String)
-> IO (Maybe String)
readlineExMaybe String
prompt Maybe (CompletionEnv -> String -> IO ())
completer Maybe (String -> String)
mbhighlighter
  = String
-> Maybe (CompletionEnv -> String -> IO ())
-> Maybe (HighlightEnv -> String -> IO ())
-> IO (Maybe String)
readlinePrimMaybe String
prompt Maybe (CompletionEnv -> String -> IO ())
completer (case Maybe (String -> String)
mbhighlighter of
                                          Maybe (String -> String)
Nothing -> Maybe (HighlightEnv -> String -> IO ())
forall a. Maybe a
Nothing
                                          Just String -> String
hl -> (HighlightEnv -> String -> IO ())
-> Maybe (HighlightEnv -> String -> IO ())
forall a. a -> Maybe a
Just ((String -> String) -> HighlightEnv -> String -> IO ()
highlightFmt String -> String
hl))

-- | @readlinePrim prompt mbCompleter mbHighlighter@: as 'readline' but

-- uses the given @mbCompleter@ function to complete words on @tab@ (instead of the default completer). 

-- and the given @mbHighlighter@ function to highlight the input (instead of the default highlighter).

-- See also 'readlineEx' and 'readlinePrimMaybe'.

readlinePrim :: String -> Maybe (CompletionEnv -> String -> IO ()) -> Maybe (HighlightEnv -> String -> IO ()) -> IO String
readlinePrim :: String
-> Maybe (CompletionEnv -> String -> IO ())
-> Maybe (HighlightEnv -> String -> IO ())
-> IO String
readlinePrim String
prompt Maybe (CompletionEnv -> String -> IO ())
completer Maybe (HighlightEnv -> String -> IO ())
highlighter
  = IO (Maybe String) -> IO String
unmaybe (IO (Maybe String) -> IO String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> a -> b
$ String
-> Maybe (CompletionEnv -> String -> IO ())
-> Maybe (HighlightEnv -> String -> IO ())
-> IO (Maybe String)
readlinePrimMaybe String
prompt Maybe (CompletionEnv -> String -> IO ())
completer Maybe (HighlightEnv -> String -> IO ())
highlighter

-- | As 'readlinePrim' but returns 'Nothing' on end-of-file or other errors (ctrl-C/ctrl-D).

-- See also 'readlineMaybe'.

readlinePrimMaybe :: String -> Maybe (CompletionEnv -> String -> IO ()) -> Maybe (HighlightEnv -> String -> IO ()) -> IO (Maybe String) 
readlinePrimMaybe :: String
-> Maybe (CompletionEnv -> String -> IO ())
-> Maybe (HighlightEnv -> String -> IO ())
-> IO (Maybe String)
readlinePrimMaybe String
prompt Maybe (CompletionEnv -> String -> IO ())
completer Maybe (HighlightEnv -> String -> IO ())
highlighter
  = String -> (CString -> IO (Maybe String)) -> IO (Maybe String)
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
prompt ((CString -> IO (Maybe String)) -> IO (Maybe String))
-> (CString -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \CString
cprompt ->
    do FunPtr CCompleterFun
ccompleter   <- Maybe (CompletionEnv -> String -> IO ())
-> IO (FunPtr CCompleterFun)
makeCCompleter Maybe (CompletionEnv -> String -> IO ())
completer
       FunPtr CHighlightFun
chighlighter <- Maybe (HighlightEnv -> String -> IO ())
-> IO (FunPtr CHighlightFun)
makeCHighlighter Maybe (HighlightEnv -> String -> IO ())
highlighter
       CString
cres <- CString
-> FunPtr CCompleterFun
-> Ptr ()
-> FunPtr CHighlightFun
-> Ptr ()
-> IO CString
ic_readline_ex CString
cprompt FunPtr CCompleterFun
ccompleter Ptr ()
forall a. Ptr a
nullPtr FunPtr CHighlightFun
chighlighter Ptr ()
forall a. Ptr a
nullPtr
       Maybe String
res  <- CString -> IO (Maybe String)
peekUTF8StringMaybe CString
cres
       CString -> IO ()
forall a. Ptr a -> IO ()
ic_free CString
cres
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr CCompleterFun
ccompleter FunPtr CCompleterFun -> FunPtr CCompleterFun -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr CCompleterFun
forall a. FunPtr a
nullFunPtr)   (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr CCompleterFun -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CCompleterFun
ccompleter
       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr CHighlightFun
chighlighter FunPtr CHighlightFun -> FunPtr CHighlightFun -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr CHighlightFun
forall a. FunPtr a
nullFunPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr CHighlightFun -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CHighlightFun
chighlighter
       Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
res

-- | Thread safe call to asynchronously send a stop event to a 'readline' 

-- which behaves as if the user pressed @ctrl-C@,

-- which will return with 'Nothing' (or @\"\"@). 

-- Returns 'True' if the event was successfully delivered.

asyncStop :: IO Bool
asyncStop :: IO Bool
asyncStop
  = IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ IO CCBool
ic_async_stop

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

-- History

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


foreign import ccall ic_set_history           :: CString -> CInt -> IO ()
foreign import ccall ic_history_remove_last   :: IO ()
foreign import ccall ic_history_clear         :: IO ()
foreign import ccall ic_history_add           :: CString -> IO ()

-- | @setHistory filename maxEntries@: 

-- Enable history that is persisted to the given file path with a given maximum number of entries.

-- Use -1 for the default entries (200).

-- See also 'enableHistoryDuplicates'.

setHistory :: FilePath -> Int -> IO ()
setHistory :: String -> Int -> IO ()
setHistory String
fname Int
maxEntries
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
fname ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cfname ->
    do CString -> CCBool -> IO ()
ic_set_history CString
cfname (Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
maxEntries)

-- | Isocline automatically adds input of more than 1 character to the history.

-- This command removes the last entry.

historyRemoveLast :: IO ()
historyRemoveLast :: IO ()
historyRemoveLast 
  = IO ()
ic_history_remove_last

-- | Clear the history.

historyClear :: IO ()
historyClear :: IO ()
historyClear
  = IO ()
ic_history_clear

-- | @historyAdd entry@: add @entry@ to the history.

historyAdd :: String -> IO ()
historyAdd :: String -> IO ()
historyAdd String
entry
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
entry ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
centry ->
    do CString -> IO ()
ic_history_add CString
centry 


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

-- Completion

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

-- use our own CBool for compatibility with an older base

type CCBool = CInt

type CCharClassFun = CString -> CLong -> IO CCBool
type CharClassFun  = Char -> Bool

foreign import ccall ic_set_default_completer :: FunPtr CCompleterFun -> IO ()
foreign import ccall "wrapper" ic_make_completer :: CCompleterFun -> IO (FunPtr CCompleterFun)
foreign import ccall "wrapper" ic_make_charclassfun :: CCharClassFun -> IO (FunPtr CCharClassFun)

foreign import ccall ic_add_completion_ex     :: Ptr IcCompletionEnv -> CString -> CString -> CString -> IO CCBool
foreign import ccall ic_add_completion_prim   :: Ptr IcCompletionEnv -> CString -> CString -> CString -> CInt -> CInt -> IO CCBool
foreign import ccall ic_complete_filename     :: Ptr IcCompletionEnv -> CString -> CChar -> CString -> CString -> IO ()
foreign import ccall ic_complete_word         :: Ptr IcCompletionEnv -> CString -> FunPtr CCompleterFun -> FunPtr CCharClassFun -> IO ()
foreign import ccall ic_complete_qword        :: Ptr IcCompletionEnv -> CString -> FunPtr CCompleterFun -> FunPtr CCharClassFun -> IO ()
foreign import ccall ic_complete_qword_ex     :: Ptr IcCompletionEnv -> CString -> FunPtr CCompleterFun -> FunPtr CCharClassFun -> CChar -> CString -> IO ()

foreign import ccall ic_has_completions       :: Ptr IcCompletionEnv -> IO CCBool
foreign import ccall ic_stop_completing       :: Ptr IcCompletionEnv -> IO CCBool

-- | A completion entry

data Completion = Completion { 
  Completion -> String
replacement :: String,  -- ^ actual replacement

  Completion -> String
display :: String,      -- ^ display of the completion in the completion menu

  Completion -> String
help :: String          -- ^ help message 

} deriving (Completion -> Completion -> Bool
(Completion -> Completion -> Bool)
-> (Completion -> Completion -> Bool) -> Eq Completion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Completion -> Completion -> Bool
$c/= :: Completion -> Completion -> Bool
== :: Completion -> Completion -> Bool
$c== :: Completion -> Completion -> Bool
Eq, Int -> Completion -> String -> String
[Completion] -> String -> String
Completion -> String
(Int -> Completion -> String -> String)
-> (Completion -> String)
-> ([Completion] -> String -> String)
-> Show Completion
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Completion] -> String -> String
$cshowList :: [Completion] -> String -> String
show :: Completion -> String
$cshow :: Completion -> String
showsPrec :: Int -> Completion -> String -> String
$cshowsPrec :: Int -> Completion -> String -> String
Show)

-- | Create a completion with just a replacement

completion :: String -> Completion
completion :: String -> Completion
completion String
replacement
  = String -> String -> String -> Completion
Completion String
replacement String
"" String
""

-- | @completionFull replacement display help@: Create a completion with a separate display and help string.

completionFull :: String -> String -> String -> Completion
completionFull :: String -> String -> String -> Completion
completionFull String
replacement String
display String
help
  = String -> String -> String -> Completion
Completion  String
replacement String
display String
help 


-- | Is the given input a prefix of the completion replacement?

isPrefix :: String -> Completion -> Bool
isPrefix :: String -> Completion -> Bool
isPrefix String
input Completion
compl
  = String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
input (Completion -> String
replacement Completion
compl)

-- | @completionsFor input replacements@: Filter those @replacements@ that 

-- start with the given @input@, and return them as completions.

completionsFor :: String -> [String] -> [Completion]
completionsFor :: String -> [String] -> [Completion]
completionsFor String
input [String]
rs
  = (String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
completion ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
input) [String]
rs)

-- | Convenience: creates a completer function directly from a list

-- of candidate completion strings. Uses `completionsFor` to filter the 

-- input and `completeWord` to find the word boundary.

-- For example: @'readlineEx' \"myprompt\" (Just ('wordCompleter' completer)) Nothing@.

wordCompleter :: [String] -> (CompletionEnv -> String -> IO ()) 
wordCompleter :: [String] -> CompletionEnv -> String -> IO ()
wordCompleter [String]
completions
  = (\CompletionEnv
cenv String
input -> CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> (String -> [Completion])
-> IO ()
completeWord CompletionEnv
cenv String
input Maybe (Char -> Bool)
forall a. Maybe a
Nothing (\String
input -> String -> [String] -> [Completion]
completionsFor String
input [String]
completions))

-- | @setDefaultCompleter completer@: Set a new tab-completion function @completer@ 

-- that is called by Isocline automatically. 

-- The callback is called with a 'CompletionEnv' context and the current user

-- input up to the cursor.

-- By default the 'completeFileName' completer is used.

-- This overwrites any previously set completer.

setDefaultCompleter :: (CompletionEnv -> String -> IO ()) -> IO ()
setDefaultCompleter :: (CompletionEnv -> String -> IO ()) -> IO ()
setDefaultCompleter CompletionEnv -> String -> IO ()
completer 
  = do FunPtr CCompleterFun
ccompleter <- Maybe (CompletionEnv -> String -> IO ())
-> IO (FunPtr CCompleterFun)
makeCCompleter ((CompletionEnv -> String -> IO ())
-> Maybe (CompletionEnv -> String -> IO ())
forall a. a -> Maybe a
Just CompletionEnv -> String -> IO ()
completer)
       FunPtr CCompleterFun -> IO ()
ic_set_default_completer FunPtr CCompleterFun
ccompleter

withCCompleter :: Maybe CompleterFun -> (FunPtr CCompleterFun -> IO a) -> IO a
withCCompleter :: Maybe (CompletionEnv -> String -> IO ())
-> (FunPtr CCompleterFun -> IO a) -> IO a
withCCompleter Maybe (CompletionEnv -> String -> IO ())
completer FunPtr CCompleterFun -> IO a
action
  = IO (FunPtr CCompleterFun)
-> (FunPtr CCompleterFun -> IO ())
-> (FunPtr CCompleterFun -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Maybe (CompletionEnv -> String -> IO ())
-> IO (FunPtr CCompleterFun)
makeCCompleter Maybe (CompletionEnv -> String -> IO ())
completer) (\FunPtr CCompleterFun
cfun -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr CCompleterFun
forall a. FunPtr a
nullFunPtr FunPtr CCompleterFun -> FunPtr CCompleterFun -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr CCompleterFun
cfun) (FunPtr CCompleterFun -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CCompleterFun
cfun)) FunPtr CCompleterFun -> IO a
action

makeCCompleter :: Maybe CompleterFun -> IO (FunPtr CCompleterFun)
makeCCompleter :: Maybe (CompletionEnv -> String -> IO ())
-> IO (FunPtr CCompleterFun)
makeCCompleter Maybe (CompletionEnv -> String -> IO ())
Nothing = FunPtr CCompleterFun -> IO (FunPtr CCompleterFun)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr CCompleterFun
forall a. FunPtr a
nullFunPtr
makeCCompleter (Just CompletionEnv -> String -> IO ()
completer)
  = CCompleterFun -> IO (FunPtr CCompleterFun)
ic_make_completer CCompleterFun
wrapper
  where
    wrapper :: Ptr IcCompletionEnv -> CString -> IO ()
    wrapper :: CCompleterFun
wrapper Ptr IcCompletionEnv
rpcomp CString
cprefx
      = do String
prefx <- CString -> IO String
peekUTF8String0 CString
cprefx
           CompletionEnv -> String -> IO ()
completer (Ptr IcCompletionEnv -> CompletionEnv
CompletionEnv Ptr IcCompletionEnv
rpcomp) String
prefx


-- | @addCompletion compl completion@: Inside a completer callback, add a new completion.

-- If 'addCompletion' returns 'True' keep adding completions,

-- but if it returns 'False' an effort should be made to return from the completer

-- callback without adding more completions.

addCompletion :: CompletionEnv -> Completion -> IO Bool
addCompletion :: CompletionEnv -> Completion -> IO Bool
addCompletion (CompletionEnv Ptr IcCompletionEnv
rpc) (Completion String
replacement String
display String
help)
  = String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
replacement ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
crepl ->
    String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
display ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
cdisplay ->
    String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
help ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
chelp ->    
    do CCBool
cbool <- Ptr IcCompletionEnv -> CString -> CString -> CString -> IO CCBool
ic_add_completion_ex Ptr IcCompletionEnv
rpc CString
crepl CString
cdisplay CString
chelp
       Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (CCBool -> Int
forall a. Enum a => a -> Int
fromEnum CCBool
cbool Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)

-- | @addCompletionPrim compl completion deleteBefore deleteAfter@: 

-- Primitive add completion, use with care and call only directly inside a completer callback.

-- If 'addCompletion' returns 'True' keep adding completions,

-- but if it returns 'False' an effort should be made to return from the completer

-- callback without adding more completions.

addCompletionPrim :: CompletionEnv -> Completion -> Int -> Int -> IO Bool
addCompletionPrim :: CompletionEnv -> Completion -> Int -> Int -> IO Bool
addCompletionPrim (CompletionEnv Ptr IcCompletionEnv
rpc) (Completion String
replacement String
display String
help) Int
deleteBefore Int
deleteAfter
  = String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
replacement ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
crepl ->
    String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
display ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
cdisplay ->
    String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
help ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \CString
chelp ->
    do CCBool
cbool <- Ptr IcCompletionEnv
-> CString -> CString -> CString -> CCBool -> CCBool -> IO CCBool
ic_add_completion_prim Ptr IcCompletionEnv
rpc CString
crepl CString
cdisplay CString
chelp (Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
deleteBefore) (Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
deleteAfter)
       Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (CCBool -> Int
forall a. Enum a => a -> Int
fromEnum CCBool
cbool Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)

    
-- | @addCompletions compl completions@: add multiple completions at once.

-- If 'addCompletions' returns 'True' keep adding completions,

-- but if it returns 'False' an effort should be made to return from the completer

-- callback without adding more completions.

addCompletions :: CompletionEnv -> [Completion] -> IO Bool
addCompletions :: CompletionEnv -> [Completion] -> IO Bool
addCompletions CompletionEnv
compl [] = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
addCompletions CompletionEnv
compl (Completion
c:[Completion]
cs)
  = do Bool
continue <- CompletionEnv -> Completion -> IO Bool
addCompletion CompletionEnv
compl Completion
c
       if (Bool
continue) 
         then CompletionEnv -> [Completion] -> IO Bool
addCompletions CompletionEnv
compl [Completion]
cs
         else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | @completeFileName compls input dirSep roots extensions@: 

-- Complete filenames with the given @input@, a possible directory separator @dirSep@, 

-- a list of root folders @roots@  to search from

-- (by default @["."]@), and a list of extensions to match (use @[]@ to match any extension).

-- The directory separator is used when completing directory names.

-- For example, using g @\'/\'@ as a directory separator, we get:

--

-- > /ho         --> /home/

-- > /home/.ba   --> /home/.bashrc

--

completeFileName :: CompletionEnv -> String -> Maybe Char -> [FilePath] -> [String] -> IO ()
completeFileName :: CompletionEnv
-> String -> Maybe Char -> [String] -> [String] -> IO ()
completeFileName (CompletionEnv Ptr IcCompletionEnv
rpc) String
prefx Maybe Char
dirSep [String]
roots [String]
extensions
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
prefx ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cprefx ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
";" [String]
roots)) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
croots ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
";" [String]
extensions)) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cextensions ->
    do let cdirSep :: CChar
cdirSep = case Maybe Char
dirSep of
                       Maybe Char
Nothing -> Int -> CChar
forall a. Enum a => Int -> a
toEnum Int
0
                       Just Char
c  -> Char -> CChar
castCharToCChar Char
c
       Ptr IcCompletionEnv
-> CString -> CChar -> CString -> CString -> IO ()
ic_complete_filename Ptr IcCompletionEnv
rpc CString
cprefx CChar
cdirSep CString
croots CString
cextensions

-- | @completeWord compl input isWordChar completer@: 

-- Complete a /word/ (or /token/) and calls the user @completer@ function with just the current word

-- (instead of the whole input)

-- Takes the 'CompletionEnv' environment @compl@, the current @input@, an possible

-- @isWordChar@ function, and a user defined 

-- @completer@ function that is called with adjusted input which 

-- is limited to the /word/ just before the cursor.

-- Pass 'Nothing' to @isWordChar@ for the default @not . separator@

-- where @separator = \c -> c `elem` \" \\t\\r\\n,.;:/\\\\(){}[]\"@.

completeWord :: CompletionEnv -> String -> Maybe (Char -> Bool) -> (String -> [Completion]) -> IO () 
completeWord :: CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> (String -> [Completion])
-> IO ()
completeWord CompletionEnv
cenv String
input Maybe (Char -> Bool)
isWordChar String -> [Completion]
completer 
  = CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> (CompletionEnv -> String -> IO ())
-> IO ()
completeWordPrim CompletionEnv
cenv String
input Maybe (Char -> Bool)
isWordChar CompletionEnv -> String -> IO ()
cenvCompleter
  where
    cenvCompleter :: CompletionEnv -> String -> IO ()
cenvCompleter CompletionEnv
cenv String
input
      = do CompletionEnv -> [Completion] -> IO Bool
addCompletions CompletionEnv
cenv (String -> [Completion]
completer String
input)
           () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | @completeQuotedWord compl input isWordChar completer@: 

-- Complete a /word/ taking care of automatically quoting and escaping characters.

-- Takes the 'CompletionEnv' environment @compl@, the current @input@, and a user defined 

-- @completer@ function that is called with adjusted input which is unquoted, unescaped,

-- and limited to the /word/ just before the cursor.

-- For example, with a @hello world@ completion, we get:

--

-- > hel        -->  hello\ world

-- > hello\ w   -->  hello\ world

-- > hello w    -->                   # no completion, the word is just 'w'>

-- > "hel       -->  "hello world" 

-- > "hello w   -->  "hello world"

--

-- The call @('completeWord' compl prefx isWordChar fun)@ is a short hand for 

-- @('completeQuotedWord' compl prefx isWordChar \'\\\\\' \"\'\\\"\" fun)@.

-- Pass 'Nothing' to @isWordChar@ for the default @not . separator@

-- where @separator = \c -> c `elem` \" \\t\\r\\n,.;:/\\\\(){}[]\"@.

completeQuotedWord :: CompletionEnv -> String -> Maybe (Char -> Bool) -> (String -> [Completion]) -> IO () 
completeQuotedWord :: CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> (String -> [Completion])
-> IO ()
completeQuotedWord CompletionEnv
cenv String
input Maybe (Char -> Bool)
isWordChar String -> [Completion]
completer 
  = CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> (CompletionEnv -> String -> IO ())
-> IO ()
completeWordPrim CompletionEnv
cenv String
input Maybe (Char -> Bool)
isWordChar CompletionEnv -> String -> IO ()
cenvCompleter
  where
    cenvCompleter :: CompletionEnv -> String -> IO ()
cenvCompleter CompletionEnv
cenv String
input
      = do CompletionEnv -> [Completion] -> IO Bool
addCompletions CompletionEnv
cenv (String -> [Completion]
completer String
input)
           () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  
-- | @completeQuotedWordEx compl input isWordChar escapeChar quoteChars completer@: 

-- Complete a /word/ taking care of automatically quoting and escaping characters.

-- Takes the 'CompletionEnv' environment @compl@, the current @input@, and a user defined 

-- @completer@ function that is called with adjusted input which is unquoted, unescaped,

-- and limited to the /word/ just before the cursor.

-- Unlike 'completeQuotedWord', this function can specify 

-- the /escape/ character and the /quote/ characters.

-- See also 'completeWord'.

completeQuotedWordEx :: CompletionEnv -> String -> Maybe (Char -> Bool) -> Maybe Char -> String -> (String -> [Completion]) -> IO () 
completeQuotedWordEx :: CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> Maybe Char
-> String
-> (String -> [Completion])
-> IO ()
completeQuotedWordEx CompletionEnv
cenv String
input Maybe (Char -> Bool)
isWordChar Maybe Char
escapeChar String
quoteChars String -> [Completion]
completer 
  = CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> Maybe Char
-> String
-> (CompletionEnv -> String -> IO ())
-> IO ()
completeQuotedWordPrimEx CompletionEnv
cenv String
input Maybe (Char -> Bool)
isWordChar Maybe Char
escapeChar String
quoteChars CompletionEnv -> String -> IO ()
cenvCompleter 
  where
    cenvCompleter :: CompletionEnv -> String -> IO ()
cenvCompleter CompletionEnv
cenv String
input 
      = do CompletionEnv -> [Completion] -> IO Bool
addCompletions CompletionEnv
cenv (String -> [Completion]
completer String
input)
           () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | @completeWord compl input isWordChar completer@: 

-- Complete a /word/,/token/ and calls the user @completer@ function with just the current word

-- (instead of the whole input)

-- Takes the 'CompletionEnv' environment @compl@, the current @input@, an possible

-- @isWordChar@ function, and a user defined 

-- @completer@ function that is called with adjusted input which 

-- is limited to the /word/ just before the cursor.

-- Pass 'Nothing' to @isWordChar@ for the default @not . separator@

-- where @separator = \c -> c `elem` \" \\t\\r\\n,.;:/\\\\(){}[]\"@.

completeWordPrim :: CompletionEnv -> String -> Maybe (Char -> Bool) -> (CompletionEnv -> String -> IO ()) -> IO () 
completeWordPrim :: CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> (CompletionEnv -> String -> IO ())
-> IO ()
completeWordPrim (CompletionEnv Ptr IcCompletionEnv
rpc) String
prefx Maybe (Char -> Bool)
isWordChar CompletionEnv -> String -> IO ()
completer 
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
prefx ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cprefx ->
    Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO ()) -> IO ()
forall a.
Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO a) -> IO a
withCharClassFun Maybe (Char -> Bool)
isWordChar ((FunPtr CCharClassFun -> IO ()) -> IO ())
-> (FunPtr CCharClassFun -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr CCharClassFun
cisWordChar ->
    Maybe (CompletionEnv -> String -> IO ())
-> (FunPtr CCompleterFun -> IO ()) -> IO ()
forall a.
Maybe (CompletionEnv -> String -> IO ())
-> (FunPtr CCompleterFun -> IO a) -> IO a
withCCompleter ((CompletionEnv -> String -> IO ())
-> Maybe (CompletionEnv -> String -> IO ())
forall a. a -> Maybe a
Just CompletionEnv -> String -> IO ()
completer) ((FunPtr CCompleterFun -> IO ()) -> IO ())
-> (FunPtr CCompleterFun -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr CCompleterFun
ccompleter ->
    do Ptr IcCompletionEnv
-> CString -> FunPtr CCompleterFun -> FunPtr CCharClassFun -> IO ()
ic_complete_word Ptr IcCompletionEnv
rpc CString
cprefx FunPtr CCompleterFun
ccompleter FunPtr CCharClassFun
cisWordChar


-- | @completeWordPrim compl input isWordChar completer@: 

-- Complete a /word/ taking care of automatically quoting and escaping characters.

-- Takes the 'CompletionEnv' environment @compl@, the current @input@, and a user defined 

-- @completer@ function that is called with adjusted input which is unquoted, unescaped,

-- and limited to the /word/ just before the cursor.

-- For example, with a @hello world@ completion, we get:

--

-- > hel        -->  hello\ world

-- > hello\ w   -->  hello\ world

-- > hello w    -->                   # no completion, the word is just 'w'>

-- > "hel       -->  "hello world" 

-- > "hello w   -->  "hello world"

--

-- The call @('completeWordPrim' compl prefx isWordChar fun)@ is a short hand for 

-- @('completeQuotedWordPrim' compl prefx isWordChar \'\\\\\' \"\'\\\"\" fun)@.

-- Pass 'Nothing' to @isWordChar@ for the default @not . separator@

-- where @separator = \c -> c `elem` \" \\t\\r\\n,.;:/\\\\(){}[]\"@.

completeQuotedWordPrim :: CompletionEnv -> String -> Maybe (Char -> Bool) -> (CompletionEnv -> String -> IO ()) -> IO () 
completeQuotedWordPrim :: CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> (CompletionEnv -> String -> IO ())
-> IO ()
completeQuotedWordPrim (CompletionEnv Ptr IcCompletionEnv
rpc) String
prefx Maybe (Char -> Bool)
isWordChar CompletionEnv -> String -> IO ()
completer
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
prefx ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cprefx ->
    Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO ()) -> IO ()
forall a.
Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO a) -> IO a
withCharClassFun Maybe (Char -> Bool)
isWordChar ((FunPtr CCharClassFun -> IO ()) -> IO ())
-> (FunPtr CCharClassFun -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr CCharClassFun
cisWordChar ->
    Maybe (CompletionEnv -> String -> IO ())
-> (FunPtr CCompleterFun -> IO ()) -> IO ()
forall a.
Maybe (CompletionEnv -> String -> IO ())
-> (FunPtr CCompleterFun -> IO a) -> IO a
withCCompleter ((CompletionEnv -> String -> IO ())
-> Maybe (CompletionEnv -> String -> IO ())
forall a. a -> Maybe a
Just CompletionEnv -> String -> IO ()
completer) ((FunPtr CCompleterFun -> IO ()) -> IO ())
-> (FunPtr CCompleterFun -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr CCompleterFun
ccompleter ->
    do Ptr IcCompletionEnv
-> CString -> FunPtr CCompleterFun -> FunPtr CCharClassFun -> IO ()
ic_complete_qword Ptr IcCompletionEnv
rpc CString
cprefx FunPtr CCompleterFun
ccompleter FunPtr CCharClassFun
cisWordChar
  

-- | @completeQuotedWordPrim compl input isWordChar escapeChar quoteChars completer@: 

-- Complete a /word/ taking care of automatically quoting and escaping characters.

-- Takes the 'CompletionEnv' environment @compl@, the current @input@, and a user defined 

-- @completer@ function that is called with adjusted input which is unquoted, unescaped,

-- and limited to the /word/ just before the cursor.

-- Unlike 'completeWord', this function takes an explicit function to determine /word/ characters,

-- the /escape/ character, and a string of /quote/ characters.

-- See also 'completeWord'.

completeQuotedWordPrimEx :: CompletionEnv -> String -> Maybe (Char -> Bool) -> Maybe Char -> String -> (CompletionEnv -> String -> IO ()) ->  IO () 
completeQuotedWordPrimEx :: CompletionEnv
-> String
-> Maybe (Char -> Bool)
-> Maybe Char
-> String
-> (CompletionEnv -> String -> IO ())
-> IO ()
completeQuotedWordPrimEx (CompletionEnv Ptr IcCompletionEnv
rpc) String
prefx Maybe (Char -> Bool)
isWordChar Maybe Char
escapeChar String
quoteChars CompletionEnv -> String -> IO ()
completer
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
prefx ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cprefx ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
quoteChars ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cquoteChars ->
    Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO ()) -> IO ()
forall a.
Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO a) -> IO a
withCharClassFun Maybe (Char -> Bool)
isWordChar ((FunPtr CCharClassFun -> IO ()) -> IO ())
-> (FunPtr CCharClassFun -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr CCharClassFun
cisWordChar ->
    Maybe (CompletionEnv -> String -> IO ())
-> (FunPtr CCompleterFun -> IO ()) -> IO ()
forall a.
Maybe (CompletionEnv -> String -> IO ())
-> (FunPtr CCompleterFun -> IO a) -> IO a
withCCompleter ((CompletionEnv -> String -> IO ())
-> Maybe (CompletionEnv -> String -> IO ())
forall a. a -> Maybe a
Just CompletionEnv -> String -> IO ()
completer) ((FunPtr CCompleterFun -> IO ()) -> IO ())
-> (FunPtr CCompleterFun -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FunPtr CCompleterFun
ccompleter ->
    do let cescapeChar :: CChar
cescapeChar = case Maybe Char
escapeChar of
                          Maybe Char
Nothing -> Int -> CChar
forall a. Enum a => Int -> a
toEnum Int
0
                          Just Char
c  -> Char -> CChar
castCharToCChar Char
c                      
       Ptr IcCompletionEnv
-> CString
-> FunPtr CCompleterFun
-> FunPtr CCharClassFun
-> CChar
-> CString
-> IO ()
ic_complete_qword_ex Ptr IcCompletionEnv
rpc CString
cprefx FunPtr CCompleterFun
ccompleter FunPtr CCharClassFun
cisWordChar CChar
cescapeChar CString
cquoteChars
       

withCharClassFun :: Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO a) -> IO a
withCharClassFun :: Maybe (Char -> Bool) -> (FunPtr CCharClassFun -> IO a) -> IO a
withCharClassFun Maybe (Char -> Bool)
isInClass FunPtr CCharClassFun -> IO a
action
  = IO (FunPtr CCharClassFun)
-> (FunPtr CCharClassFun -> IO ())
-> (FunPtr CCharClassFun -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Maybe (Char -> Bool) -> IO (FunPtr CCharClassFun)
makeCharClassFun Maybe (Char -> Bool)
isInClass) (\FunPtr CCharClassFun
cfun -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FunPtr CCharClassFun
forall a. FunPtr a
nullFunPtr FunPtr CCharClassFun -> FunPtr CCharClassFun -> Bool
forall a. Eq a => a -> a -> Bool
/= FunPtr CCharClassFun
cfun) (FunPtr CCharClassFun -> IO ()
forall a. FunPtr a -> IO ()
freeHaskellFunPtr FunPtr CCharClassFun
cfun))  FunPtr CCharClassFun -> IO a
action 

makeCharClassFun :: Maybe (Char -> Bool) -> IO (FunPtr CCharClassFun)
makeCharClassFun :: Maybe (Char -> Bool) -> IO (FunPtr CCharClassFun)
makeCharClassFun Maybe (Char -> Bool)
Nothing = FunPtr CCharClassFun -> IO (FunPtr CCharClassFun)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr CCharClassFun
forall a. FunPtr a
nullFunPtr
makeCharClassFun (Just Char -> Bool
isInClass)
  = let charClassFun :: CString -> CLong -> IO CCBool
        charClassFun :: CCharClassFun
charClassFun CString
cstr CLong
clen 
          = let len :: Int
len = (CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
clen :: Int)
            in if (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) then CCBool -> IO CCBool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> CCBool
cbool Bool
False)
                else do String
s <- CStringLen -> IO String
peekCStringLen (CString
cstr,Int
len)
                        CCBool -> IO CCBool
forall (m :: * -> *) a. Monad m => a -> m a
return (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then (Bool -> CCBool
cbool Bool
False) else Bool -> CCBool
cbool (Char -> Bool
isInClass (String -> Char
forall a. [a] -> a
head String
s)))
    in do CCharClassFun -> IO (FunPtr CCharClassFun)
ic_make_charclassfun CCharClassFun
charClassFun
          

-- | If this returns 'True' an effort should be made to stop completing and return from the callback.

stopCompleting :: CompletionEnv -> IO Bool
stopCompleting :: CompletionEnv -> IO Bool
stopCompleting (CompletionEnv Ptr IcCompletionEnv
rpc)
  = IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr IcCompletionEnv -> IO CCBool
ic_stop_completing Ptr IcCompletionEnv
rpc

-- | Have any completions be generated so far?

hasCompletions :: CompletionEnv -> IO Bool
hasCompletions :: CompletionEnv -> IO Bool
hasCompletions (CompletionEnv Ptr IcCompletionEnv
rpc)
  = IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Ptr IcCompletionEnv -> IO CCBool
ic_has_completions Ptr IcCompletionEnv
rpc



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

-- Syntax highlighting

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


foreign import ccall ic_set_default_highlighter     :: FunPtr CHighlightFun -> Ptr () -> IO ()
foreign import ccall "wrapper" ic_make_highlight_fun:: CHighlightFun -> IO (FunPtr CHighlightFun)
foreign import ccall ic_highlight                   :: Ptr IcHighlightEnv -> CLong -> CLong -> CString -> IO ()
foreign import ccall ic_highlight_formatted         :: Ptr IcHighlightEnv -> CString -> CString -> IO ()


-- | Set a syntax highlighter.

-- There can only be one highlight function, setting it again disables the previous one.

setDefaultHighlighter :: (HighlightEnv -> String -> IO ()) -> IO ()
setDefaultHighlighter :: (HighlightEnv -> String -> IO ()) -> IO ()
setDefaultHighlighter HighlightEnv -> String -> IO ()
highlighter
  = do FunPtr CHighlightFun
chighlighter <- Maybe (HighlightEnv -> String -> IO ())
-> IO (FunPtr CHighlightFun)
makeCHighlighter ((HighlightEnv -> String -> IO ())
-> Maybe (HighlightEnv -> String -> IO ())
forall a. a -> Maybe a
Just HighlightEnv -> String -> IO ()
highlighter)
       FunPtr CHighlightFun -> Ptr () -> IO ()
ic_set_default_highlighter FunPtr CHighlightFun
chighlighter Ptr ()
forall a. Ptr a
nullPtr

makeCHighlighter :: Maybe (HighlightEnv -> String -> IO ()) -> IO (FunPtr CHighlightFun)
makeCHighlighter :: Maybe (HighlightEnv -> String -> IO ())
-> IO (FunPtr CHighlightFun)
makeCHighlighter Maybe (HighlightEnv -> String -> IO ())
Nothing = FunPtr CHighlightFun -> IO (FunPtr CHighlightFun)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr CHighlightFun
forall a. FunPtr a
nullFunPtr 
makeCHighlighter (Just HighlightEnv -> String -> IO ()
highlighter)
  = CHighlightFun -> IO (FunPtr CHighlightFun)
ic_make_highlight_fun CHighlightFun
wrapper
  where 
    wrapper :: Ptr IcHighlightEnv -> CString -> Ptr () -> IO ()
    wrapper :: CHighlightFun
wrapper Ptr IcHighlightEnv
henv CString
cinput Ptr ()
carg
      = do String
input <- CString -> IO String
peekUTF8String0 CString
cinput
           HighlightEnv -> String -> IO ()
highlighter (Ptr IcHighlightEnv -> HighlightEnv
HighlightEnv Ptr IcHighlightEnv
henv) String
input


-- | @highlight henv pos len style@: Set the style of @len@ characters

-- starting at position @pos@ in the input 

highlight :: HighlightEnv -> Int -> Int -> String -> IO ()
highlight :: HighlightEnv -> Int -> Int -> String -> IO ()
highlight (HighlightEnv Ptr IcHighlightEnv
henv) Int
pos Int
len String
style
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
style ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cstyle ->
    do Ptr IcHighlightEnv -> CLong -> CLong -> CString -> IO ()
ic_highlight Ptr IcHighlightEnv
henv (Int -> CLong
clong (-Int
pos)) (Int -> CLong
clong (-Int
len)) CString
cstyle


-- | A style for formatted strings ('Fmt').

-- For example, a style can be @"red"@ or @"b #7B3050"@. 

-- See the full list of valid [properties](https://github.com/daanx/isocline#bbcode-format)

type Style = String

-- | A string with [bbcode](https://github.com/daanx/isocline#bbcode-format) formatting.

-- For example @"[red]this is red[\/]"@.n

type Fmt   = String

-- | Use an rich text formatted highlighter from inside a highlighter callback.

highlightFmt :: (String -> Fmt) -> (HighlightEnv -> String -> IO ())
highlightFmt :: (String -> String) -> HighlightEnv -> String -> IO ()
highlightFmt String -> String
highlight (HighlightEnv Ptr IcHighlightEnv
henv) String
input 
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
input ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cinput ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 (String -> String
highlight String
input) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cfmt ->
    do Ptr IcHighlightEnv -> CString -> CString -> IO ()
ic_highlight_formatted Ptr IcHighlightEnv
henv CString
cinput CString
cfmt


-- | Style a string, e.g. @style "b red" "bold and red"@ (which is equivalent to @"[b red]bold and red[\/]"@).

-- See the repo for a full description of all [styles](https://github.com/daanx/isocline#bbcode-format).

style :: Style -> Fmt -> Fmt
style :: String -> String -> String
style String
st String
s
  = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
st then String
s else (String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
st String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[/]") 

-- | Escape a string so no tags are interpreted as formatting.

plain :: String -> Fmt
plain :: String -> String
plain String
s
  = if ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Char
c -> (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'[' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
']')) String
s) then String
"[!pre]" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[/pre]" else String
s

-- | Style a string that is printed as is without interpreting markup inside it (using `plain`).

pre :: Style -> String -> Fmt
pre :: String -> String -> String
pre String
st String
s
  = String -> String -> String
style String
st (String -> String
plain String
s)

-- | Set a syntax highlighter that uses a pure function that returns a bbcode

-- formatted string (using 'style', 'plain' etc). See 'highlightFmt' for more information.

-- There can only be one highlight function, setting it again disables the previous one.

setDefaultFmtHighlighter :: (String -> Fmt) -> IO ()
setDefaultFmtHighlighter :: (String -> String) -> IO ()
setDefaultFmtHighlighter String -> String
highlight 
  = (HighlightEnv -> String -> IO ()) -> IO ()
setDefaultHighlighter ((String -> String) -> HighlightEnv -> String -> IO ()
highlightFmt String -> String
highlight)





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

-- Print rich text

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


foreign import ccall ic_print           :: CString -> IO ()
foreign import ccall ic_println         :: CString -> IO ()
foreign import ccall ic_style_def       :: CString -> CString -> IO ()
foreign import ccall ic_style_open      :: CString -> IO ()
foreign import ccall ic_style_close     :: IO ()

-- | Output rich formatted text containing [bbcode](https://github.com/daanx/isocline#bbcode-format).

-- For example: @putFmt \"[b]bold [red]and red[\/][\/]\"@

-- All unclosed tags are automatically closed (but see also 'styleOpen').

-- See the repo for more information about [formatted output](https://github.com/daanx/isocline#formatted-output).

putFmt :: Fmt -> IO ()
putFmt :: String -> IO ()
putFmt String
s 
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cs -> 
    do CString -> IO ()
ic_print CString
cs

-- | Output rich formatted text containing bbcode's ending with a newline.

putFmtLn :: Fmt -> IO ()
putFmtLn :: String -> IO ()
putFmtLn String
s 
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cs -> 
    do CString -> IO ()
ic_println CString
cs

-- | Define (or redefine) a style.

-- For example @styleDef "warning" "crimon underline"@,

-- and then use it as @'putFmtLn' "[warning]this is a warning[/]"@. 

-- This can be very useful for theming your application with semantic styles.

-- See also [formatted output](https://github.com/daanx/isocline#formatted-output)

styleDef :: String -> Style -> IO ()
styleDef :: String -> String -> IO ()
styleDef String
name String
style
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
name ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cname ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
style ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cstyle ->
    do CString -> CString -> IO ()
ic_style_def CString
cname CString
cstyle

-- | Open a style that is active for all 'putFmt' and 'putFmtLn' until it is closed again (`styleClose`).

styleOpen :: Style -> IO ()
styleOpen :: String -> IO ()
styleOpen String
style
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
style ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cstyle ->
    do CString -> IO ()
ic_style_open CString
cstyle        

-- | Close a previously opened style.

styleClose :: IO ()
styleClose :: IO ()
styleClose 
  = IO ()
ic_style_close

-- | Use a style over an action.

withStyle :: Style -> IO a -> IO a
withStyle :: String -> IO a -> IO a
withStyle String
style IO a
action
  = IO () -> (() -> IO ()) -> (() -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IO ()
styleOpen String
style) (\() -> IO ()
styleClose) (\() -> IO a
action) 


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

-- Terminal

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


foreign import ccall ic_term_init       :: IO ()
foreign import ccall ic_term_done       :: IO ()
foreign import ccall ic_term_flush      :: IO ()
foreign import ccall ic_term_write      :: CString -> IO ()
foreign import ccall ic_term_writeln    :: CString -> IO ()
foreign import ccall ic_term_underline  :: CCBool -> IO ()
foreign import ccall ic_term_reverse    :: CCBool -> IO ()
foreign import ccall ic_term_color_ansi :: CCBool -> CInt -> IO ()
foreign import ccall ic_term_color_rgb  :: CCBool -> CInt -> IO ()
foreign import ccall ic_term_style      :: CString -> IO ()
foreign import ccall ic_term_reset      :: IO ()

-- | Initialize the terminal for the @term@ functions.

-- Does nothing on most platforms but on windows enables UTF8 output

-- and potentially enables virtual terminal processing.

-- See also 'withTerm'.

termInit :: IO ()
termInit :: IO ()
termInit 
  = IO ()
ic_term_init

-- | Done using @term@ functions.

-- See also 'withTerm'.

termDone :: IO ()
termDone :: IO ()
termDone 
  = IO ()
ic_term_done

-- | Use the @term@ functions (brackets 'termInit' and 'termDone').

withTerm :: IO a -> IO a
withTerm :: IO a -> IO a
withTerm IO a
action
  = IO () -> (() -> IO ()) -> (() -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO ()
termInit (\() -> IO ()
termDone) (\() -> IO a
action) 

-- | Flush terminal output. Happens automatically on newline (@'\\n'@) characters as well.

termFlush :: IO ()
termFlush :: IO ()
termFlush
  = IO ()
ic_term_flush  

-- | Write output to the terminal where ANSI CSI sequences are

-- handled portably across platforms (including Windows).

termWrite :: String -> IO ()
termWrite :: String -> IO ()
termWrite String
s
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cs -> CString -> IO ()
ic_term_write CString
cs

-- | Write output with a ending newline to the terminal where 

-- ANSI CSI sequences are handled portably across platforms (including Windows).

termWriteLn :: String -> IO ()
termWriteLn :: String -> IO ()
termWriteLn String
s
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
s ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cs -> CString -> IO ()
ic_term_writeln CString
cs  

-- | Set the terminal text color as a hexadecimal number @0x@rrggbb. 

-- The color is auto adjusted for terminals with less colors.

termColor :: Int -> IO ()
termColor :: Int -> IO ()
termColor Int
color
  = CCBool -> CCBool -> IO ()
ic_term_color_rgb (Bool -> CCBool
cbool Bool
True) (Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
color)

-- | Set the terminal text background color. The color is auto adjusted for terminals with less colors.

termBgColor :: Int -> IO ()
termBgColor :: Int -> IO ()
termBgColor Int
color
  = CCBool -> CCBool -> IO ()
ic_term_color_rgb (Bool -> CCBool
cbool Bool
False) (Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
color)

-- | Set the terminal text color as an ANSI palette color (between @0@ and @255@). Use 256 for the default.

-- The color is auto adjusted for terminals with less colors.

termColorAnsi :: Int -> IO ()
termColorAnsi :: Int -> IO ()
termColorAnsi Int
color
  = CCBool -> CCBool -> IO ()
ic_term_color_ansi (Bool -> CCBool
cbool Bool
True) (Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
color)

-- | Set the terminal text background color as an ANSI palette color (between @0@ and @255@). Use 256 for the default.

-- The color is auto adjusted for terminals with less colors.

termBgColorAnsi :: Int -> IO ()
termBgColorAnsi :: Int -> IO ()
termBgColorAnsi Int
color
  = CCBool -> CCBool -> IO ()
ic_term_color_ansi (Bool -> CCBool
cbool Bool
False) (Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
color)

-- | Set the terminal attributes from a style

termStyle :: Style -> IO ()
termStyle :: String -> IO ()
termStyle String
style
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
style ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cstyle ->
    do CString -> IO ()
ic_term_style CString
cstyle

-- | Set the terminal text underline mode.

termUnderline :: Bool -> IO ()
termUnderline :: Bool -> IO ()
termUnderline Bool
enable
  = CCBool -> IO ()
ic_term_underline (Bool -> CCBool
cbool Bool
enable)  

-- | Set the terminal text reverse video mode.

termReverse :: Bool -> IO ()
termReverse :: Bool -> IO ()
termReverse Bool
enable
  = CCBool -> IO ()
ic_term_reverse (Bool -> CCBool
cbool Bool
enable)  

-- | Reset the terminal text mode to defaults

termReset :: IO ()
termReset :: IO ()
termReset 
  = IO ()
ic_term_reset


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

-- Configuration

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

foreign import ccall ic_set_prompt_marker :: CString -> CString -> IO ()
foreign import ccall ic_get_prompt_marker :: IO CString
foreign import ccall ic_get_continuation_prompt_marker :: IO CString
foreign import ccall ic_enable_multiline  :: CCBool -> IO CCBool
foreign import ccall ic_enable_beep       :: CCBool -> IO CCBool
foreign import ccall ic_enable_color      :: CCBool -> IO CCBool
foreign import ccall ic_enable_auto_tab   :: CCBool -> IO CCBool
foreign import ccall ic_enable_inline_help:: CCBool -> IO CCBool
foreign import ccall ic_enable_hint       :: CCBool -> IO CCBool
foreign import ccall ic_set_hint_delay    :: CLong -> IO CLong
foreign import ccall ic_enable_highlight  :: CCBool -> IO CCBool
foreign import ccall ic_enable_history_duplicates :: CCBool -> IO CCBool
foreign import ccall ic_enable_completion_preview :: CCBool -> IO CCBool
foreign import ccall ic_enable_multiline_indent   :: CCBool -> IO CCBool
foreign import ccall ic_enable_brace_matching     :: CCBool -> IO CCBool
foreign import ccall ic_enable_brace_insertion    :: CCBool -> IO CCBool
foreign import ccall ic_set_matching_braces       :: CString -> IO ()
foreign import ccall ic_set_insertion_braces      :: CString -> IO ()

cbool :: Bool -> CCBool
cbool :: Bool -> CCBool
cbool Bool
True  = Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
1
cbool Bool
False = Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
0

uncbool :: IO CCBool -> IO Bool
uncbool :: IO CCBool -> IO Bool
uncbool IO CCBool
action
  = do CCBool
i <- IO CCBool
action
       Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (CCBool
i CCBool -> CCBool -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> CCBool
forall a. Enum a => Int -> a
toEnum Int
0)

clong :: Int -> CLong
clong :: Int -> CLong
clong Int
l = Int -> CLong
forall a. Enum a => Int -> a
toEnum Int
l


-- | @setPromptMarker marker multiline_marker@: Set the prompt @marker@ (by default @\"> \"@). 

-- and a possible different continuation prompt marker @multiline_marker@ for multiline 

-- input (defaults to @marker@).

setPromptMarker :: String -> String -> IO ()
setPromptMarker :: String -> String -> IO ()
setPromptMarker String
marker String
multiline_marker  
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
marker ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cmarker ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
multiline_marker ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cmultiline_marker ->
    do CString -> CString -> IO ()
ic_set_prompt_marker CString
cmarker CString
cmultiline_marker


-- | Get the current prompt marker.

getPromptMarker :: IO String
getPromptMarker :: IO String
getPromptMarker 
  = do CString
cstr  <- IO CString
ic_get_prompt_marker
       if (CString
forall a. Ptr a
nullPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
cstr) 
         then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         else do CString
cstr2 <- CString -> IO CString
ic_strdup CString
cstr
                 CString -> IO String
peekUTF8String0 CString
cstr2

-- | Get the current prompt continuation marker for multi-line input.

getContinuationPromptMarker :: IO String
getContinuationPromptMarker :: IO String
getContinuationPromptMarker 
  = do CString
cstr <- IO CString
ic_get_continuation_prompt_marker
       if (CString
forall a. Ptr a
nullPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
cstr) 
         then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
         else do CString
cstr2 <- CString -> IO CString
ic_strdup CString
cstr
                 CString -> IO String
peekUTF8String0 CString
cstr2


-- | Disable or enable multi-line input (enabled by default).

-- Returns the previous value.

enableMultiline :: Bool -> IO Bool
enableMultiline :: Bool -> IO Bool
enableMultiline Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_multiline (Bool -> CCBool
cbool Bool
enable)

-- | Disable or enable sound (enabled by default).

-- | A beep is used when tab cannot find any completion for example.

-- Returns the previous value.

enableBeep :: Bool -> IO Bool
enableBeep :: Bool -> IO Bool
enableBeep Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_beep (Bool -> CCBool
cbool Bool
enable)

-- | Disable or enable color output (enabled by default).

-- Returns the previous value.

enableColor :: Bool -> IO Bool
enableColor :: Bool -> IO Bool
enableColor Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_color (Bool -> CCBool
cbool Bool
enable)

-- | Disable or enable duplicate entries in the history (duplicate entries are not allowed by default).

-- Returns the previous value.

enableHistoryDuplicates :: Bool -> IO Bool
enableHistoryDuplicates :: Bool -> IO Bool
enableHistoryDuplicates Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_history_duplicates (Bool -> CCBool
cbool Bool
enable)


-- | Disable or enable automatic tab completion after a completion 

-- to expand as far as possible if the completions are unique. (disabled by default).

-- Returns the previous value.

enableAutoTab :: Bool -> IO Bool
enableAutoTab :: Bool -> IO Bool
enableAutoTab Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_auto_tab (Bool -> CCBool
cbool Bool
enable)


-- | Disable or enable short inline help message (for history search etc.) (enabled by default).

-- Pressing F1 always shows full help regardless of this setting. 

-- Returns the previous value.

enableInlineHelp :: Bool -> IO Bool
enableInlineHelp :: Bool -> IO Bool
enableInlineHelp Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_inline_help (Bool -> CCBool
cbool Bool
enable)

-- | Disable or enable preview of a completion selection (enabled by default)

-- Returns the previous value.

enableCompletionPreview :: Bool -> IO Bool
enableCompletionPreview :: Bool -> IO Bool
enableCompletionPreview Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_completion_preview (Bool -> CCBool
cbool Bool
enable)


-- | Disable or enable brace matching (enabled by default)

-- Returns the previous value.

enableBraceMatching :: Bool -> IO Bool
enableBraceMatching :: Bool -> IO Bool
enableBraceMatching Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_brace_matching (Bool -> CCBool
cbool Bool
enable)

-- | Disable or enable automatic close brace insertion (enabled by default)

-- Returns the previous value.

enableBraceInsertion :: Bool -> IO Bool
enableBraceInsertion :: Bool -> IO Bool
enableBraceInsertion Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_brace_insertion (Bool -> CCBool
cbool Bool
enable)

-- | Set pairs of matching braces, by default @\"(){}[]\"@.

setMatchingBraces :: String -> IO ()
setMatchingBraces :: String -> IO ()
setMatchingBraces String
bracePairs
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
bracePairs ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cbracePairs ->
    do CString -> IO ()
ic_set_matching_braces CString
cbracePairs

-- | Set pairs of auto insertion braces, by default @\"(){}[]\\\"\\\"\'\'\"@.

setInsertionBraces :: String -> IO ()
setInsertionBraces :: String -> IO ()
setInsertionBraces String
bracePairs
  = String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withUTF8String0 String
bracePairs ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cbracePairs ->
    do CString -> IO ()
ic_set_insertion_braces CString
cbracePairs


-- | Disable or enable automatic indentation to line up the

-- multiline prompt marker with the initial prompt marker (enabled by default).

-- Returns the previous value.

-- See also 'setPromptMarker'.

enableMultilineIndent :: Bool -> IO Bool
enableMultilineIndent :: Bool -> IO Bool
enableMultilineIndent Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_multiline_indent (Bool -> CCBool
cbool Bool
enable)

-- | Disable or enable automatic inline hinting (enabled by default)

-- Returns the previous value.

enableHint :: Bool -> IO Bool
enableHint :: Bool -> IO Bool
enableHint Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_hint (Bool -> CCBool
cbool Bool
enable)

-- | Disable or enable syntax highlighting (enabled by default).

-- Returns the previous value.

enableHighlight :: Bool -> IO Bool
enableHighlight :: Bool -> IO Bool
enableHighlight Bool
enable
  = do IO CCBool -> IO Bool
uncbool (IO CCBool -> IO Bool) -> IO CCBool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CCBool -> IO CCBool
ic_enable_highlight (Bool -> CCBool
cbool Bool
enable)

-- | Set the delay in milliseconds before a hint is displayed (500ms by default)

-- See also 'enableHint'

setHintDelay :: Int -> IO Int
setHintDelay :: Int -> IO Int
setHintDelay Int
ms
  = do CLong
cl <- CLong -> IO CLong
ic_set_hint_delay (Int -> CLong
forall a. Enum a => Int -> a
toEnum Int
ms)
       Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (CLong -> Int
forall a. Enum a => a -> Int
fromEnum CLong
cl)


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

-- UTF8 Strings

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


withUTF8String0 :: String -> (CString -> IO a) -> IO a
withUTF8String0 :: String -> (CString -> IO a) -> IO a
withUTF8String0 String
s CString -> IO a
action
  = if (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) then CString -> IO a
action CString
forall a. Ptr a
nullPtr else String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withUTF8String String
s CString -> IO a
action

peekUTF8String0 :: CString -> IO String
peekUTF8String0 :: CString -> IO String
peekUTF8String0 CString
cstr
  = if (CString
forall a. Ptr a
nullPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
cstr) then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"" else CString -> IO String
peekUTF8String CString
cstr

peekUTF8StringMaybe :: CString -> IO (Maybe String)
peekUTF8StringMaybe :: CString -> IO (Maybe String)
peekUTF8StringMaybe CString
cstr
  = if (CString
forall a. Ptr a
nullPtr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
cstr) then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing 
     else do String
s <- CString -> IO String
peekUTF8String CString
cstr
             Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
s)

peekUTF8String :: CString -> IO String
peekUTF8String :: CString -> IO String
peekUTF8String CString
cstr
  = do ByteString
bstr <- CString -> IO ByteString
B.packCString CString
cstr
       String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
T.unpack (OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode ByteString
bstr))

withUTF8String :: String -> (CString -> IO a) -> IO a
withUTF8String :: String -> (CString -> IO a) -> IO a
withUTF8String String
str CString -> IO a
action
  = do let bstr :: ByteString
bstr = Text -> ByteString
TE.encodeUtf8 (String -> Text
T.pack String
str)
       ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
bstr CString -> IO a
action