Case insensitive completion

I am not author of the patch, this commit use patch from https://paste.debian.net/plainh/ec5ae9040
see judah#84 judah#84 (comment)

System/Console/Haskeline/Command/Completion.hs

@@ -14,6 +14,7 @@ import System.Console.Haskeline.Prefs
 import System.Console.Haskeline.Completion
 import System.Console.Haskeline.Monads
 
+import Data.Char(toLower)
 import Data.List(transpose, unfoldr)
 
 useCompletion :: InsertMode -> Completion -> InsertMode
@@ -64,7 +65,9 @@ makePartialCompletion :: InsertMode -> [Completion] -> InsertMode
 makePartialCompletion im completions = insertString partial im
   where
     partial = foldl1 commonPrefix (map replacement completions)
-    commonPrefix (c:cs) (d:ds) | c == d = c : commonPrefix cs ds
+    commonPrefix (c:cs) (d:ds) | toLower c == toLower d = c : commonPrefix cs ds
+        -- toLower is useful when there are case-insensitive matches and
+        -- does nothing to case-sensitive ones.
     commonPrefix _ _ = ""
 
 pagingCompletion :: MonadReader Layout m => Key -> Prefs

System/Console/Haskeline/Completion.hs

@@ -1,10 +1,12 @@
 module System.Console.Haskeline.Completion(
                             CompletionFunc,
                             Completion(..),
+                            CaseSensitivity(..),
                             noCompletion,
                             simpleCompletion,
                             -- * Word completion
                             completeWord,
+                            completeList,
                             completeWordWithPrev,
                             completeQuotedWord,
                             -- * Filename completion
@@ -17,6 +19,7 @@ module System.Console.Haskeline.Completion(
 import System.FilePath
 import Data.List(isPrefixOf)
 import Control.Monad(forM)
+import Data.Char(toLower)
 
 import System.Console.Haskeline.Directory
 import System.Console.Haskeline.Monads
@@ -41,6 +44,9 @@ data Completion = Completion {replacement  :: String, -- ^ Text to insert in lin
                             }
                     deriving (Eq, Ord, Show)
 
+-- | Case sensitivity for autocomplete-from-wordlist functions.
+data CaseSensitivity = MatchCase | IgnoreCase
+
 -- | Disable completion altogether.
 noCompletion :: Monad m => CompletionFunc m
 noCompletion (s,_) = return (s,[])
@@ -58,6 +64,37 @@ completeWord :: Monad m => Maybe Char
         -> CompletionFunc m
 completeWord esc ws = completeWordWithPrev esc ws . const
 
+-- | Autocomplete from list of words, following the same behaviour as
+-- 'completeWord' (completes to the immediate left of the cursor, word begins
+-- at newline or unescaped whitespace).
+--
+-- This function allows selecting case-sensitivity of the autocomplete.
+-- e.g. with 'IgnoreCase', @readf\<Tab\>@ will be expanded to
+-- @readFile@.
+completeList :: Monad m => Maybe Char -- ^ An optional escape character
+                        -> [Char]     -- ^ Characters which count as whitespace
+                        -> [String]   -- ^ List of autocompletable words
+                        -> CaseSensitivity -- ^ Case sensitivity
+                        -> CompletionFunc m
+completeList esc ws ml cs  = do
+    completeWordWithPrev esc ws (complFun ml)
+  where
+        complFun :: Monad m => [String] -> String -> String -> m [Completion]
+        complFun dic _ part = return . map simpleCompletion .
+                              selectMatches cs part $ dic
+
+        -- selectMatches performs an `isPrefixOf` filter on a dictionary;
+        -- for IgnoreCase, perfect matches will be listed higher.
+        selectMatches :: CaseSensitivity -> String -> [String] -> [String]
+        selectMatches MatchCase part dic = filter (isPrefixOf part) dic
+        selectMatches IgnoreCase part dic =
+            filter (isPrefixOf part) dic ++
+            filter (\d -> isPrefixOf (low part) (low d) &&
+                          (not $ isPrefixOf part d)) dic
+
+        low :: String -> String
+        low t = map toLower t
+
 -- | A custom 'CompletionFunc' which completes the word immediately to the left of the cursor,
 -- and takes into account the line contents to the left of the word.
 --

examples/Case.hs

@@ -0,0 +1,50 @@
+module Main where
+
+import System.Console.Haskeline
+import System.Console.Haskeline.Completion
+import System.Environment
+import Control.Exception (AsyncException(..))
+
+{-
+Testing case-insensitive autocompletion.
+
+Usage:
+(from the project folder)
+    cabal new-repl
+(an then from inside ghci)
+    :load examples/Case.hs
+    main
+-}
+
+{- Expected behaviour:
+        r<tab> does not change cap of the letter
+        R<tab> does not change cap of the letter
+        Ca<tab> suggestions are "Cane callo"
+        ca<tab> suggestions are "callo Cane"
+        ma<tab> gets completed to "maybe"
+        Ma<tab> gets completed to "Maybe"
+        cane<tab> gets completed to "Cane"
+-}
+
+mySettings :: Settings IO
+mySettings = setComplete cfCI defaultSettings
+    where
+          cfCI :: CompletionFunc IO
+          cfCI = completeList Nothing " "
+                     ["Rana", "rosa", "Cane", "callo", "maybe", "Maybe"]
+                     IgnoreCase
+
+main :: IO ()
+main = runInputT mySettings $ withInterrupt $ loop getInputLine 0
+    where
+        loop inputFunc n = do
+            minput <- handle (\Interrupt -> return (Just "Caught interrupted"))
+                        $ inputFunc (show n ++ ":")
+            case minput of
+                Nothing -> return ()
+                Just "quit" -> return ()
+                Just "q" -> return ()
+                Just s -> do
+                            outputStrLn ("line " ++ show n ++ ":" ++ s)
+                            loop inputFunc (n+1)
+

haskeline.cabal

@@ -20,7 +20,7 @@ Homepage:       https://github.com/judah/haskeline
 Bug-Reports:    https://github.com/judah/haskeline/issues
 Stability:      Stable
 Build-Type:     Simple
-extra-source-files: examples/Test.hs Changelog includes/*.h
+extra-source-files: examples/Test.hs examples/Case.hs Changelog includes/*.h
 
 source-repository head
     type: git