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

    -- |
    -- Module      :  Yi.Hoogle
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Provides functions for calling Hoogle on the commandline, and
    -- processing results into a form useful for completion or insertion.

    module Yi.Hoogle where

    import           Control.Arrow       ((&&&))
    import           Data.Char           (isUpper)
    import           Data.List           (nub)
    import qualified Data.Text           as T (isInfixOf, lines, unpack)
    import           System.Exit         (ExitCode (ExitFailure))
    import           Yi.Buffer           (readRegionB, regionOfB, replaceRegionB, unitWord)
    import           Yi.Editor           (printMsgs, withCurrentBuffer)
    import           Yi.Keymap           (YiM)
    import           Yi.Process          (runProgCommand)
    import qualified Yi.Rope             as R (YiString, fromText, head, null, toString, toText, words)
    import           Yi.String           (showT)
    import           Yi.Utils            (io)

    -- | Remove anything starting with uppercase letter. These denote
    -- either module names or types.
    caseSensitize :: [R.YiString] -> [R.YiString]
    caseSensitize :: [YiString] -> [YiString]
    caseSensitize = (YiString -> Bool) -> [YiString] -> [YiString]
    forall a. (a -> Bool) -> [a] -> [a]
    filter YiString -> Bool
    p
      where
        p :: R.YiString -> Bool
        p :: YiString -> Bool
    p YiString
    t = case YiString -> Maybe Char
    R.head YiString
    t of
          Maybe Char
    Nothing -> Bool
    False
          Just Char
    c  -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Char -> Bool
    isUpper Char
    c

    -- | Hoogle's output includes a sort of type keyword, telling whether
    -- a hit is a package name, syntax, a module name, etc. But we care
    -- primarily about the function names, so we filter out anything
    -- containing the keywords.
    gv :: [R.YiString] -> [R.YiString]
    gv :: [YiString] -> [YiString]
    gv = (YiString -> Bool) -> [YiString] -> [YiString]
    forall a. (a -> Bool) -> [a] -> [a]
    filter YiString -> Bool
    f
      where
        ks :: [Text]
    ks = [Text
    "module ", Text
    " type ", Text
    "package ", Text
    " data ", Text
    " keyword "]
        f :: YiString -> Bool
    f YiString
    x = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Text -> Text -> Bool
    `T.isInfixOf` YiString -> Text
    R.toText YiString
    x) [Text]
    ks

    -- | Query Hoogle, with given search and options. This errors out on no
    -- results or if the hoogle command is not on path.
    hoogleRaw :: R.YiString -> R.YiString -> IO [R.YiString]
    hoogleRaw :: YiString -> YiString -> IO [YiString]
    hoogleRaw YiString
    srch YiString
    opts = do
      let options :: [YiString]
    options = (YiString -> Bool) -> [YiString] -> [YiString]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (YiString -> Bool) -> YiString -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . YiString -> Bool
    R.null) [YiString
    opts, YiString
    srch]
      outp@(_status, out, _err) <- [Char] -> [[Char]] -> IO (ExitCode, Text, Text)
    forall a c.
    ListLikeProcessIO a c =>
    [Char] -> [[Char]] -> IO (ExitCode, a, a)
    runProgCommand [Char]
    "hoogle" (YiString -> [Char]
    R.toString (YiString -> [Char]) -> [YiString] -> [[Char]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [YiString]
    options)
      case outp of
        (ExitFailure Int
    1, Text
    "", Text
    "") -> -- no output, probably failed to run binary
          [Char] -> IO ()
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail [Char]
    "Error running hoogle command.  Is hoogle on path?"
        (ExitFailure Int
    1, Text
    xs, Text
    _) -> [Char] -> IO ()
    forall a. [Char] -> IO a
    forall (m :: * -> *) a. MonadFail m => [Char] -> m a
    fail ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "hoogle failed with: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    T.unpack Text
    xs
        (ExitCode, Text, Text)
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      -- TODO: bench ‘R.fromText . T.lines’ vs ‘R.lines . R.fromText’
      let results = (Text -> YiString) -> [Text] -> [YiString]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> YiString
    R.fromText ([Text] -> [YiString]) -> (Text -> [Text]) -> Text -> [YiString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Text]
    T.lines (Text -> [YiString]) -> Text -> [YiString]
    forall a b. (a -> b) -> a -> b
    $ Text
    out
      if results == ["No results found"]
        then fail "No Hoogle results"
        else return results

    -- | Filter the output of 'hoogleRaw' to leave just functions.
    hoogleFunctions :: R.YiString -> IO [R.YiString]
    hoogleFunctions :: YiString -> IO [YiString]
    hoogleFunctions YiString
    a =
      [YiString] -> [YiString]
    caseSensitize ([YiString] -> [YiString])
    -> ([YiString] -> [YiString]) -> [YiString] -> [YiString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [YiString] -> [YiString]
    gv ([YiString] -> [YiString])
    -> ([YiString] -> [YiString]) -> [YiString] -> [YiString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [YiString] -> [YiString]
    forall a. Eq a => [a] -> [a]
    nub ([YiString] -> [YiString])
    -> ([YiString] -> [YiString]) -> [YiString] -> [YiString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (YiString -> YiString) -> [YiString] -> [YiString]
    forall a b. (a -> b) -> [a] -> [b]
    map (([YiString] -> Int -> YiString
    forall a. HasCallStack => [a] -> Int -> a
    !!Int
    1) ([YiString] -> YiString)
    -> (YiString -> [YiString]) -> YiString -> YiString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . YiString -> [YiString]
    R.words) ([YiString] -> [YiString]) -> IO [YiString] -> IO [YiString]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> YiString -> YiString -> IO [YiString]
    hoogleRaw YiString
    a YiString
    ""

    -- | Return module-function pairs.
    hoogleFunModule :: R.YiString -> IO [(R.YiString, R.YiString)]
    hoogleFunModule :: YiString -> IO [(YiString, YiString)]
    hoogleFunModule YiString
    a = (YiString -> (YiString, YiString))
    -> [YiString] -> [(YiString, YiString)]
    forall a b. (a -> b) -> [a] -> [b]
    map (([YiString] -> YiString
    forall a. HasCallStack => [a] -> a
    head ([YiString] -> YiString)
    -> ([YiString] -> YiString) -> [YiString] -> (YiString, YiString)
    forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& ([YiString] -> Int -> YiString
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    1)) ([YiString] -> (YiString, YiString))
    -> (YiString -> [YiString]) -> YiString -> (YiString, YiString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . YiString -> [YiString]
    R.words) ([YiString] -> [(YiString, YiString)])
    -> ([YiString] -> [YiString])
    -> [YiString]
    -> [(YiString, YiString)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [YiString] -> [YiString]
    gv ([YiString] -> [(YiString, YiString)])
    -> IO [YiString] -> IO [(YiString, YiString)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> YiString -> YiString -> IO [YiString]
    hoogleRaw YiString
    a YiString
    ""

    -- | Call out to 'hoogleFunModule', and overwrite the word at point with
    -- the first returned function.
    hoogle :: YiM R.YiString
    hoogle :: YiM YiString
    hoogle = do
        (wordRegion,word) <- BufferM (Region, YiString) -> YiM (Region, YiString)
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM (Region, YiString) -> YiM (Region, YiString))
    -> BufferM (Region, YiString) -> YiM (Region, YiString)
    forall a b. (a -> b) -> a -> b
    $ do
          wordRegion <- TextUnit -> BufferM Region
    regionOfB TextUnit
    unitWord
          word <- readRegionB wordRegion
          return (wordRegion, word)
        ((modl,fun):_) <- io $ hoogleFunModule word

        withCurrentBuffer $ replaceRegionB wordRegion fun
        return modl

    -- | Call out to 'hoogleRaw', and print inside the Minibuffer the results of
    -- searching Hoogle with the word at point.
    hoogleSearch :: YiM ()
    hoogleSearch :: YiM ()
    hoogleSearch = do
      word <- BufferM YiString -> YiM YiString
    forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
    withCurrentBuffer (BufferM YiString -> YiM YiString)
    -> BufferM YiString -> YiM YiString
    forall a b. (a -> b) -> a -> b
    $ do
        wordRegion <- TextUnit -> BufferM Region
    regionOfB TextUnit
    unitWord
        readRegionB wordRegion
      results <- io $ hoogleRaw word ""

      -- The quotes help legibility between closely-packed results
      printMsgs $ map showT results