{-# LANGUAGE LambdaCase, MultiWayIf, RecordWildCards, ScopedTypeVariables,
             TupleSections #-}

module Action.Search
    (actionSearch, withSearch, search
    ,targetInfo
    ,targetResultDisplay
    ,action_search_test
    ) where

import Control.DeepSeq
import Control.Exception.Extra
import Control.Monad.Extra
import qualified Data.Aeson as JSON
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Functor.Identity
import Data.List.Extra
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Set as Set
import System.Directory
import Text.Blaze.Renderer.Utf8
import Safe

import Action.CmdLine
import General.Store
import General.Util
import Input.Item
import Output.Items
import Output.Names
import Output.Tags
import Output.Types
import Query

-- -- generate all
-- @tagsoup -- generate tagsoup
-- @tagsoup filter -- search the tagsoup package
-- filter -- search all

actionSearch :: CmdLine -> IO ()
actionSearch :: CmdLine -> IO ()
actionSearch Search{Bool
Int
String
[String]
Maybe Bool
Maybe Int
Language
color :: Maybe Bool
json :: Bool
jsonl :: Bool
link :: Bool
numbers :: Bool
info :: Bool
database :: String
count :: Maybe Int
query :: [String]
repeat_ :: Int
language :: Language
compare_ :: [String]
color :: CmdLine -> Maybe Bool
json :: CmdLine -> Bool
jsonl :: CmdLine -> Bool
link :: CmdLine -> Bool
numbers :: CmdLine -> Bool
info :: CmdLine -> Bool
database :: CmdLine -> String
count :: CmdLine -> Maybe Int
query :: CmdLine -> [String]
repeat_ :: CmdLine -> Int
language :: CmdLine -> Language
compare_ :: CmdLine -> [String]
..} = Int -> IO () -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
repeat_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ -- deliberately reopen the database each time
    String -> (StoreRead -> IO ()) -> IO ()
forall a. NFData a => String -> (StoreRead -> IO a) -> IO a
withSearch String
database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \StoreRead
store ->
        if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
compare_ then do
            Int
count' <- Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
10 Maybe Int
count
            ([Query]
q, [Target]
res) <- ([Query], [Target]) -> IO ([Query], [Target])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Query], [Target]) -> IO ([Query], [Target]))
-> ([Query], [Target]) -> IO ([Query], [Target])
forall a b. (a -> b) -> a -> b
$ StoreRead -> [Query] -> ([Query], [Target])
search StoreRead
store ([Query] -> ([Query], [Target])) -> [Query] -> ([Query], [Target])
forall a b. (a -> b) -> a -> b
$ String -> [Query]
parseQuery (String -> [Query]) -> String -> [Query]
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
query
            IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Query: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
unescapeHTML (ByteString -> String
LBS.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Markup -> ByteString
renderMarkup (Markup -> ByteString) -> Markup -> ByteString
forall a b. (a -> b) -> a -> b
$ [Query] -> Markup
renderQuery [Query]
q)
            let ([String]
shown, [String]
hidden) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
count' ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Target -> String) -> [Target] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Target -> String
targetResultDisplay Bool
link) [Target]
res
            if [Target] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Target]
res then
                String -> IO ()
putStrLn String
"No results found"
             else if Bool
info then do
                 String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Target -> String
targetInfo (Target -> String) -> Target -> String
forall a b. (a -> b) -> a -> b
$ [Target] -> Target
forall a. [a] -> a
headErr [Target]
res
             else do
                let toShow :: [String]
toShow = if Bool
numbers Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
info then [String] -> [String]
addCounter [String]
shown else [String]
shown
                if | Bool
json -> ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [Target] -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode ([Target] -> ByteString) -> [Target] -> ByteString
forall a b. (a -> b) -> a -> b
$ ([Target] -> [Target])
-> (Int -> [Target] -> [Target])
-> Maybe Int
-> [Target]
-> [Target]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Target] -> [Target]
forall a. a -> a
id Int -> [Target] -> [Target]
forall a. Int -> [a] -> [a]
take Maybe Int
count ([Target] -> [Target]) -> [Target] -> [Target]
forall a b. (a -> b) -> a -> b
$ (Target -> Target) -> [Target] -> [Target]
forall a b. (a -> b) -> [a] -> [b]
map Target -> Target
unHTMLtargetItem [Target]
res
                   | Bool
jsonl -> (Target -> IO ()) -> [Target] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ByteString -> IO ()
LBS.putStrLn (ByteString -> IO ()) -> (Target -> ByteString) -> Target -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode) ([Target] -> IO ()) -> [Target] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([Target] -> [Target])
-> (Int -> [Target] -> [Target])
-> Maybe Int
-> [Target]
-> [Target]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Target] -> [Target]
forall a. a -> a
id Int -> [Target] -> [Target]
forall a. Int -> [a] -> [a]
take Maybe Int
count ([Target] -> [Target]) -> [Target] -> [Target]
forall a b. (a -> b) -> a -> b
$ (Target -> Target) -> [Target] -> [Target]
forall a b. (a -> b) -> [a] -> [b]
map Target -> Target
unHTMLtargetItem [Target]
res
                   | Bool
otherwise -> String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
toShow
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
hidden [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
json) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    IO () -> IO ()
whenNormal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"-- plus more results not shown, pass --count=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
count'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
10) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to see more"
        else do
            let parseType :: String -> (String, Sig String)
parseType String
x = case String -> [Query]
parseQuery String
x of
                                  [QueryType Type ()
t] -> (Type () -> String
forall a. Pretty a => a -> String
pretty Type ()
t, Type () -> Sig String
forall a. Type a -> Sig String
hseToSig Type ()
t)
                                  [Query]
_ -> String -> (String, Sig String)
forall a. Partial => String -> a
error (String -> (String, Sig String)) -> String -> (String, Sig String)
forall a b. (a -> b) -> a -> b
$ String
"Expected a type signature, got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
            String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ StoreRead
-> (String, Sig String) -> [(String, Sig String)] -> [String]
searchFingerprintsDebug StoreRead
store (String -> (String, Sig String)
parseType (String -> (String, Sig String)) -> String -> (String, Sig String)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
query) ((String -> (String, Sig String))
-> [String] -> [(String, Sig String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> (String, Sig String)
parseType [String]
compare_)

-- | Returns the details printed out when hoogle --info is called
targetInfo :: Target -> String
targetInfo :: Target -> String
targetInfo Target{String
Maybe (String, String)
targetURL :: String
targetPackage :: Maybe (String, String)
targetModule :: Maybe (String, String)
targetType :: String
targetItem :: String
targetDocs :: String
targetURL :: Target -> String
targetPackage :: Target -> Maybe (String, String)
targetModule :: Target -> Maybe (String, String)
targetType :: Target -> String
targetItem :: Target -> String
targetDocs :: Target -> String
..} =
    [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String -> String
unHTML String
targetItem ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
              [ [String] -> String
unwords [String]
packageModule | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
packageModule] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
              [ String -> String
unHTML String
targetDocs ]
            where packageModule :: [String]
packageModule = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Maybe (String, String)] -> [(String, String)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (String, String)
targetPackage, Maybe (String, String)
targetModule]

-- | Returns the Target formatted as an item to display in the results
-- | Bool argument decides whether links are shown
targetResultDisplay :: Bool -> Target -> String
targetResultDisplay :: Bool -> Target -> String
targetResultDisplay Bool
link Target{String
Maybe (String, String)
targetURL :: Target -> String
targetPackage :: Target -> Maybe (String, String)
targetModule :: Target -> Maybe (String, String)
targetType :: Target -> String
targetItem :: Target -> String
targetDocs :: Target -> String
targetURL :: String
targetPackage :: Maybe (String, String)
targetModule :: Maybe (String, String)
targetType :: String
targetItem :: String
targetDocs :: String
..} = String -> String
unHTML (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst (Maybe (String, String) -> [(String, String)]
forall a. Maybe a -> [a]
maybeToList Maybe (String, String)
targetModule) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [String
targetItem] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [String
"-- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
targetURL | Bool
link]

unHTMLtargetItem :: Target -> Target
unHTMLtargetItem :: Target -> Target
unHTMLtargetItem Target
target = Target
target {targetItem = unHTML $ targetItem target}

addCounter :: [String] -> [String]
addCounter :: [String] -> [String]
addCounter = (Integer -> String -> String) -> Integer -> [String] -> [String]
forall a b c. Enum a => (a -> b -> c) -> a -> [b] -> [c]
zipWithFrom (\Integer
i String
x -> Integer -> String
forall a. Show a => a -> String
show Integer
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) Integer
1

withSearch :: NFData a => FilePath -> (StoreRead -> IO a) -> IO a
withSearch :: forall a. NFData a => String -> (StoreRead -> IO a) -> IO a
withSearch String
database StoreRead -> IO a
act = do
    IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (String -> IO Bool
doesFileExist String
database) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
exitFail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error, database does not exist (run 'hoogle generate' first)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                   String
"    Filename: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
database
    String -> (StoreRead -> IO a) -> IO a
forall a. NFData a => String -> (StoreRead -> IO a) -> IO a
storeReadFile String
database StoreRead -> IO a
act


search :: StoreRead -> [Query] -> ([Query], [Target])
search :: StoreRead -> [Query] -> ([Query], [Target])
search StoreRead
store [Query]
qs = Identity ([Query], [Target]) -> ([Query], [Target])
forall a. Identity a -> a
runIdentity (Identity ([Query], [Target]) -> ([Query], [Target]))
-> Identity ([Query], [Target]) -> ([Query], [Target])
forall a b. (a -> b) -> a -> b
$ do
    ([Query]
qs, Bool
exact, TargetId -> Bool
filt, [TargetId]
list) <- ([Query], Bool, TargetId -> Bool, [TargetId])
-> Identity ([Query], Bool, TargetId -> Bool, [TargetId])
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Query], Bool, TargetId -> Bool, [TargetId])
 -> Identity ([Query], Bool, TargetId -> Bool, [TargetId]))
-> ([Query], Bool, TargetId -> Bool, [TargetId])
-> Identity ([Query], Bool, TargetId -> Bool, [TargetId])
forall a b. (a -> b) -> a -> b
$ StoreRead
-> [Query] -> ([Query], Bool, TargetId -> Bool, [TargetId])
applyTags StoreRead
store  [Query]
qs
    [TargetId]
is <- case ((Query -> Bool) -> [Query] -> [Query]
forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
isQueryName [Query]
qs, (Query -> Bool) -> [Query] -> [Query]
forall a. (a -> Bool) -> [a] -> [a]
filter Query -> Bool
isQueryType [Query]
qs) of
        ([], [] ) -> [TargetId] -> Identity [TargetId]
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TargetId]
list
        ([], Query
t:[Query]
_) -> [TargetId] -> Identity [TargetId]
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TargetId] -> Identity [TargetId])
-> [TargetId] -> Identity [TargetId]
forall a b. (a -> b) -> a -> b
$ StoreRead -> Sig String -> [TargetId]
searchTypes StoreRead
store (Sig String -> [TargetId]) -> Sig String -> [TargetId]
forall a b. (a -> b) -> a -> b
$ Type () -> Sig String
forall a. Type a -> Sig String
hseToSig (Type () -> Sig String) -> Type () -> Sig String
forall a b. (a -> b) -> a -> b
$ Query -> Type ()
fromQueryType Query
t
        ([Query]
xs, [] ) -> [TargetId] -> Identity [TargetId]
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TargetId] -> Identity [TargetId])
-> [TargetId] -> Identity [TargetId]
forall a b. (a -> b) -> a -> b
$ StoreRead -> Bool -> [String] -> [TargetId]
searchNames StoreRead
store Bool
exact ([String] -> [TargetId]) -> [String] -> [TargetId]
forall a b. (a -> b) -> a -> b
$ (Query -> String) -> [Query] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Query -> String
fromQueryName [Query]
xs
        ([Query]
xs, Query
t:[Query]
_) -> do
            Set TargetId
nam <- Set TargetId -> Identity (Set TargetId)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set TargetId -> Identity (Set TargetId))
-> Set TargetId -> Identity (Set TargetId)
forall a b. (a -> b) -> a -> b
$ [TargetId] -> Set TargetId
forall a. Ord a => [a] -> Set a
Set.fromList ([TargetId] -> Set TargetId) -> [TargetId] -> Set TargetId
forall a b. (a -> b) -> a -> b
$ StoreRead -> Bool -> [String] -> [TargetId]
searchNames StoreRead
store Bool
exact ([String] -> [TargetId]) -> [String] -> [TargetId]
forall a b. (a -> b) -> a -> b
$ (Query -> String) -> [Query] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Query -> String
fromQueryName [Query]
xs
            [TargetId] -> Identity [TargetId]
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TargetId] -> Identity [TargetId])
-> [TargetId] -> Identity [TargetId]
forall a b. (a -> b) -> a -> b
$ (TargetId -> Bool) -> [TargetId] -> [TargetId]
forall a. (a -> Bool) -> [a] -> [a]
filter (TargetId -> Set TargetId -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TargetId
nam) ([TargetId] -> [TargetId]) -> [TargetId] -> [TargetId]
forall a b. (a -> b) -> a -> b
$ StoreRead -> Sig String -> [TargetId]
searchTypes StoreRead
store (Sig String -> [TargetId]) -> Sig String -> [TargetId]
forall a b. (a -> b) -> a -> b
$ Type () -> Sig String
forall a. Type a -> Sig String
hseToSig (Type () -> Sig String) -> Type () -> Sig String
forall a b. (a -> b) -> a -> b
$ Query -> Type ()
fromQueryType Query
t
    let look :: TargetId -> Target
look = StoreRead -> TargetId -> Target
lookupItem StoreRead
store
    ([Query], [Target]) -> Identity ([Query], [Target])
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Query]
qs, (TargetId -> Target) -> [TargetId] -> [Target]
forall a b. (a -> b) -> [a] -> [b]
map TargetId -> Target
look ([TargetId] -> [Target]) -> [TargetId] -> [Target]
forall a b. (a -> b) -> a -> b
$ (TargetId -> Bool) -> [TargetId] -> [TargetId]
forall a. (a -> Bool) -> [a] -> [a]
filter TargetId -> Bool
filt [TargetId]
is)

action_search_test :: Bool -> FilePath -> IO ()
action_search_test :: Bool -> String -> IO ()
action_search_test Bool
sample String
database = String -> IO () -> IO ()
testing String
"Action.Search.search" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> (StoreRead -> IO ()) -> IO ()
forall a. NFData a => String -> (StoreRead -> IO a) -> IO a
withSearch String
database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \StoreRead
store -> do
    let noResults :: String -> IO ()
noResults String
a = do
          [Target]
res <- [Target] -> IO [Target]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Target] -> IO [Target]) -> [Target] -> IO [Target]
forall a b. (a -> b) -> a -> b
$ ([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
store (String -> [Query]
parseQuery String
a)
          case [Target]
res of
              [] -> Char -> IO ()
putChar Char
'.'
              [Target]
_ -> String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Searching for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nGot: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Target] -> String
forall a. Show a => a -> String
show (Int -> [Target] -> [Target]
forall a. Int -> [a] -> [a]
take Int
1 [Target]
res) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n expected none"
    let String
a ==$ :: String -> (String -> Bool) -> IO ()
==$ String -> Bool
f = do
            [Target]
res <- [Target] -> IO [Target]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Target] -> IO [Target]) -> [Target] -> IO [Target]
forall a b. (a -> b) -> a -> b
$ ([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
store (String -> [Query]
parseQuery String
a)
            case [Target]
res of
                Target{String
Maybe (String, String)
targetURL :: Target -> String
targetPackage :: Target -> Maybe (String, String)
targetModule :: Target -> Maybe (String, String)
targetType :: Target -> String
targetItem :: Target -> String
targetDocs :: Target -> String
targetURL :: String
targetPackage :: Maybe (String, String)
targetModule :: Maybe (String, String)
targetType :: String
targetItem :: String
targetDocs :: String
..}:[Target]
_ | String -> Bool
f String
targetURL -> Char -> IO ()
putChar Char
'.'
                [Target]
_ -> String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Searching for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nGot: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Target] -> String
forall a. Show a => a -> String
show (Int -> [Target] -> [Target]
forall a. Int -> [a] -> [a]
take Int
1 [Target]
res)
    let String
a === :: String -> String -> IO ()
=== String
b = String
a String -> (String -> Bool) -> IO ()
==$ (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b)

    let query :: String -> [ExpectedQueryResult] -> IO ()
        query :: String -> [ExpectedQueryResult] -> IO ()
query String
a [ExpectedQueryResult]
qrs = let results :: [[Target]]
results = [Target] -> [[Target]]
deDup ([Target] -> [[Target]]) -> [Target] -> [[Target]]
forall a b. (a -> b) -> a -> b
$ ([Query], [Target]) -> [Target]
forall a b. (a, b) -> b
snd (StoreRead -> [Query] -> ([Query], [Target])
search StoreRead
store (String -> [Query]
parseQuery String
a))
                      in [ExpectedQueryResult] -> (ExpectedQueryResult -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExpectedQueryResult]
qrs ((ExpectedQueryResult -> IO ()) -> IO ())
-> (ExpectedQueryResult -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ExpectedQueryResult
qr -> case ExpectedQueryResult -> [[Target]] -> TestResult
matchQR ExpectedQueryResult
qr [[Target]]
results of
                                              TestResult
Success           -> Char -> IO ()
putChar Char
'.'
                                              TestResult
ExpectedFailure   -> Char -> IO ()
putChar Char
'o'
                                              TestResult
_ -> String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Searching for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
a
                                                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nGot: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [[Target]] -> String
forall a. Show a => a -> String
show (Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
take Int
5 [[Target]]
results)
                                                           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpectedQueryResult -> String
expected ExpectedQueryResult
qr

    let hackage :: String -> String
hackage String
x = String
"https://hackage.haskell.org/package/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
    if Bool
sample then do
        String
"__prefix__" String -> String -> IO ()
=== String
"http://henry.com?too_long"
        String
"__suffix__" String -> String -> IO ()
=== String
"http://henry.com?too_long"
        String
"__infix__" String -> String -> IO ()
=== String
"http://henry.com?too_long"
        String
"Wife" String -> String -> IO ()
=== String
"http://eghmitchell.com/Mitchell.html#a_wife"
        StoreRead -> [String]
completionTags StoreRead
store [String] -> [String] -> IO ()
forall a. (Show a, Eq a) => a -> a -> IO ()
`testEq` [String
"set:all",String
"set:sample-data",String
"package:emily",String
"package:henry"]
     else do
        String
"base" String -> String -> IO ()
=== String -> String
hackage String
"base"
        String
"Prelude" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html"
        String
"map" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:map"
        String
"map is:ping" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:map"
        String
"map package:base" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:map"
        String -> IO ()
noResults String
"map package:package-not-in-db"
        String -> IO ()
noResults String
"map module:Module.Not.In.Db"
        String
"True" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:True"
        String
"Bool" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#t:Bool"
        String
"String" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#t:String"
        String
"Ord" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#t:Ord"
        String
">>=" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:-62--62--61-"
        String
"sequen" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:sequence"
        String
"foldl'" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Data-List.html#v:foldl-39-"
        String
"Action package:shake" String -> String -> IO ()
=== String
"https://hackage.haskell.org/package/shake/docs/Development-Shake.html#t:Action"
        String
"Action package:shake set:stackage" String -> String -> IO ()
=== String
"https://hackage.haskell.org/package/shake/docs/Development-Shake.html#t:Action"
        String
"map -package:base" String -> (String -> Bool) -> IO ()
==$ \String
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
"/base/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
x
        String
"<>" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:-60--62-"
        String
"Data.Set.insert" String -> String -> IO ()
=== String -> String
hackage String
"containers/docs/Data-Set.html#v:insert"
        String
"Set.insert" String -> String -> IO ()
=== String -> String
hackage String
"containers/docs/Data-Set.html#v:insert"
        String
"Prelude.mapM_" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:mapM_"
        String
"Data.Complex.(:+)" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Data-Complex.html#v::-43-"
        String
"\8801" String -> String -> IO ()
=== String -> String
hackage String
"base-unicode-symbols/docs/Data-Eq-Unicode.html#v:-8801-"
        String
"\8484" String -> String -> IO ()
=== String -> String
hackage String
"base-unicode-symbols/docs/Prelude-Unicode.html#t:-8484-"
        String
"copilot" String -> String -> IO ()
=== String -> String
hackage String
"copilot"
        String
"supero" String -> String -> IO ()
=== String -> String
hackage String
"supero"
        String
"set:stackage" String -> String -> IO ()
=== String -> String
hackage String
"base"
        String
"author:Neil-Mitchell" String -> String -> IO ()
=== String -> String
hackage String
"filepath"
        -- FIXME: "author:Neil-M" === hackage "filepath"
        -- FIXME: "Data.Se.insert" === hackage "containers/docs/Data-Set.html#v:insert"
        String
"set:-haskell-platform author:Neil-Mitchell" String -> String -> IO ()
=== String -> String
hackage String
"safe"
        String
"author:Neil-Mitchell category:Javascript" String -> String -> IO ()
=== String -> String
hackage String
"js-jquery"
        String
"( )" String -> (String -> Bool) -> IO ()
==$ (String -> Bool -> Bool) -> Bool -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> Bool
forall a b. a -> b -> b
seq Bool
True -- used to segfault
        String
"( -is:exact) package:base=" String -> (String -> Bool) -> IO ()
==$ (String -> Bool -> Bool) -> Bool -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Bool -> Bool
forall a b. a -> b -> b
seq Bool
True
        String
"(a -> b) -> [a] -> [b]" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html#v:map"
        String
"Ord a => [a] -> [a]" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Data-List.html#v:sort"
        String
"ShakeOptions -> Int" String -> String -> IO ()
=== String -> String
hackage String
"shake/docs/Development-Shake.html#v:shakeThreads"
        String
"is:module" String -> String -> IO ()
=== String -> String
hackage String
"base/docs/Prelude.html"
        String
"visibleDataCons" String -> String -> IO ()
=== String -> String
hackage String
"ghc/docs/GHC-Core-TyCon.html#v:visibleDataCons"
        String
"sparkle" String -> String -> IO ()
=== String -> String
hackage String
"sparkle" -- library without Hoogle docs
        String
"weeder" String -> String -> IO ()
=== String -> String
hackage String
"weeder" -- executable in Stackage
        String
"supero" String -> String -> IO ()
=== String -> String
hackage String
"supero"

        String -> [ExpectedQueryResult] -> IO ()
query String
"(a -> [a]) -> [a] -> [a]"
            [ TargetMatcher -> ExpectedQueryResult
TopHit   (String
"concatMap" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"(=<<)" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
50 (String
"(>>=)" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"[a] -> Maybe a"
            [ TargetMatcher -> ExpectedQueryResult
TopHit  (String
"listToMaybe" String -> String -> TargetMatcher
`inModule` String
"Data.Maybe")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"headMay"     String -> String -> TargetMatcher
`inModule` String
"Safe")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"a -> [a]"
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10    (String
"repeat"    String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
50    (String
"singleton" String -> String -> TargetMatcher
`inModule` String
"Util")
            , TargetMatcher -> ExpectedQueryResult
DoesNotFind (String
"head"      String -> String -> TargetMatcher
`inPackage` String
"base")
            , TargetMatcher -> ExpectedQueryResult
DoesNotFind (String
"last"      String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
50    (String
"pure"      String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
100   (String
"return"    String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #267" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  (String
"pure" String -> String -> TargetMatcher
`inPackage` String
"base") TargetMatcher -> TargetMatcher -> ExpectedQueryResult
`AppearsBefore` (String
"shrinkNothing" String -> String -> TargetMatcher
`inModule` String
"Test.QuickCheck")
            -- , InTop 10 ("pure"   `inPackage` "base")
            -- , InTop 10 ("return" `inPackage` "base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"[a] -> a"
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"head" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"last" String -> String -> TargetMatcher
`inPackage` String
"base")
            , TargetMatcher -> ExpectedQueryResult
DoesNotFind (String
"repeat" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"[Char] -> Char"
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"head" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
RanksBelow Int
10 (String
"mconcat" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"a -> b"
            [ TargetMatcher -> ExpectedQueryResult
TopHit (String
"unsafeCoerce" String -> String -> TargetMatcher
`inModule` String
"Unsafe.Coerce")
            , TargetMatcher -> ExpectedQueryResult
DoesNotFind (String
"id" String -> String -> TargetMatcher
`inPackage` String
"base") -- see GitHub issue #180
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #268" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
20 (String
"coerce" String -> String -> TargetMatcher
`inModule` String
"Data.Coerce")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #268" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
5   (String
"coerce" String -> String -> TargetMatcher
`inModule` String
"Data.Coerce")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"String -> (Char -> Maybe Char) -> Maybe String" -- c/o @ndrssmn
            [ String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #266" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"traverse" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #266" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"mapM" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #266" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"forM" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"a -> [(a,b)] -> b"
            [ String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #267" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  TargetMatcher -> ExpectedQueryResult
TopHit  (String
"lookup" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
3 (String
"lookup" String -> String -> TargetMatcher
`inPackage` String
"base")
            , TargetMatcher -> ExpectedQueryResult
DoesNotFind (String
"zip" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"[(a,b)] -> a -> b"
            [ String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #267" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  TargetMatcher -> ExpectedQueryResult
TopHit (String
"lookup" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
3 (String
"lookup" String -> String -> TargetMatcher
`inPackage` String
"base")
            , TargetMatcher -> ExpectedQueryResult
DoesNotFind (String
"zip" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"(a -> m b) -> t a -> m (t b)" -- see GitHub issue #218
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"traverse" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"mapConcurrently" String -> String -> TargetMatcher
`inModule` String
"Control.Concurrent.Async.Lifted")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"mapM" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
50 (String
"forM" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"m (m a) -> m a" -- see GitHub issue #252
            [ TargetMatcher -> ExpectedQueryResult
TopHit (String
"join" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"(a -> b -> c) -> (a -> b) -> a -> c"
            [ String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #269" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
5 (String
"ap" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #269" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
5 (String
"(<*>)" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"String -> Int"
            [ TargetMatcher -> ExpectedQueryResult
DoesNotFind (String
"cursorUpCode" String -> String -> TargetMatcher
`inPackage` String
"ansi-terminal")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #266" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
20 (String
"length" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"(a -> b) -> f a -> f b"
            [ TargetMatcher -> ExpectedQueryResult
TopHit (String
"fmap" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"(a -> b) -> Maybe a -> Maybe b"
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
3 (String
"fmap" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"IO a -> m a"
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
5 (String
"liftIO" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"a -> m a" -- see GitHub issue #180
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
20 (String
"pure" String -> String -> TargetMatcher
`inPackage` String
"base")
            , Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
50 (String
"return" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #267" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
5 (String
"pure" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #267" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
3 (String
"return" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"(a -> a) -> k -> Map k a -> Map k a" -- see GitHub issue #180
            [ TargetMatcher -> ExpectedQueryResult
TopHit (String
"adjust" String -> String -> TargetMatcher
`inPackage` String
"containers")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"Int -> Integer" -- see GitHub issue #127
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
40 (String
"toInteger" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #127" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  TargetMatcher -> ExpectedQueryResult
TopHit (String
"toInteger" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"Integer -> Int" -- see GitHub issue #127
            [ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
40 (String
"fromInteger" String -> String -> TargetMatcher
`inPackage` String
"base")
            , String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"GitHub issue #127" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$
                  TargetMatcher -> ExpectedQueryResult
TopHit (String
"fromInteger" String -> String -> TargetMatcher
`inPackage` String
"base")
            ]
        String -> [ExpectedQueryResult] -> IO ()
query String
"[Parser a] -> Parser a" -- see GitHub issue #90
            [ String -> ExpectedQueryResult -> ExpectedQueryResult
KnownFailure String
"Todo" (ExpectedQueryResult -> ExpectedQueryResult)
-> ExpectedQueryResult -> ExpectedQueryResult
forall a b. (a -> b) -> a -> b
$ Int -> TargetMatcher -> ExpectedQueryResult
InTop Int
10 (String
"choice" String -> String -> TargetMatcher
`inPackage` String
"attoparsec")
            ]

        let tags :: [String]
tags = StoreRead -> [String]
completionTags StoreRead
store
        let asserts :: Bool -> String -> IO ()
asserts Bool
b String
x = if Bool
b then Char -> IO ()
putChar Char
'.' else String -> IO ()
forall a. Partial => String -> IO a
errorIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Assertion failed, got False for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
        Bool -> String -> IO ()
asserts (String
"set:haskell-platform" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags) String
"set:haskell-platform `elem` tags"
        Bool -> String -> IO ()
asserts (String
"author:Neil-Mitchell" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags) String
"author:Neil-Mitchell `elem` tags"
        Bool -> String -> IO ()
asserts (String
"package:uniplate" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags) String
"package:uniplate `elem` tags"
        Bool -> String -> IO ()
asserts (String
"package:supero" String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
tags) String
"package:supero `notElem` tags"


--------------------------------------------------------------------------------------------------
-- Test helpers

data ExpectedQueryResult
    = TopHit TargetMatcher
    | InTop Int TargetMatcher
    | RanksBelow Int TargetMatcher
    | DoesNotFind TargetMatcher
    | AppearsBefore TargetMatcher TargetMatcher
    | NoHits
    | KnownFailure String ExpectedQueryResult

expected :: ExpectedQueryResult -> String
expected :: ExpectedQueryResult -> String
expected = \case
    TopHit TargetMatcher
tm       -> TargetMatcher -> String
showTM TargetMatcher
tm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as first hit."
    InTop Int
n TargetMatcher
tm      -> TargetMatcher -> String
showTM TargetMatcher
tm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in top " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" hits."
    RanksBelow Int
n TargetMatcher
tm -> TargetMatcher -> String
showTM TargetMatcher
tm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not in top " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" hits."
    DoesNotFind TargetMatcher
tm  -> String
"to not match " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetMatcher -> String
showTM TargetMatcher
tm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    AppearsBefore TargetMatcher
tm TargetMatcher
tm' -> TargetMatcher -> String
showTM TargetMatcher
tm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to appear before " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TargetMatcher -> String
showTM TargetMatcher
tm' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    ExpectedQueryResult
NoHits          -> String
"no results."
    KnownFailure String
why ExpectedQueryResult
qr -> String
"to see a failure (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExpectedQueryResult -> String
expected ExpectedQueryResult
qr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" But it succeeded!"

data TestResult
    = Success
    | Failure
    | ExpectedFailure
    | UnexpectedSuccess

matchQR :: ExpectedQueryResult -> [[Target]] -> TestResult
matchQR :: ExpectedQueryResult -> [[Target]] -> TestResult
matchQR ExpectedQueryResult
qr [[Target]]
res = case ExpectedQueryResult
qr of
    TopHit TargetMatcher
tm        -> Bool -> TestResult
success (Bool -> TestResult) -> Bool -> TestResult
forall a b. (a -> b) -> a -> b
$ ([Target] -> Bool) -> [[Target]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Target -> Bool) -> [Target] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm)) ([[Target]] -> Bool) -> [[Target]] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
take Int
1 [[Target]]
res
    InTop Int
n TargetMatcher
tm       -> Bool -> TestResult
success (Bool -> TestResult) -> Bool -> TestResult
forall a b. (a -> b) -> a -> b
$ ([Target] -> Bool) -> [[Target]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Target -> Bool) -> [Target] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm)) ([[Target]] -> Bool) -> [[Target]] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
take Int
n [[Target]]
res
    RanksBelow Int
n TargetMatcher
tm  -> Bool -> TestResult
success (Bool -> TestResult) -> Bool -> TestResult
forall a b. (a -> b) -> a -> b
$ ([Target] -> Bool) -> [[Target]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Target -> Bool) -> [Target] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm)) ([[Target]] -> Bool) -> [[Target]] -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
drop Int
n [[Target]]
res
    DoesNotFind TargetMatcher
tm   -> Bool -> TestResult
success (Bool -> TestResult) -> Bool -> TestResult
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Target] -> Bool) -> [[Target]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Target -> Bool) -> [Target] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm)) [[Target]]
res
    AppearsBefore TargetMatcher
tm TargetMatcher
tm' -> Bool -> TestResult
success (Bool -> TestResult) -> Bool -> TestResult
forall a b. (a -> b) -> a -> b
$ ( Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Integer -> Integer -> Bool)
-> Maybe Integer -> Maybe (Integer -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TargetMatcher -> Maybe Integer
forall {b}. (Enum b, Num b) => TargetMatcher -> Maybe b
matchIdx TargetMatcher
tm Maybe (Integer -> Bool) -> Maybe Integer -> Maybe Bool
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TargetMatcher -> Maybe Integer
forall {b}. (Enum b, Num b) => TargetMatcher -> Maybe b
matchIdx TargetMatcher
tm' ) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    ExpectedQueryResult
NoHits           -> Bool -> TestResult
success (Bool -> TestResult) -> Bool -> TestResult
forall a b. (a -> b) -> a -> b
$ [[Target]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Target]]
res
    KnownFailure String
_ ExpectedQueryResult
qr' -> case ExpectedQueryResult -> [[Target]] -> TestResult
matchQR ExpectedQueryResult
qr' [[Target]]
res of
        TestResult
Success           -> TestResult
UnexpectedSuccess
        TestResult
Failure           -> TestResult
ExpectedFailure
        TestResult
ExpectedFailure   -> TestResult
Failure
        TestResult
UnexpectedSuccess -> TestResult
Failure
  where
    success :: Bool -> TestResult
success Bool
p = if Bool
p then TestResult
Success else TestResult
Failure
    matchIdx :: TargetMatcher -> Maybe b
matchIdx TargetMatcher
tm = ((b, Target) -> b) -> Maybe (b, Target) -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, Target) -> b
forall a b. (a, b) -> a
fst (Maybe (b, Target) -> Maybe b) -> Maybe (b, Target) -> Maybe b
forall a b. (a -> b) -> a -> b
$ ((b, Target) -> Bool) -> [(b, Target)] -> Maybe (b, Target)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm (Target -> Bool) -> ((b, Target) -> Target) -> (b, Target) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, Target) -> Target
forall a b. (a, b) -> b
snd) (b -> [Target] -> [(b, Target)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom b
0 ([Target] -> [(b, Target)]) -> [Target] -> [(b, Target)]
forall a b. (a -> b) -> a -> b
$ [[Target]] -> [Target]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Target]]
res)

data TargetMatcher
    = MatchFunctionInModule  String String
    | MatchFunctionInPackage String String

showTM :: TargetMatcher -> String
showTM :: TargetMatcher -> String
showTM = \case
    MatchFunctionInModule  String
f String
m -> String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'s " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f
    MatchFunctionInPackage String
f String
p -> String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" from package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p

runTargetMatcher :: TargetMatcher -> Target -> Bool
runTargetMatcher :: TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
matcher Target{String
Maybe (String, String)
targetURL :: Target -> String
targetPackage :: Target -> Maybe (String, String)
targetModule :: Target -> Maybe (String, String)
targetType :: Target -> String
targetItem :: Target -> String
targetDocs :: Target -> String
targetURL :: String
targetPackage :: Maybe (String, String)
targetModule :: Maybe (String, String)
targetType :: String
targetItem :: String
targetDocs :: String
..} = case TargetMatcher
matcher of
    MatchFunctionInModule String
f String
m ->
        String -> Maybe String
forall a. a -> Maybe a
Just String
m Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== ((String, String) -> String)
-> Maybe (String, String) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String) -> String
forall a b. (a, b) -> a
fst Maybe (String, String)
targetModule
        Bool -> Bool -> Bool
&& String
f String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
unHTML String
targetItem
    MatchFunctionInPackage String
f String
m ->
        String -> Maybe String
forall a. a -> Maybe a
Just String
m Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== ((String, String) -> String)
-> Maybe (String, String) -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, String) -> String
forall a b. (a, b) -> a
fst Maybe (String, String)
targetPackage
        Bool -> Bool -> Bool
&& String
f String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String -> String
unHTML String
targetItem

inModule :: String -> String -> TargetMatcher
inModule :: String -> String -> TargetMatcher
inModule = String -> String -> TargetMatcher
MatchFunctionInModule

inPackage :: String -> String -> TargetMatcher
inPackage :: String -> String -> TargetMatcher
inPackage = String -> String -> TargetMatcher
MatchFunctionInPackage

-- Group duplicated targets (e.g. re-exports) together.
deDup :: [Target] -> [[Target]]
deDup :: [Target] -> [[Target]]
deDup [Target]
tgts = Map Int [Target] -> [[Target]]
forall k a. Map k a -> [a]
Map.elems ([(Int, [Target])] -> Map Int [Target]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, [Target])] -> Map Int [Target])
-> [(Int, [Target])] -> Map Int [Target]
forall a b. (a -> b) -> a -> b
$ Map Target (Int, [Target]) -> [(Int, [Target])]
forall k a. Map k a -> [a]
Map.elems Map Target (Int, [Target])
tgtMap)
  where
    tgtMap :: Map.Map Target (Int, [Target])
    tgtMap :: Map Target (Int, [Target])
tgtMap = ((Int, [Target]) -> (Int, [Target]) -> (Int, [Target]))
-> [(Target, (Int, [Target]))] -> Map Target (Int, [Target])
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (\(Int
n, [Target]
ts) (Int
n', [Target]
ts') -> (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
n', [Target]
ts [Target] -> [Target] -> [Target]
forall a. [a] -> [a] -> [a]
++ [Target]
ts'))
             ([(Target, (Int, [Target]))] -> Map Target (Int, [Target]))
-> [(Target, (Int, [Target]))] -> Map Target (Int, [Target])
forall a b. (a -> b) -> a -> b
$ (Int -> Target -> (Target, (Int, [Target])))
-> Int -> [Target] -> [(Target, (Int, [Target]))]
forall a b c. Enum a => (a -> b -> c) -> a -> [b] -> [c]
zipWithFrom (\Int
n Target
t -> (Target -> Target
simple Target
t, (Int
n, [Target
t]))) Int
0 [Target]
tgts

    simple :: Target -> Target
    simple :: Target -> Target
simple Target
t = Target
t { targetURL = "", targetPackage = Nothing, targetModule = Nothing }