    -- 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 = Module [String]
    forall st. Module st
    newModule
        { moduleDefState = return []
        , moduleCmds = return
            [ (command "hoogle")
                { help = say "hoogle <expr>. Haskell API Search for either names, or types."
                , process = \String
    s -> do
                    binary <- Config String -> Cmd (ModuleT [String] LB) String
    forall a. Config a -> Cmd (ModuleT [String] LB) a
    forall (m :: * -> *) a. MonadConfig m => Config a -> m a
    getConfig Config String
    hoogleBinary
                    o <- io (hoogle binary s)
                    let (this,that) = splitAt 3 o
                    writeMS that
                    mapM_ say this
                }
            , (command "hoogle+")
                -- TODO: what does this really do?  give it a proper help msg
                { help = say "hoogle <expr>. Haskell API Search for either names, or types."
                , process = \String
    _ -> do
                    this <- (LBState (Cmd (ModuleT [String] LB))
     -> (LBState (Cmd (ModuleT [String] LB))
         -> Cmd (ModuleT [String] LB) ())
     -> Cmd (ModuleT [String] LB) [String])
    -> Cmd (ModuleT [String] LB) [String]
    forall a.
    (LBState (Cmd (ModuleT [String] LB))
     -> (LBState (Cmd (ModuleT [String] LB))
         -> Cmd (ModuleT [String] LB) ())
     -> Cmd (ModuleT [String] LB) a)
    -> Cmd (ModuleT [String] LB) a
    forall (m :: * -> *) a.
    MonadLBState m =>
    (LBState m -> (LBState m -> m ()) -> m a) -> m a
    withMS ((LBState (Cmd (ModuleT [String] LB))
      -> (LBState (Cmd (ModuleT [String] LB))
          -> Cmd (ModuleT [String] LB) ())
      -> Cmd (ModuleT [String] LB) [String])
     -> Cmd (ModuleT [String] LB) [String])
    -> (LBState (Cmd (ModuleT [String] LB))
        -> (LBState (Cmd (ModuleT [String] LB))
            -> Cmd (ModuleT [String] LB) ())
        -> Cmd (ModuleT [String] LB) [String])
    -> Cmd (ModuleT [String] LB) [String]
    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) = Int -> [String] -> ([String], [String])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    3 [String]
    LBState (Cmd (ModuleT [String] LB))
    st
                        LBState (Cmd (ModuleT [String] LB)) -> Cmd (ModuleT [String] LB) ()
    write [String]
    LBState (Cmd (ModuleT [String] LB))
    that
                        [String] -> Cmd (ModuleT [String] LB) [String]
    forall a. a -> Cmd (ModuleT [String] LB) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String]
    this
                    mapM_ say 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]
            (_,out,err) <- String -> [String] -> String -> IO (ExitCode, String, String)
    readProcessWithExitCode String
    binary [String]
    args String
    ""
            return $ result out 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' = (String -> (Int, String)) -> [String] -> [(Int, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> (Int, String)
    toPair ([String] -> [(Int, String)]) -> [String] -> [(Int, String)]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    xs
                        res :: [String]
    res = ((Int, String) -> String) -> [(Int, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, String) -> String
    forall a b. (a, b) -> b
    snd ([(Int, String)] -> [String]) -> [(Int, String)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ ((Int, String) -> Bool) -> [(Int, String)] -> [(Int, String)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >=Int
    cutoff) (Int -> Bool) -> ((Int, String) -> Int) -> (Int, String) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, String) -> Int
    forall a b. (a, b) -> a
    fst) [(Int, String)]
    xs'
                    in if [String] -> Bool
    forall a. [a] -> Bool
    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)  = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '@') String
    s'
                              rank :: String
    rank = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    ' ') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    2 (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String
    meta
                          in case String -> Maybe Int
    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)