module Client.Commands.WordCompletion
( Prefix(..)
, wordComplete
) where
import qualified Client.State.EditBox as Edit
import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Char
import Data.List
import qualified Data.Set as Set
import Data.String (IsString(..))
import qualified Data.Text as Text
import Data.Text (Text)
import Irc.Identifier
wordComplete ::
Prefix a =>
(String -> String) ->
Bool ->
[a] ->
[a] ->
Edit.EditBox -> Maybe Edit.EditBox
wordComplete leadingCase isReversed hint vals box =
do let current = currentWord box
guard (not (null current))
let cur = fromString current
case view Edit.lastOperation box of
Edit.TabOperation patternStr
| isPrefix pat cur ->
do next <- tabSearch isReversed pat cur vals
Just $ replaceWith leadingCase (toString next) box
where
pat = fromString patternStr
_ ->
do next <- find (isPrefix cur) hint <|>
tabSearch isReversed cur cur vals
Just $ set Edit.lastOperation (Edit.TabOperation current)
$ replaceWith leadingCase (toString next) box
replaceWith :: (String -> String) -> String -> Edit.EditBox -> Edit.EditBox
replaceWith leadingCase str box =
let box1 = Edit.killWordBackward False box
str1 | view Edit.pos box1 == 0 = leadingCase str
| otherwise = str
in over Edit.content (Edit.insertString str1) box1
currentWord :: Edit.EditBox -> String
currentWord box
= reverse
$ takeWhile (not . isSpace)
$ dropWhile (\x -> x==' ' || x==':')
$ reverse
$ take n txt
where Edit.Line n txt = view Edit.line box
class (IsString a, Ord a) => Prefix a where
isPrefix :: a -> a -> Bool
toString :: a -> String
instance Prefix Identifier where
isPrefix = idPrefix
toString = Text.unpack . idText
instance Prefix Text where
isPrefix = Text.isPrefixOf
toString = Text.unpack
tabSearch :: Prefix a => Bool -> a -> a -> [a] -> Maybe a
tabSearch isReversed pat cur vals
| Just next <- advanceFun cur valSet
, isPrefix pat next
= Just next
| isReversed = find (isPrefix pat) (Set.toDescList valSet)
| otherwise = do x <- Set.lookupGE pat valSet
guard (isPrefix pat x)
Just x
where
valSet = Set.fromList vals
advanceFun | isReversed = Set.lookupLT
| otherwise = Set.lookupGT