-- | High level Hoogle API
module Hoogle(
    Database, withDatabase, searchDatabase, defaultDatabaseLocation,
    Target(..), URL,
    hoogle,
    targetInfo,
    targetResultDisplay
    ) where

import Control.DeepSeq (NFData)

import Query
import Input.Item
import General.Util
import General.Store

import Action.CmdLine
import Action.Generate
import Action.Search
import Action.Server
import Action.Test


-- | Database containing Hoogle search data.
newtype Database = Database StoreRead

-- | Load a database from a file.
withDatabase :: NFData a => FilePath -> (Database -> IO a) -> IO a
withDatabase :: FilePath -> (Database -> IO a) -> IO a
withDatabase FilePath
file Database -> IO a
act = FilePath -> (StoreRead -> IO a) -> IO a
forall a. NFData a => FilePath -> (StoreRead -> IO a) -> IO a
storeReadFile FilePath
file ((StoreRead -> IO a) -> IO a) -> (StoreRead -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Database -> IO a
act (Database -> IO a) -> (StoreRead -> Database) -> StoreRead -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreRead -> Database
Database

-- | The default location of a database
defaultDatabaseLocation :: IO FilePath
defaultDatabaseLocation :: IO FilePath
defaultDatabaseLocation = Language -> IO FilePath
defaultDatabaseLang Language
Haskell

-- | Search a database, given a query string, produces a list of results.
searchDatabase :: Database -> String -> [Target]
searchDatabase :: Database -> FilePath -> [Target]
searchDatabase (Database StoreRead
db) FilePath
query = ([Query], [Target]) -> [Target]
forall a b. (a, b) -> b
snd (([Query], [Target]) -> [Target])
-> ([Query], [Target]) -> [Target]
forall a b. (a -> b) -> a -> b
$ StoreRead -> [Query] -> ([Query], [Target])
search StoreRead
db ([Query] -> ([Query], [Target])) -> [Query] -> ([Query], [Target])
forall a b. (a -> b) -> a -> b
$ FilePath -> [Query]
parseQuery FilePath
query


-- | Run a command line Hoogle operation.
hoogle :: [String] -> IO ()
hoogle :: [FilePath] -> IO ()
hoogle [FilePath]
args = do
    CmdLine
args <- [FilePath] -> IO CmdLine
getCmdLine [FilePath]
args
    case CmdLine
args of
        Search{} -> CmdLine -> IO ()
actionSearch CmdLine
args
        Generate{} -> CmdLine -> IO ()
actionGenerate CmdLine
args
        Server{} -> CmdLine -> IO ()
actionServer CmdLine
args
        Test{} -> CmdLine -> IO ()
actionTest CmdLine
args
        Replay{} -> CmdLine -> IO ()
actionReplay CmdLine
args