{-# 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