-- Copyright (c) 2004-5 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)

-- | Talk to Neil Mitchell's `Hoogle' program
module Lambdabot.Plugin.Haskell.Hoogle (hooglePlugin) where

import Lambdabot.Config.Haskell
import Lambdabot.Plugin
import Lambdabot.Util
import System.Process

hooglePlugin :: Module [String]
hooglePlugin :: Module [String]
hooglePlugin = forall st. Module st
newModule
    { moduleDefState :: LB [String]
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return []
    , moduleCmds :: ModuleT [String] LB [Command (ModuleT [String] LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"hoogle")
            { help :: Cmd (ModuleT [String] LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"hoogle <expr>. Haskell API Search for either names, or types."
            , process :: String -> Cmd (ModuleT [String] LB) ()
process = \String
s -> do
                String
binary <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config String
hoogleBinary
                [String]
o <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> String -> IO [String]
hoogle String
binary String
s)
                let ([String]
this,[String]
that) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
3 [String]
o
                forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS [String]
that
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). Monad m => String -> Cmd m ()
say [String]
this
            }
        , (String -> Command Identity
command String
"hoogle+")
            -- TODO: what does this really do?  give it a proper help msg
            { help :: Cmd (ModuleT [String] LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"hoogle <expr>. Haskell API Search for either names, or types."
            , process :: String -> Cmd (ModuleT [String] LB) ()
process = \String
_ -> do
                [String]
this <- forall (m :: * -> *) a.
MonadLBState m =>
(LBState m -> (LBState m -> m ()) -> m a) -> m a
withMS forall a b. (a -> b) -> a -> b
$ \LBState (Cmd (ModuleT [String] LB))
st LBState (Cmd (ModuleT [String] LB)) -> Cmd (ModuleT [String] LB) ()
write -> do
                    let ([String]
this,[String]
that) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
3 LBState (Cmd (ModuleT [String] LB))
st
                    LBState (Cmd (ModuleT [String] LB)) -> Cmd (ModuleT [String] LB) ()
write [String]
that
                    forall (m :: * -> *) a. Monad m => a -> m a
return [String]
this
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). Monad m => String -> Cmd m ()
say [String]
this
            }
        ]
    }

------------------------------------------------------------------------

-- arbitrary cutoff point
cutoff :: Int
cutoff :: Int
cutoff = -Int
10

-- | Actually run the hoogle binary
hoogle :: String -> String -> IO [String]
hoogle :: String -> String -> IO [String]
hoogle String
binary String
s = do
        let args :: [String]
args = [String
"--count=20", String
s]
        (ExitCode
_,String
out,String
err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
binary [String]
args String
""
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
result String
out String
err

    where result :: String -> String -> [String]
result [] [] = [String
"A Hoogle error occurred."]
          result [] String
ys = [String
ys]
          result String
xs String
_  =
                let xs' :: [(Int, String)]
xs' = forall a b. (a -> b) -> [a] -> [b]
map String -> (Int, String)
toPair forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
xs
                    res :: [String]
res = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>=Int
cutoff) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Int, String)]
xs'
                in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
res
                   then [String
"No matches, try a more general search"]
                   else [String]
res

          toPair :: String -> (Int, String)
toPair String
s' = let (String
res, String
meta)  = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
'@') String
s'
                          rank :: String
rank = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
' ') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall a b. (a -> b) -> a -> b
$ String
meta
                      in case forall (m :: * -> *) a. (MonadFail m, Read a) => String -> m a
readM String
rank :: Maybe Int of
                         Just Int
n  -> (Int
n,String
res)
                         Maybe Int
Nothing -> (Int
0,String
res)