    module System.Console.Haskeline.Command.Completion(
                                CompletionFunc,
                                Completion,
                                CompletionType(..),
                                completionCmd
                                ) where

    import System.Console.Haskeline.Backend.WCWidth (gsWidth)
    import System.Console.Haskeline.Command
    import System.Console.Haskeline.Command.Undo
    import System.Console.Haskeline.Key
    import System.Console.Haskeline.Term (Layout(..), CommandMonad(..))
    import System.Console.Haskeline.LineState
    import System.Console.Haskeline.Prefs
    import System.Console.Haskeline.Completion
    import System.Console.Haskeline.Monads

    import Data.List(transpose, unfoldr)

    useCompletion :: InsertMode -> Completion -> InsertMode
    useCompletion :: InsertMode -> Completion -> InsertMode
    useCompletion InsertMode
    im Completion
    c = String -> InsertMode -> InsertMode
    insertString String
    r InsertMode
    im
        where r :: String
    r | Completion -> Bool
    isFinished Completion
    c = Completion -> String
    replacement Completion
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " "
                | Bool
    otherwise = Completion -> String
    replacement Completion
    c

    askIMCompletions :: CommandMonad m =>
                Command m InsertMode (InsertMode, [Completion])
    askIMCompletions :: forall (m :: * -> *).
    CommandMonad m =>
    Command m InsertMode (InsertMode, [Completion])
    askIMCompletions (IMode [Grapheme]
    xs [Grapheme]
    ys) = do
        (rest, completions) <- m (String, [Completion]) -> CmdM m (String, [Completion])
    forall (m :: * -> *) a. Monad m => m a -> CmdM m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m (String, [Completion]) -> CmdM m (String, [Completion]))
    -> m (String, [Completion]) -> CmdM m (String, [Completion])
    forall a b. (a -> b) -> a -> b
    $ (String, String) -> m (String, [Completion])
    forall (m :: * -> *).
    CommandMonad m =>
    (String, String) -> m (String, [Completion])
    runCompletion (([Grapheme] -> String) -> [Grapheme] -> String
    forall a b. ([a] -> [b]) -> [a] -> [b]
    withRev [Grapheme] -> String
    graphemesToString [Grapheme]
    xs,
                                                [Grapheme] -> String
    graphemesToString [Grapheme]
    ys)
        return (IMode (withRev stringToGraphemes rest) ys, completions)
      where
        withRev :: ([a] -> [b]) -> [a] -> [b]
        withRev :: forall a b. ([a] -> [b]) -> [a] -> [b]
    withRev [a] -> [b]
    f = [b] -> [b]
    forall a. [a] -> [a]
    reverse ([b] -> [b]) -> ([a] -> [b]) -> [a] -> [b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [b]
    f ([a] -> [b]) -> ([a] -> [a]) -> [a] -> [b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. [a] -> [a]
    reverse

    -- | Create a 'Command' for word completion.
    completionCmd :: (MonadState Undo m, CommandMonad m)
                    => Key -> KeyCommand m InsertMode InsertMode
    completionCmd :: forall (m :: * -> *).
    (MonadState Undo m, CommandMonad m) =>
    Key -> KeyCommand m InsertMode InsertMode
    completionCmd Key
    k = Key
    k Key
    -> Command m InsertMode InsertMode
    -> KeyMap (Command m InsertMode InsertMode)
    forall a. Key -> a -> KeyMap a
    +> Command m InsertMode InsertMode
    forall s (m :: * -> *).
    (Save s, MonadState Undo m) =>
    Command m s s
    saveForUndo Command m InsertMode InsertMode
    -> Command m InsertMode InsertMode
    -> Command m InsertMode InsertMode
    forall (m :: * -> *) s t u.
    Monad m =>
    Command m s t -> Command m t u -> Command m s u
    >|> \InsertMode
    oldIM -> do
        (rest,cs) <- Command m InsertMode (InsertMode, [Completion])
    forall (m :: * -> *).
    CommandMonad m =>
    Command m InsertMode (InsertMode, [Completion])
    askIMCompletions InsertMode
    oldIM
        case cs of
            [] -> Effect -> CmdM m ()
    forall (m :: * -> *). Effect -> CmdM m ()
    effect Effect
    RingBell CmdM m () -> CmdM m InsertMode -> CmdM m InsertMode
    forall a b. CmdM m a -> CmdM m b -> CmdM m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Command m InsertMode InsertMode
    forall a. a -> CmdM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return InsertMode
    oldIM
            [Completion
    c] -> Command m InsertMode InsertMode
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState Command m InsertMode InsertMode -> Command m InsertMode InsertMode
    forall a b. (a -> b) -> a -> b
    $ InsertMode -> Completion -> InsertMode
    useCompletion InsertMode
    rest Completion
    c
            [Completion]
    _ -> Key
    -> InsertMode -> InsertMode -> [Completion] -> CmdM m InsertMode
    forall (m :: * -> *).
    (MonadReader Prefs m, MonadReader Layout m) =>
    Key
    -> InsertMode -> InsertMode -> [Completion] -> CmdM m InsertMode
    presentCompletions Key
    k InsertMode
    oldIM InsertMode
    rest [Completion]
    cs

    presentCompletions :: (MonadReader Prefs m, MonadReader Layout m)
            => Key -> InsertMode -> InsertMode
                -> [Completion] -> CmdM m InsertMode
    presentCompletions :: forall (m :: * -> *).
    (MonadReader Prefs m, MonadReader Layout m) =>
    Key
    -> InsertMode -> InsertMode -> [Completion] -> CmdM m InsertMode
    presentCompletions Key
    k InsertMode
    oldIM InsertMode
    rest [Completion]
    cs = do
        prefs <- CmdM m Prefs
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        case completionType prefs of
            CompletionType
    MenuCompletion -> Key -> [InsertMode] -> Command m InsertMode InsertMode
    forall (m :: * -> *).
    Monad m =>
    Key -> [InsertMode] -> Command m InsertMode InsertMode
    menuCompletion Key
    k ((Completion -> InsertMode) -> [Completion] -> [InsertMode]
    forall a b. (a -> b) -> [a] -> [b]
    map (InsertMode -> Completion -> InsertMode
    useCompletion InsertMode
    rest) [Completion]
    cs) InsertMode
    oldIM
            CompletionType
    ListCompletion -> do
                withPartial <- Command m InsertMode InsertMode
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState Command m InsertMode InsertMode -> Command m InsertMode InsertMode
    forall a b. (a -> b) -> a -> b
    $ InsertMode -> [Completion] -> InsertMode
    makePartialCompletion InsertMode
    rest [Completion]
    cs
                if withPartial /= oldIM
                    then return withPartial
                    else pagingCompletion k prefs cs withPartial

    menuCompletion :: Monad m => Key -> [InsertMode] -> Command m InsertMode InsertMode
    menuCompletion :: forall (m :: * -> *).
    Monad m =>
    Key -> [InsertMode] -> Command m InsertMode InsertMode
    menuCompletion Key
    k = [InsertMode] -> Command m InsertMode InsertMode
    forall {m :: * -> *} {s}.
    (Monad m, LineState s) =>
    [s] -> Command m s s
    loop
        where
            loop :: [s] -> Command m s s
    loop [] = Command m s s
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState
            loop (s
    c:[s]
    cs) = (s -> s) -> Command m s s
    forall t (m :: * -> *) s.
    (LineState t, Monad m) =>
    (s -> t) -> Command m s t
    change (s -> s -> s
    forall a b. a -> b -> a
    const s
    c) Command m s s -> Command m s s -> Command m s s
    forall (m :: * -> *) s t u.
    Monad m =>
    Command m s t -> Command m t u -> Command m s u
    >|> KeyCommand m s s -> Command m s s
    forall (m :: * -> *) s.
    Monad m =>
    KeyCommand m s s -> Command m s s
    try (Key
    k Key -> Command m s s -> KeyCommand m s s
    forall a. Key -> a -> KeyMap a
    +> [s] -> Command m s s
    loop [s]
    cs)

    makePartialCompletion :: InsertMode -> [Completion] -> InsertMode
    makePartialCompletion :: InsertMode -> [Completion] -> InsertMode
    makePartialCompletion InsertMode
    im [Completion]
    completions = String -> InsertMode -> InsertMode
    insertString String
    partial InsertMode
    im
      where
        partial :: String
    partial = (String -> String -> String) -> [String] -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldl1 String -> String -> String
    commonPrefix ((Completion -> String) -> [Completion] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Completion -> String
    replacement [Completion]
    completions)
        commonPrefix :: String -> String -> String
    commonPrefix (Char
    c:String
    cs) (Char
    d:String
    ds) | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    d = Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String -> String
    commonPrefix String
    cs String
    ds
        commonPrefix String
    _ String
    _ = String
    ""

    pagingCompletion :: MonadReader Layout m => Key -> Prefs
                    -> [Completion] -> Command m InsertMode InsertMode
    pagingCompletion :: forall (m :: * -> *).
    MonadReader Layout m =>
    Key -> Prefs -> [Completion] -> Command m InsertMode InsertMode
    pagingCompletion Key
    k Prefs
    prefs [Completion]
    completions = \InsertMode
    im -> do
            ls <- (Layout -> [String]) -> CmdM m [String]
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ((Layout -> [String]) -> CmdM m [String])
    -> (Layout -> [String]) -> CmdM m [String]
    forall a b. (a -> b) -> a -> b
    $ [String] -> Layout -> [String]
    makeLines ((Completion -> String) -> [Completion] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Completion -> String
    display [Completion]
    completions)
            let pageAction = do
                    Prefs -> Int -> CmdM m () -> CmdM m ()
    forall (m :: * -> *).
    Monad m =>
    Prefs -> Int -> CmdM m () -> CmdM m ()
    askFirst Prefs
    prefs ([Completion] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Completion]
    completions) (CmdM m () -> CmdM m ()) -> CmdM m () -> CmdM m ()
    forall a b. (a -> b) -> a -> b
    $
                                if Prefs -> Bool
    completionPaging Prefs
    prefs
                                    then [String] -> CmdM m ()
    forall (m :: * -> *). MonadReader Layout m => [String] -> CmdM m ()
    printPage [String]
    ls
                                    else Effect -> CmdM m ()
    forall (m :: * -> *). Effect -> CmdM m ()
    effect ([String] -> Effect
    PrintLines [String]
    ls)
                    InsertMode -> CmdM m InsertMode
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState InsertMode
    im
            if listCompletionsImmediately prefs
                then pageAction
                else effect RingBell >> try (k +> const pageAction) im

    askFirst :: Monad m => Prefs -> Int -> CmdM m ()
                -> CmdM m ()
    askFirst :: forall (m :: * -> *).
    Monad m =>
    Prefs -> Int -> CmdM m () -> CmdM m ()
    askFirst Prefs
    prefs Int
    n CmdM m ()
    cmd
        | Bool -> (Int -> Bool) -> Maybe Int -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    False (Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    n) (Prefs -> Maybe Int
    completionPromptLimit Prefs
    prefs) = do
            _ <- Command m Message Message
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState (String -> Message
    Message (String -> Message) -> String -> Message
    forall a b. (a -> b) -> a -> b
    $ String
    "Display all " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n
                                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " possibilities? (y or n)")
            keyChoiceCmdM [
                simpleChar 'y' +> cmd
                , simpleChar 'n' +> return ()
                ]
        | Bool
    otherwise = CmdM m ()
    cmd

    pageCompletions :: MonadReader Layout m => [String] -> CmdM m ()
    pageCompletions :: forall (m :: * -> *). MonadReader Layout m => [String] -> CmdM m ()
    pageCompletions [] = () -> CmdM m ()
    forall a. a -> CmdM m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    pageCompletions wws :: [String]
    wws@(String
    w:[String]
    ws) = do
        _ <- Command m Message Message
    forall (m :: * -> *) s. (Monad m, LineState s) => Command m s s
    setState Command m Message Message -> Command m Message Message
    forall a b. (a -> b) -> a -> b
    $ String -> Message
    Message String
    "----More----"
        keyChoiceCmdM [
            simpleChar '\n' +> oneLine
            , simpleKey DownKey +> oneLine
            , simpleChar 'q' +> return ()
            , simpleChar ' ' +> (clearMessage >> printPage wws)
            ]
      where
        oneLine :: CmdM m ()
    oneLine = CmdM m ()
    forall {m :: * -> *}. CmdM m ()
    clearMessage CmdM m () -> CmdM m () -> CmdM m ()
    forall a b. CmdM m a -> CmdM m b -> CmdM m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Effect -> CmdM m ()
    forall (m :: * -> *). Effect -> CmdM m ()
    effect ([String] -> Effect
    PrintLines [String
    w]) CmdM m () -> CmdM m () -> CmdM m ()
    forall a b. CmdM m a -> CmdM m b -> CmdM m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [String] -> CmdM m ()
    forall (m :: * -> *). MonadReader Layout m => [String] -> CmdM m ()
    pageCompletions [String]
    ws
        clearMessage :: CmdM m ()
    clearMessage = Effect -> CmdM m ()
    forall (m :: * -> *). Effect -> CmdM m ()
    effect (Effect -> CmdM m ()) -> Effect -> CmdM m ()
    forall a b. (a -> b) -> a -> b
    $ ([Grapheme] -> LineChars) -> Effect
    LineChange (([Grapheme] -> LineChars) -> Effect)
    -> ([Grapheme] -> LineChars) -> Effect
    forall a b. (a -> b) -> a -> b
    $ LineChars -> [Grapheme] -> LineChars
    forall a b. a -> b -> a
    const ([],[])

    printPage :: MonadReader Layout m => [String] -> CmdM m ()
    printPage :: forall (m :: * -> *). MonadReader Layout m => [String] -> CmdM m ()
    printPage [String]
    ls = do
        layout <- CmdM m Layout
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        let (ps,rest) = splitAt (height layout - 1) ls
        effect $ PrintLines ps
        pageCompletions rest

    -----------------------------------------------
    -- Splitting the list of completions into lines for paging.
    makeLines :: [String] -> Layout -> [String]
    makeLines :: [String] -> Layout -> [String]
    makeLines [String]
    ws Layout
    layout = let
        minColPad :: Int
    minColPad = Int
    2
        printWidth :: Int
    printWidth = Layout -> Int
    width Layout
    layout
        maxWidth :: Int
    maxWidth = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    printWidth ([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 ([Grapheme] -> Int
    gsWidth ([Grapheme] -> Int) -> (String -> [Grapheme]) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [Grapheme]
    stringToGraphemes) [String]
    ws) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    minColPad)
        numCols :: Int
    numCols = Int
    printWidth Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    maxWidth
        ls :: [[String]]
    ls = if Int
    maxWidth Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    printWidth
                        then (String -> [String]) -> [String] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : []) [String]
    ws
                        else Int -> [String] -> [[String]]
    forall a. Int -> [a] -> [[a]]
    splitIntoGroups Int
    numCols [String]
    ws
        in ([String] -> String) -> [[String]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> [String] -> String
    padWords Int
    maxWidth) [[String]]
    ls

    -- Add spaces to the end of each word so that it takes up the given visual width.
    -- Don't pad the word in the last column, since printing a space in the last column
    -- causes a line wrap on some terminals.
    padWords :: Int -> [String] -> String
    padWords :: Int -> [String] -> String
    padWords Int
    _ [String
    x] = String
    x
    padWords Int
    _ [] = String
    ""
    padWords Int
    wid (String
    x:[String]
    xs) = String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    wid Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    widthOf String
    x) Char
    ' '
                            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> [String] -> String
    padWords Int
    wid [String]
    xs
        where
            -- kludge: compute the width in graphemes, not chars.
            -- also use graphemes for the max width so that multi-width characters
            -- such as CJK letters are aligned correctly.
            widthOf :: String -> Int
    widthOf = [Grapheme] -> Int
    gsWidth ([Grapheme] -> Int) -> (String -> [Grapheme]) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [Grapheme]
    stringToGraphemes

    -- Split xs into rows of length n,
    -- such that the list increases incrementally along the columns.
    -- e.g.: splitIntoGroups 4 [1..11] ==
    -- [[1,4,7,10]
    -- ,[2,5,8,11]
    -- ,[3,6,9]]
    splitIntoGroups :: Int -> [a] -> [[a]]
    splitIntoGroups :: forall a. Int -> [a] -> [[a]]
    splitIntoGroups Int
    n [a]
    xs = [[a]] -> [[a]]
    forall a. [[a]] -> [[a]]
    transpose ([[a]] -> [[a]]) -> [[a]] -> [[a]]
    forall a b. (a -> b) -> a -> b
    $ ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr [a] -> Maybe ([a], [a])
    forall {a}. [a] -> Maybe ([a], [a])
    f [a]
    xs
        where
            f :: [a] -> Maybe ([a], [a])
    f [] = Maybe ([a], [a])
    forall a. Maybe a
    Nothing
            f [a]
    ys = ([a], [a]) -> Maybe ([a], [a])
    forall a. a -> Maybe a
    Just (Int -> [a] -> ([a], [a])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    k [a]
    ys)
            k :: Int
    k = Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    ceilDiv ([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs) Int
    n

    -- ceilDiv m n is the smallest k such that k * n >= m.
    ceilDiv :: Integral a => a -> a -> a
    ceilDiv :: forall a. Integral a => a -> a -> a
    ceilDiv a
    m a
    n | a
    m a -> a -> a
    forall a. Integral a => a -> a -> a
    `rem` a
    n a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0    =  a
    m a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` a
    n
                | Bool
    otherwise         =  a
    m a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` a
    n a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1