{-# 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 :: (ExitCode, Text, Text)
outp@(ExitCode
_status, Text
out, Text
_err) <- String -> [String] -> IO (ExitCode, Text, Text)
forall a c.
ListLikeProcessIO a c =>
String -> [String] -> IO (ExitCode, a, a)
runProgCommand String
"hoogle" (YiString -> String
R.toString (YiString -> String) -> [YiString] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [YiString]
options)
  case (ExitCode, Text, Text)
outp of
    (ExitFailure Int
1, Text
"", Text
"") -> -- no output, probably failed to run binary
      String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Error running hoogle command.  Is hoogle on path?"
    (ExitFailure Int
1, Text
xs, Text
_) -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"hoogle failed with: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
xs
    (ExitCode, Text, Text)
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- TODO: bench ‘R.fromText . T.lines’ vs ‘R.lines . R.fromText’
  let results :: [YiString]
results = (Text -> YiString) -> [Text] -> [YiString]
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 [YiString]
results [YiString] -> [YiString] -> Bool
forall a. Eq a => a -> a -> Bool
== [YiString
"No results found"]
    then String -> IO [YiString]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No Hoogle results"
    else [YiString] -> IO [YiString]
forall (m :: * -> *) a. Monad m => a -> m a
return [YiString]
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. [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. [a] -> a
head ([YiString] -> YiString)
-> ([YiString] -> YiString) -> [YiString] -> (YiString, YiString)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ([YiString] -> Int -> YiString
forall a. [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
    (Region
wordRegion,YiString
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
      Region
wordRegion <- TextUnit -> BufferM Region
regionOfB TextUnit
unitWord
      YiString
word <- Region -> BufferM YiString
readRegionB Region
wordRegion
      (Region, YiString) -> BufferM (Region, YiString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Region
wordRegion, YiString
word)
    ((YiString
modl,YiString
fun):[(YiString, YiString)]
_) <- IO [(YiString, YiString)] -> YiM [(YiString, YiString)]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [(YiString, YiString)] -> YiM [(YiString, YiString)])
-> IO [(YiString, YiString)] -> YiM [(YiString, YiString)]
forall a b. (a -> b) -> a -> b
$ YiString -> IO [(YiString, YiString)]
hoogleFunModule YiString
word

    BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Region -> YiString -> BufferM ()
replaceRegionB Region
wordRegion YiString
fun
    YiString -> YiM YiString
forall (m :: * -> *) a. Monad m => a -> m a
return YiString
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
  YiString
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
    Region
wordRegion <- TextUnit -> BufferM Region
regionOfB TextUnit
unitWord
    Region -> BufferM YiString
readRegionB Region
wordRegion
  [YiString]
results <- IO [YiString] -> YiM [YiString]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [YiString] -> YiM [YiString])
-> IO [YiString] -> YiM [YiString]
forall a b. (a -> b) -> a -> b
$ YiString -> YiString -> IO [YiString]
hoogleRaw YiString
word YiString
""

  -- The quotes help legibility between closely-packed results
  [Text] -> YiM ()
forall (m :: * -> *). MonadEditor m => [Text] -> m ()
printMsgs ([Text] -> YiM ()) -> [Text] -> YiM ()
forall a b. (a -> b) -> a -> b
$ (YiString -> Text) -> [YiString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map YiString -> Text
forall a. Show a => a -> Text
showT [YiString]
results