{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.TextCompletion
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Module providing text completion functions.

module Yi.TextCompletion (
        -- * Word completion
        wordComplete,
        wordComplete',
        wordCompleteString,
        wordCompleteString',
        mkWordComplete,
        resetComplete,
        completeWordB,
        CompletionScope(..)
) where

import           Control.Monad       (forM)
import           Data.Binary         (Binary, get, put)
import           Data.Char           (GeneralCategory (..), generalCategory)
import           Data.Default        (Default, def)
import           Data.Function       (on)
import           Data.List           (findIndex)
import           Data.List.NonEmpty  (NonEmpty (..))
import           Data.Maybe          (isJust)
import qualified Data.Text           as T (Text, drop, groupBy, head, isPrefixOf, length, null)
import qualified Data.Text.Encoding  as E (decodeUtf8, encodeUtf8)
import           Data.Typeable       (Typeable)
import           Yi.Buffer
import           Yi.Completion       (completeInList, isCasePrefixOf)
import           Yi.Editor
import           Yi.Keymap           (YiM)
import qualified Yi.Rope             as R (fromText, toText)
import           Yi.Types            (YiVariable)
import           Yi.Utils            (nubSet)

-- ---------------------------------------------------------------------
-- | Word completion
--
-- when doing keyword completion, we need to keep track of the word
-- we're trying to complete.


newtype Completion = Completion
      [T.Text] -- the list of all possible things we can complete to.
               -- (this seems very inefficient; but we use laziness to
               -- our advantage)
    deriving (Typeable, Int -> Completion -> ShowS
[Completion] -> ShowS
Completion -> String
(Int -> Completion -> ShowS)
-> (Completion -> String)
-> ([Completion] -> ShowS)
-> Show Completion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Completion] -> ShowS
$cshowList :: [Completion] -> ShowS
show :: Completion -> String
$cshow :: Completion -> String
showsPrec :: Int -> Completion -> ShowS
$cshowsPrec :: Int -> Completion -> ShowS
Show, 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)

instance Binary Completion where
  put :: Completion -> Put
put (Completion [Text]
ts) = [ByteString] -> Put
forall t. Binary t => t -> Put
put (Text -> ByteString
E.encodeUtf8 (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ts)
  get :: Get Completion
get = [Text] -> Completion
Completion ([Text] -> Completion)
-> ([ByteString] -> [Text]) -> [ByteString] -> Completion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
E.decodeUtf8 ([ByteString] -> Completion) -> Get [ByteString] -> Get Completion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [ByteString]
forall t. Binary t => Get t
get

-- TODO: put this in keymap state instead
instance Default Completion where
    def :: Completion
def = [Text] -> Completion
Completion []

instance YiVariable Completion

-- | Switch out of completion mode.
resetComplete :: EditorM ()
resetComplete :: EditorM ()
resetComplete = Completion -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn ([Text] -> Completion
Completion [])

-- | Try to complete the current word with occurences found elsewhere in the
-- editor. Further calls try other options.
mkWordComplete :: YiM T.Text -- ^ Extract function
               -> (T.Text -> YiM [T.Text]) -- ^ Source function
               -> ([T.Text] -> YiM ()) -- ^ Message function
               -> (T.Text -> T.Text -> Bool) -- ^ Predicate matcher
               -> YiM T.Text
mkWordComplete :: YiM Text
-> (Text -> YiM [Text])
-> ([Text] -> YiM ())
-> (Text -> Text -> Bool)
-> YiM Text
mkWordComplete YiM Text
extractFn Text -> YiM [Text]
sourceFn [Text] -> YiM ()
msgFn Text -> Text -> Bool
predMatch = do
  Completion [Text]
complList <- EditorM Completion -> YiM Completion
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM Completion
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
  case [Text]
complList of
    (Text
x:[Text]
xs) -> do -- more alternatives, use them.
       [Text] -> YiM ()
msgFn (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
xs)
       EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ())
-> (Completion -> EditorM ()) -> Completion -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Completion -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (Completion -> YiM ()) -> Completion -> YiM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Completion
Completion [Text]
xs
       Text -> YiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
    [] -> do -- no alternatives, build them.
      Text
w <- YiM Text
extractFn
      [Text]
ws <- Text -> YiM [Text]
sourceFn Text
w
      let comps :: [Text]
comps = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSet ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
matches Text
w) [Text]
ws) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
w]
      Completion -> YiM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (Completion -> YiM ()) -> Completion -> YiM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Completion
Completion [Text]
comps
      -- We put 'w' back at the end so we go back to it after seeing
      -- all possibilities.

      -- to pick the 1st possibility.
      YiM Text
-> (Text -> YiM [Text])
-> ([Text] -> YiM ())
-> (Text -> Text -> Bool)
-> YiM Text
mkWordComplete YiM Text
extractFn Text -> YiM [Text]
sourceFn [Text] -> YiM ()
msgFn Text -> Text -> Bool
predMatch

  where matches :: Text -> Text -> Bool
matches Text
x Text
y = Text
x Text -> Text -> Bool
`predMatch` Text
y Bool -> Bool -> Bool
&& Text
xText -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=Text
y

wordCompleteString' :: Bool -> YiM T.Text
wordCompleteString' :: Bool -> YiM Text
wordCompleteString' Bool
caseSensitive =
  YiM Text
-> (Text -> YiM [Text])
-> ([Text] -> YiM ())
-> (Text -> Text -> Bool)
-> YiM Text
mkWordComplete (BufferM Text -> YiM Text
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM Text -> YiM Text) -> BufferM Text -> YiM Text
forall a b. (a -> b) -> a -> b
$
                   Region -> BufferM Text
textRegion (Region -> BufferM Text) -> BufferM Region -> BufferM Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
unitWord Direction
Backward)
                 (\Text
_ -> EditorM [Text] -> YiM [Text]
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM [Text]
wordsForCompletion)
                 (\[Text]
_ -> () -> YiM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                 (Bool -> Text -> Text -> Bool
isCasePrefixOf Bool
caseSensitive)
  where
    textRegion :: Region -> BufferM Text
textRegion = (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> Text
R.toText (BufferM YiString -> BufferM Text)
-> (Region -> BufferM YiString) -> Region -> BufferM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> BufferM YiString
readRegionB

wordCompleteString :: YiM T.Text
wordCompleteString :: YiM Text
wordCompleteString = Bool -> YiM Text
wordCompleteString' Bool
True

wordComplete' :: Bool -> YiM ()
wordComplete' :: Bool -> YiM ()
wordComplete' Bool
caseSensitive = do
  YiString
x <- Text -> YiString
R.fromText (Text -> YiString) -> YiM Text -> YiM YiString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> YiM Text
wordCompleteString' Bool
caseSensitive
  EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ()) -> BufferM () -> EditorM ()
forall a b. (a -> b) -> a -> b
$
    (Region -> YiString -> BufferM ())
-> YiString -> Region -> BufferM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Region -> YiString -> BufferM ()
replaceRegionB YiString
x (Region -> BufferM ()) -> BufferM Region -> BufferM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
unitWord Direction
Backward

wordComplete :: YiM ()
wordComplete :: YiM ()
wordComplete = Bool -> YiM ()
wordComplete' Bool
True

----------------------------
-- Alternative Word Completion

{-
  'completeWordB' is an alternative to 'wordCompleteB'.

  'completeWordB' offers a slightly different interface. The user
  completes the word using the mini-buffer in the same way a user
  completes a buffer or file name when switching buffers or opening a
  file. This means that it never guesses and completes only as much as
  it can without guessing.

  I think there is room for both approaches. The 'wordCompleteB' approach
  which just guesses the completion from a list of possible completion
  and then re-hitting the key-binding will cause it to guess again.
  I think this is very nice for things such as completing a word within
  a TeX-buffer. However using the mini-buffer might be nicer when we allow
  syntax knowledge to allow completion for example we may complete from
  a Hoogle database.
-}
completeWordB :: CompletionScope -> EditorM ()
completeWordB :: CompletionScope -> EditorM ()
completeWordB = CompletionScope -> EditorM ()
veryQuickCompleteWord

data CompletionScope = FromCurrentBuffer | FromAllBuffers
  deriving (CompletionScope -> CompletionScope -> Bool
(CompletionScope -> CompletionScope -> Bool)
-> (CompletionScope -> CompletionScope -> Bool)
-> Eq CompletionScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionScope -> CompletionScope -> Bool
$c/= :: CompletionScope -> CompletionScope -> Bool
== :: CompletionScope -> CompletionScope -> Bool
$c== :: CompletionScope -> CompletionScope -> Bool
Eq, Int -> CompletionScope -> ShowS
[CompletionScope] -> ShowS
CompletionScope -> String
(Int -> CompletionScope -> ShowS)
-> (CompletionScope -> String)
-> ([CompletionScope] -> ShowS)
-> Show CompletionScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionScope] -> ShowS
$cshowList :: [CompletionScope] -> ShowS
show :: CompletionScope -> String
$cshow :: CompletionScope -> String
showsPrec :: Int -> CompletionScope -> ShowS
$cshowsPrec :: Int -> CompletionScope -> ShowS
Show)

{-
  This is a very quick and dirty way to complete the current word.
  It works in a similar way to the completion of words in the mini-buffer
  it uses the message buffer to give simple feedback such as,
  "Matches:" and "Complete, but not unique:"

  It is by no means perfect but it's also not bad, pretty usable.
-}
veryQuickCompleteWord :: CompletionScope -> EditorM ()
veryQuickCompleteWord :: CompletionScope -> EditorM ()
veryQuickCompleteWord CompletionScope
scope = do
  (Text
curWord, [Text]
curWords) <- BufferM (Text, [Text]) -> EditorM (Text, [Text])
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM (Text, [Text])
wordsAndCurrentWord
  [Text]
allWords <- ([[Text]] -> [Text]) -> EditorM [[Text]] -> EditorM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (EditorM [[Text]] -> EditorM [Text])
-> EditorM [[Text]] -> EditorM [Text]
forall a b. (a -> b) -> a -> b
$ BufferM [Text] -> EditorM [[Text]]
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m [a]
withEveryBuffer (BufferM [Text] -> EditorM [[Text]])
-> BufferM [Text] -> EditorM [[Text]]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
words' (Text -> [Text]) -> BufferM Text -> BufferM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (YiString -> Text
R.toText (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
elemsB)
  let match :: T.Text -> Maybe T.Text
      match :: Text -> Maybe Text
match Text
x = if (Text
curWord Text -> Text -> Bool
`T.isPrefixOf` Text
x) Bool -> Bool -> Bool
&& (Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
curWord)
                then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
                else Maybe Text
forall a. Maybe a
Nothing
      wordsToChooseFrom :: [Text]
wordsToChooseFrom = if CompletionScope
scope CompletionScope -> CompletionScope -> Bool
forall a. Eq a => a -> a -> Bool
== CompletionScope
FromCurrentBuffer
                          then [Text]
curWords
                          else [Text]
allWords
  Text
preText             <- Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInList Text
curWord Text -> Maybe Text
match [Text]
wordsToChooseFrom
  if Text -> Bool
T.null Text
curWord
    then Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg Text
"No word to complete"
    else BufferM () -> EditorM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> EditorM ())
-> (Text -> BufferM ()) -> Text -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
insertN (YiString -> BufferM ())
-> (Text -> YiString) -> Text -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> YiString
R.fromText (Text -> EditorM ()) -> Text -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
curWord) Text
preText

wordsAndCurrentWord :: BufferM (T.Text, [T.Text])
wordsAndCurrentWord :: BufferM (Text, [Text])
wordsAndCurrentWord =
  do Text
curText          <- YiString -> Text
R.toText (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
elemsB
     Text
curWord          <-
       (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> Text
R.toText (BufferM YiString -> BufferM Text)
-> BufferM YiString -> BufferM Text
forall a b. (a -> b) -> a -> b
$ Region -> BufferM YiString
readRegionB (Region -> BufferM YiString) -> BufferM Region -> BufferM YiString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
unitWord Direction
Backward
     (Text, [Text]) -> BufferM (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
curWord, Text -> [Text]
words' Text
curText)

wordsForCompletionInBuffer :: BufferM [T.Text]
wordsForCompletionInBuffer :: BufferM [Text]
wordsForCompletionInBuffer = do
  let readTextRegion :: Region -> BufferM Text
readTextRegion = (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap YiString -> Text
R.toText (BufferM YiString -> BufferM Text)
-> (Region -> BufferM YiString) -> Region -> BufferM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Region -> BufferM YiString
readRegionB
  Text
above <- Region -> BufferM Text
readTextRegion (Region -> BufferM Text) -> BufferM Region -> BufferM Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
Document Direction
Backward
  Text
below <- Region -> BufferM Text
readTextRegion (Region -> BufferM Text) -> BufferM Region -> BufferM Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextUnit -> Direction -> BufferM Region
regionOfPartB TextUnit
Document Direction
Forward
  [Text] -> BufferM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> BufferM [Text]) -> [Text] -> BufferM [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse (Text -> [Text]
words' Text
above) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text]
words' Text
below

wordsForCompletion :: EditorM [T.Text]
wordsForCompletion :: EditorM [Text]
wordsForCompletion = do
    BufferRef
_ :| [BufferRef]
bs <- (FBuffer -> BufferRef) -> NonEmpty FBuffer -> NonEmpty BufferRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FBuffer -> BufferRef
bkey (NonEmpty FBuffer -> NonEmpty BufferRef)
-> EditorM (NonEmpty FBuffer) -> EditorM (NonEmpty BufferRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditorM (NonEmpty FBuffer)
forall (m :: * -> *). MonadEditor m => m (NonEmpty FBuffer)
getBufferStack
    [Text]
w0 <- BufferM [Text] -> EditorM [Text]
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM [Text]
wordsForCompletionInBuffer
    [Text]
contents <- [BufferRef] -> (BufferRef -> EditorM Text) -> EditorM [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [BufferRef]
bs ((BufferRef -> EditorM Text) -> EditorM [Text])
-> (BufferRef -> EditorM Text) -> EditorM [Text]
forall a b. (a -> b) -> a -> b
$ \BufferRef
b -> BufferRef -> BufferM Text -> EditorM Text
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b (YiString -> Text
R.toText (YiString -> Text) -> BufferM YiString -> BufferM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM YiString
elemsB)
    [Text] -> EditorM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> EditorM [Text]) -> [Text] -> EditorM [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
w0 [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
words' [Text]
contents

words' :: T.Text -> [T.Text]
words' :: Text -> [Text]
words' = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (Text -> Maybe Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe Int
charClass (Char -> Maybe Int) -> (Text -> Char) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
T.head) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe Int -> Maybe Int -> Bool)
-> (Char -> Maybe Int) -> Char -> Char -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> Maybe Int
charClass)

charClass :: Char -> Maybe Int
charClass :: Char -> Maybe Int
charClass Char
c = ([GeneralCategory] -> Bool) -> [[GeneralCategory]] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> [GeneralCategory] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)
                [ [ GeneralCategory
UppercaseLetter, GeneralCategory
LowercaseLetter, GeneralCategory
TitlecaseLetter
                  , GeneralCategory
ModifierLetter, GeneralCategory
OtherLetter
                  , GeneralCategory
ConnectorPunctuation
                  , GeneralCategory
NonSpacingMark, GeneralCategory
SpacingCombiningMark, GeneralCategory
EnclosingMark
                  , GeneralCategory
DecimalNumber, GeneralCategory
LetterNumber, GeneralCategory
OtherNumber
                  ]
                , [ GeneralCategory
MathSymbol, GeneralCategory
CurrencySymbol, GeneralCategory
ModifierSymbol, GeneralCategory
OtherSymbol ]
                ]

{-
  Finally obviously we wish to have a much more sophisticated completeword.
  One which spawns a mini-buffer and allows searching in Hoogle databases
  or in other files etc.
-}