module Client.Commands.WordCompletion
( Prefix(..)
, wordComplete
, WordCompletionMode(..)
, plainWordCompleteMode
, defaultNickWordCompleteMode
, slackNickWordCompleteMode
, CaseText, caseText
) where
import Client.State.EditBox qualified as Edit
import Control.Applicative ((<|>))
import Control.Lens (view, over, set)
import Control.Monad (guard)
import Data.List (find)
import Data.Set qualified as Set
import Data.String (IsString(..))
import Data.Text (Text)
import Data.Text qualified as Text
import Irc.Identifier (Identifier, idPrefix, idText)
data WordCompletionMode = WordCompletionMode
{ WordCompletionMode -> String
wcmStartPrefix, WordCompletionMode -> String
wcmStartSuffix, WordCompletionMode -> String
wcmMiddlePrefix, WordCompletionMode -> String
wcmMiddleSuffix :: String }
deriving Int -> WordCompletionMode -> ShowS
[WordCompletionMode] -> ShowS
WordCompletionMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordCompletionMode] -> ShowS
$cshowList :: [WordCompletionMode] -> ShowS
show :: WordCompletionMode -> String
$cshow :: WordCompletionMode -> String
showsPrec :: Int -> WordCompletionMode -> ShowS
$cshowsPrec :: Int -> WordCompletionMode -> ShowS
Show
plainWordCompleteMode :: WordCompletionMode
plainWordCompleteMode :: WordCompletionMode
plainWordCompleteMode = String -> String -> String -> String -> WordCompletionMode
WordCompletionMode String
"" String
"" String
"" String
""
defaultNickWordCompleteMode :: WordCompletionMode
defaultNickWordCompleteMode :: WordCompletionMode
defaultNickWordCompleteMode = String -> String -> String -> String -> WordCompletionMode
WordCompletionMode String
"" String
": " String
"" String
""
slackNickWordCompleteMode :: WordCompletionMode
slackNickWordCompleteMode :: WordCompletionMode
slackNickWordCompleteMode = String -> String -> String -> String -> WordCompletionMode
WordCompletionMode String
"@" String
" " String
"@" String
""
wordComplete ::
Prefix a =>
(Char -> Bool) ->
WordCompletionMode ->
Bool ->
[a] ->
[a] ->
Edit.EditBox -> Maybe Edit.EditBox
wordComplete :: forall a.
Prefix a =>
(Char -> Bool)
-> WordCompletionMode
-> Bool
-> [a]
-> [a]
-> EditBox
-> Maybe EditBox
wordComplete Char -> Bool
p WordCompletionMode
mode Bool
isReversed [a]
hint [a]
vals EditBox
box =
do let current :: String
current = (Char -> Bool) -> WordCompletionMode -> EditBox -> String
currentWord Char -> Bool
p WordCompletionMode
mode EditBox
box
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
current))
let cur :: a
cur = forall a. IsString a => String -> a
fromString String
current
case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' EditBox LastOperation
Edit.lastOperation EditBox
box of
Edit.TabOperation String
patternStr
| forall a. Prefix a => a -> a -> Bool
isPrefix a
pat a
cur ->
do a
next <- forall a. Prefix a => Bool -> a -> a -> [a] -> Maybe a
tabSearch Bool
isReversed a
pat a
cur [a]
vals
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> WordCompletionMode -> String -> EditBox -> EditBox
replaceWith Char -> Bool
p WordCompletionMode
mode (forall a. Prefix a => a -> String
toString a
next) EditBox
box
where
pat :: a
pat = forall a. IsString a => String -> a
fromString String
patternStr
LastOperation
_ ->
do a
next <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Prefix a => a -> a -> Bool
isPrefix a
cur) [a]
hint forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall a. Prefix a => Bool -> a -> a -> [a] -> Maybe a
tabSearch Bool
isReversed a
cur a
cur [a]
vals
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s t a b. ASetter s t a b -> b -> s -> t
set Lens' EditBox LastOperation
Edit.lastOperation (String -> LastOperation
Edit.TabOperation String
current)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool)
-> WordCompletionMode -> String -> EditBox -> EditBox
replaceWith Char -> Bool
p WordCompletionMode
mode (forall a. Prefix a => a -> String
toString a
next) EditBox
box
replaceWith :: (Char -> Bool) -> WordCompletionMode -> String -> Edit.EditBox -> Edit.EditBox
replaceWith :: (Char -> Bool)
-> WordCompletionMode -> String -> EditBox -> EditBox
replaceWith Char -> Bool
p (WordCompletionMode String
spfx String
ssfx String
mpfx String
msfx) String
str EditBox
box =
let box1 :: EditBox
box1 = (Char -> Bool) -> Bool -> EditBox -> EditBox
Edit.killWordBackward (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
p) Bool
False EditBox
box
str1 :: String
str1 | forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. HasLine c => Lens' c Int
Edit.pos EditBox
box1 forall a. Eq a => a -> a -> Bool
== Int
0 = String
spfx forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
ssfx
| Bool
otherwise = String
mpfx forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
msfx
in forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over Lens' EditBox Content
Edit.content (String -> Content -> Content
Edit.insertString String
str1) EditBox
box1
currentWord :: (Char -> Bool) -> WordCompletionMode -> Edit.EditBox -> String
currentWord :: (Char -> Bool) -> WordCompletionMode -> EditBox -> String
currentWord Char -> Bool
p (WordCompletionMode String
spfx String
ssfx String
mpfx String
msfx) EditBox
box
= forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`String
pfx)
forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
p
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`String
sfx)
forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse
forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
n String
txt
where
pfx :: String
pfx = String
spfxforall a. [a] -> [a] -> [a]
++String
mpfx
sfx :: String
sfx = String
ssfxforall a. [a] -> [a] -> [a]
++String
msfx
Edit.Line Int
n String
txt = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall c. HasLine c => Lens' c Line
Edit.line EditBox
box
class (IsString a, Ord a) => Prefix a where
isPrefix :: a -> a -> Bool
toString :: a -> String
instance Prefix Identifier where
isPrefix :: Identifier -> Identifier -> Bool
isPrefix = Identifier -> Identifier -> Bool
idPrefix
toString :: Identifier -> String
toString = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> Text
idText
instance Prefix Text where
isPrefix :: Text -> Text -> Bool
isPrefix = Text -> Text -> Bool
Text.isPrefixOf
toString :: Text -> String
toString = Text -> String
Text.unpack
newtype CaseText = CaseText { CaseText -> Text
unCaseText :: Text }
deriving (CaseText -> CaseText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaseText -> CaseText -> Bool
$c/= :: CaseText -> CaseText -> Bool
== :: CaseText -> CaseText -> Bool
$c== :: CaseText -> CaseText -> Bool
Eq, Eq CaseText
CaseText -> CaseText -> Bool
CaseText -> CaseText -> Ordering
CaseText -> CaseText -> CaseText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CaseText -> CaseText -> CaseText
$cmin :: CaseText -> CaseText -> CaseText
max :: CaseText -> CaseText -> CaseText
$cmax :: CaseText -> CaseText -> CaseText
>= :: CaseText -> CaseText -> Bool
$c>= :: CaseText -> CaseText -> Bool
> :: CaseText -> CaseText -> Bool
$c> :: CaseText -> CaseText -> Bool
<= :: CaseText -> CaseText -> Bool
$c<= :: CaseText -> CaseText -> Bool
< :: CaseText -> CaseText -> Bool
$c< :: CaseText -> CaseText -> Bool
compare :: CaseText -> CaseText -> Ordering
$ccompare :: CaseText -> CaseText -> Ordering
Ord, Int -> CaseText -> ShowS
[CaseText] -> ShowS
CaseText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaseText] -> ShowS
$cshowList :: [CaseText] -> ShowS
show :: CaseText -> String
$cshow :: CaseText -> String
showsPrec :: Int -> CaseText -> ShowS
$cshowsPrec :: Int -> CaseText -> ShowS
Show, ReadPrec [CaseText]
ReadPrec CaseText
Int -> ReadS CaseText
ReadS [CaseText]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CaseText]
$creadListPrec :: ReadPrec [CaseText]
readPrec :: ReadPrec CaseText
$creadPrec :: ReadPrec CaseText
readList :: ReadS [CaseText]
$creadList :: ReadS [CaseText]
readsPrec :: Int -> ReadS CaseText
$creadsPrec :: Int -> ReadS CaseText
Read)
instance IsString CaseText where
fromString :: String -> CaseText
fromString = Text -> CaseText
CaseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
instance Prefix CaseText where
isPrefix :: CaseText -> CaseText -> Bool
isPrefix CaseText
x CaseText
y = Text -> Text -> Bool
Text.isPrefixOf (CaseText -> Text
unCaseText CaseText
x) (CaseText -> Text
unCaseText CaseText
y)
toString :: CaseText -> String
toString = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseText -> Text
unCaseText
caseText :: Text -> CaseText
caseText :: Text -> CaseText
caseText = Text -> CaseText
CaseText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower
tabSearch ::
Prefix a =>
Bool ->
a ->
a ->
[a] ->
Maybe a
tabSearch :: forall a. Prefix a => Bool -> a -> a -> [a] -> Maybe a
tabSearch Bool
isReversed a
pat a
cur [a]
vals
| forall a. Set a -> Bool
Set.null Set a
valSet = forall a. Maybe a
Nothing
| Just a
next <- a -> Set a -> Maybe a
advanceFun a
cur Set a
valSet = forall a. a -> Maybe a
Just a
next
| Bool
isReversed = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a. Set a -> a
Set.findMax Set a
valSet
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall a. Set a -> a
Set.findMin Set a
valSet
where
valSet :: Set a
valSet = forall a. Ord a => [a] -> Set a
Set.fromList (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Prefix a => a -> a -> Bool
isPrefix a
pat) [a]
vals)
advanceFun :: a -> Set a -> Maybe a
advanceFun | Bool
isReversed = forall a. Ord a => a -> Set a -> Maybe a
Set.lookupLT
| Bool
otherwise = forall a. Ord a => a -> Set a -> Maybe a
Set.lookupGT