    {- |
    Module      :  XMonad.Prompt.Unicode
    Description :  A prompt for inputting Unicode characters.
    Copyright   :  (c) 2016 Joachim Breitner
                       2017 Nick Hu
    License     :  BSD-style (see LICENSE)

    Maintainer  :  <mail@joachim-breitner.de>
    Stability   :  stable

    A prompt for searching unicode characters by name and inserting them into
    the clipboard.

    The provided @unicodePrompt@ and @typeUnicodePrompt@ use @xsel@ and @xdotool@
    respectively.
    -}

    module XMonad.Prompt.Unicode (
     -- * Usage
     -- $usage
     unicodePrompt,
     typeUnicodePrompt,
     mkUnicodePrompt
     ) where

    import Codec.Binary.UTF8.String (decodeString)
    import qualified Data.ByteString.Char8 as BS
    import Numeric
    import System.IO
    import System.IO.Error
    import Text.Printf

    import XMonad
    import XMonad.Prelude
    import qualified XMonad.Util.ExtensibleState as XS
    import XMonad.Util.Run
    import XMonad.Prompt

    data Unicode = Unicode
    instance XPrompt Unicode where
      showXPrompt :: Unicode -> [Char]
    showXPrompt Unicode
    Unicode = [Char]
    "Unicode: "
      commandToComplete :: Unicode -> [Char] -> [Char]
    commandToComplete Unicode
    Unicode [Char]
    s = [Char]
    s
      nextCompletion :: Unicode -> [Char] -> [[Char]] -> [Char]
    nextCompletion Unicode
    Unicode = [Char] -> [[Char]] -> [Char]
    getNextCompletion

    newtype UnicodeData = UnicodeData { UnicodeData -> [(Char, [Char])]
    getUnicodeData :: [(Char, String)] }
      deriving (ReadPrec [UnicodeData]
    ReadPrec UnicodeData
    Int -> ReadS UnicodeData
    ReadS [UnicodeData]
    (Int -> ReadS UnicodeData)
    -> ReadS [UnicodeData]
    -> ReadPrec UnicodeData
    -> ReadPrec [UnicodeData]
    -> Read UnicodeData
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS UnicodeData
    readsPrec :: Int -> ReadS UnicodeData
    $creadList :: ReadS [UnicodeData]
    readList :: ReadS [UnicodeData]
    $creadPrec :: ReadPrec UnicodeData
    readPrec :: ReadPrec UnicodeData
    $creadListPrec :: ReadPrec [UnicodeData]
    readListPrec :: ReadPrec [UnicodeData]
    Read, Int -> UnicodeData -> [Char] -> [Char]
    [UnicodeData] -> [Char] -> [Char]
    UnicodeData -> [Char]
    (Int -> UnicodeData -> [Char] -> [Char])
    -> (UnicodeData -> [Char])
    -> ([UnicodeData] -> [Char] -> [Char])
    -> Show UnicodeData
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> UnicodeData -> [Char] -> [Char]
    showsPrec :: Int -> UnicodeData -> [Char] -> [Char]
    $cshow :: UnicodeData -> [Char]
    show :: UnicodeData -> [Char]
    $cshowList :: [UnicodeData] -> [Char] -> [Char]
    showList :: [UnicodeData] -> [Char] -> [Char]
    Show)

    instance ExtensionClass UnicodeData where
      initialValue :: UnicodeData
    initialValue = [(Char, [Char])] -> UnicodeData
    UnicodeData []
      extensionType :: UnicodeData -> StateExtension
    extensionType = UnicodeData -> StateExtension
    forall a. ExtensionClass a => a -> StateExtension
    StateExtension

    {- $usage

    You can use this module by importing it, along with
    "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file:

    > import XMonad.Prompt
    > import XMonad.Prompt.Unicode

    and adding an appropriate keybinding, for example:

    >  , ((modm .|. controlMask, xK_u), unicodePrompt "/path/to/unicode-data" def)

    More flexibility is given by the @mkUnicodePrompt@ function, which takes a
    command and a list of arguments to pass as its first two arguments. See
    @unicodePrompt@ for details.
    -}

    populateEntries :: String -> X Bool
    populateEntries :: [Char] -> X Bool
    populateEntries [Char]
    unicodeDataFilename = do
      [(Char, [Char])]
    entries <- (UnicodeData -> [(Char, [Char])])
    -> X UnicodeData -> X [(Char, [Char])]
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UnicodeData -> [(Char, [Char])]
    getUnicodeData (X UnicodeData
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get :: X UnicodeData)
      if [(Char, [Char])] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(Char, [Char])]
    entries
        then do
          Either IOError ByteString
    datE <- IO (Either IOError ByteString) -> X (Either IOError ByteString)
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either IOError ByteString) -> X (Either IOError ByteString))
    -> (IO ByteString -> IO (Either IOError ByteString))
    -> IO ByteString
    -> X (Either IOError ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO ByteString -> IO (Either IOError ByteString)
    forall a. IO a -> IO (Either IOError a)
    tryIOError (IO ByteString -> X (Either IOError ByteString))
    -> IO ByteString -> X (Either IOError ByteString)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ByteString
    BS.readFile [Char]
    unicodeDataFilename
          case Either IOError ByteString
    datE of
            Left IOError
    e -> IO Bool -> X Bool
    forall a. IO a -> X a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> X Bool) -> IO Bool -> X Bool
    forall a b. (a -> b) -> a -> b
    $ do
              Handle -> [Char] -> IO ()
    hPutStrLn Handle
    stderr ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Could not read file \"" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    unicodeDataFilename [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\""
              Handle -> IOError -> IO ()
    forall a. Show a => Handle -> a -> IO ()
    hPrint Handle
    stderr IOError
    e
              Handle -> [Char] -> IO ()
    hPutStrLn Handle
    stderr [Char]
    "Do you have unicode-data installed?"
              Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            Right ByteString
    dat -> do
              UnicodeData -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (UnicodeData -> X ())
    -> ([(Char, [Char])] -> UnicodeData) -> [(Char, [Char])] -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Char, [Char])] -> UnicodeData
    UnicodeData ([(Char, [Char])] -> UnicodeData)
    -> ([(Char, [Char])] -> [(Char, [Char])])
    -> [(Char, [Char])]
    -> UnicodeData
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Char, [Char]) -> Int) -> [(Char, [Char])] -> [(Char, [Char])]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn ([Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Char] -> Int)
    -> ((Char, [Char]) -> [Char]) -> (Char, [Char]) -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char, [Char]) -> [Char]
    forall a b. (a, b) -> b
    snd) ([(Char, [Char])] -> X ()) -> [(Char, [Char])] -> X ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [(Char, [Char])]
    parseUnicodeData ByteString
    dat
              Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
        else Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    parseUnicodeData :: BS.ByteString -> [(Char, String)]
    parseUnicodeData :: ByteString -> [(Char, [Char])]
    parseUnicodeData = (ByteString -> Maybe (Char, [Char]))
    -> [ByteString] -> [(Char, [Char])]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ByteString -> Maybe (Char, [Char])
    forall {m :: * -> *}. MonadFail m => ByteString -> m (Char, [Char])
    parseLine ([ByteString] -> [(Char, [Char])])
    -> (ByteString -> [ByteString]) -> ByteString -> [(Char, [Char])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    BS.lines
      where parseLine :: ByteString -> m (Char, [Char])
    parseLine ByteString
    l = do
              ByteString
    field1 : ByteString
    field2 : [ByteString]
    _ <- [ByteString] -> m [ByteString]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
    forall a b. (a -> b) -> a -> b
    $ Char -> ByteString -> [ByteString]
    BS.split Char
    ';' ByteString
    l
              [(Int
    c,[Char]
    "")] <- [(Int, [Char])] -> m [(Int, [Char])]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Int, [Char])] -> m [(Int, [Char])])
    -> ([Char] -> [(Int, [Char])]) -> [Char] -> m [(Int, [Char])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [(Int, [Char])]
    forall a. (Eq a, Num a) => ReadS a
    readHex ([Char] -> m [(Int, [Char])]) -> [Char] -> m [(Int, [Char])]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Char]
    BS.unpack ByteString
    field1
              [Char]
    desc <- [Char] -> m [Char]
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> m [Char]) -> ([Char] -> [Char]) -> [Char] -> m [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    decodeString ([Char] -> m [Char]) -> [Char] -> m [Char]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Char]
    BS.unpack ByteString
    field2
              (Char, [Char]) -> m (Char, [Char])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> Char
    chr Int
    c, [Char]
    desc)

    type Predicate = String -> String -> Bool

    searchUnicode :: [(Char, String)] -> Predicate -> String -> [(Char, String)]
    searchUnicode :: [(Char, [Char])] -> Predicate -> [Char] -> [(Char, [Char])]
    searchUnicode [(Char, [Char])]
    entries Predicate
    p [Char]
    s = ((Char, [Char]) -> Bool) -> [(Char, [Char])] -> [(Char, [Char])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char, [Char]) -> Bool
    forall {a}. (a, [Char]) -> Bool
    go [(Char, [Char])]
    entries
      where w :: [[Char]]
    w = ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1) (Int -> Bool) -> ([Char] -> Int) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length) ([[Char]] -> [[Char]])
    -> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [[Char]]
    words ([Char] -> [[Char]]) -> [Char] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper [Char]
    s
            go :: (a, [Char]) -> Bool
    go (a
    _, [Char]
    d) = ([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Predicate
    `p` [Char]
    d) [[Char]]
    w

    mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()
    mkUnicodePrompt :: [Char] -> [[Char]] -> [Char] -> XPConfig -> X ()
    mkUnicodePrompt [Char]
    prog [[Char]]
    args [Char]
    unicodeDataFilename XPConfig
    xpCfg =
      X Bool -> X () -> X ()
    whenX ([Char] -> X Bool
    populateEntries [Char]
    unicodeDataFilename) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        [(Char, [Char])]
    entries <- (UnicodeData -> [(Char, [Char])])
    -> X UnicodeData -> X [(Char, [Char])]
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap UnicodeData -> [(Char, [Char])]
    getUnicodeData (X UnicodeData
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get :: X UnicodeData)
        Unicode -> XPConfig -> ComplFunction -> ([Char] -> X ()) -> X ()
    forall p.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> ([Char] -> X ()) -> X ()
    mkXPrompt
          Unicode
    Unicode
          (XPConfig
    xpCfg {sorter :: [Char] -> [[Char]] -> [[Char]]
    sorter = XPConfig -> [Char] -> [[Char]] -> [[Char]]
    sorter XPConfig
    xpCfg ([Char] -> [[Char]] -> [[Char]])
    -> ([Char] -> [Char]) -> [Char] -> [[Char]] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toUpper})
          ([(Char, [Char])] -> Predicate -> ComplFunction
    unicodeCompl [(Char, [Char])]
    entries (Predicate -> ComplFunction) -> Predicate -> ComplFunction
    forall a b. (a -> b) -> a -> b
    $ XPConfig -> Predicate
    searchPredicate XPConfig
    xpCfg)
          [Char] -> X ()
    forall {m :: * -> *}. MonadIO m => [Char] -> m ()
    paste
      where
        unicodeCompl :: [(Char, String)] -> Predicate -> String -> IO [String]
        unicodeCompl :: [(Char, [Char])] -> Predicate -> ComplFunction
    unicodeCompl [(Char, [Char])]
    _ Predicate
    _ [Char]
    "" = [[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        unicodeCompl [(Char, [Char])]
    entries Predicate
    p [Char]
    s = do
          let m :: [(Char, [Char])]
    m = [(Char, [Char])] -> Predicate -> [Char] -> [(Char, [Char])]
    searchUnicode [(Char, [Char])]
    entries Predicate
    p [Char]
    s
          [[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([[Char]] -> IO [[Char]])
    -> ([(Char, [Char])] -> [[Char]])
    -> [(Char, [Char])]
    -> IO [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Char, [Char]) -> [Char]) -> [(Char, [Char])] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Char
    c,[Char]
    d) -> [Char] -> [Char] -> [Char] -> [Char]
    forall r. PrintfType r => [Char] -> r
    printf [Char]
    "%s %s" [Char
    c] [Char]
    d) ([(Char, [Char])] -> IO [[Char]])
    -> [(Char, [Char])] -> IO [[Char]]
    forall a b. (a -> b) -> a -> b
    $ Int -> [(Char, [Char])] -> [(Char, [Char])]
    forall a. Int -> [a] -> [a]
    take Int
    20 [(Char, [Char])]
    m
        paste :: [Char] -> m ()
    paste [] = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        paste (Char
    c:[Char]
    _) = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
          Handle
    handle <- [Char] -> IO Handle
    forall (m :: * -> *). MonadIO m => [Char] -> m Handle
    spawnPipe ([Char] -> IO Handle) -> [Char] -> IO Handle
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    prog [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [[Char]]
    args
          Handle -> Char -> IO ()
    hPutChar Handle
    handle Char
    c
          Handle -> IO ()
    hClose Handle
    handle
          () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Prompt the user for a Unicode character to be inserted into the paste buffer of the X server.
    unicodePrompt :: String -> XPConfig -> X ()
    unicodePrompt :: [Char] -> XPConfig -> X ()
    unicodePrompt = [Char] -> [[Char]] -> [Char] -> XPConfig -> X ()
    mkUnicodePrompt [Char]
    "xsel" [[Char]
    "-i"]

    -- | Prompt the user for a Unicode character to be typed by @xdotool@.
    typeUnicodePrompt :: String -> XPConfig -> X ()
    typeUnicodePrompt :: [Char] -> XPConfig -> X ()
    typeUnicodePrompt = [Char] -> [[Char]] -> [Char] -> XPConfig -> X ()
    mkUnicodePrompt [Char]
    "xdotool" [[Char]
    "type", [Char]
    "--clearmodifiers", [Char]
    "--file", [Char]
    "-"]