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

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

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

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{..} = 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
    FilePath -> (StoreRead -> IO ()) -> IO ()
forall a. NFData a => FilePath -> (StoreRead -> IO a) -> IO a
withSearch FilePath
database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \store :: StoreRead
store ->
        if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
compare_ then do
            Int
count' <- Int -> IO Int
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 10 Maybe Int
count
            (q :: [Query]
q, res :: [Target]
res) <- ([Query], [Target]) -> IO ([Query], [Target])
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
$ FilePath -> [Query]
parseQuery (FilePath -> [Query]) -> FilePath -> [Query]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath]
query
            IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Query: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
unescapeHTML (ByteString -> FilePath
LBS.unpack (ByteString -> FilePath) -> ByteString -> FilePath
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 (shown :: [FilePath]
shown, hidden :: [FilePath]
hidden) = Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
count' ([FilePath] -> ([FilePath], [FilePath]))
-> [FilePath] -> ([FilePath], [FilePath])
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Target -> FilePath) -> [Target] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Target -> FilePath
targetResultDisplay Bool
link) [Target]
res
            if [Target] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Target]
res then
                FilePath -> IO ()
putStrLn "No results found"
             else if Bool
info then do
                 FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Target -> FilePath
targetInfo (Target -> FilePath) -> Target -> FilePath
forall a b. (a -> b) -> a -> b
$ [Target] -> Target
forall a. [a] -> a
head [Target]
res
             else do
                let toShow :: [FilePath]
toShow = if Bool
numbers Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
info then [FilePath] -> [FilePath]
addCounter [FilePath]
shown else [FilePath]
shown
                if Bool
json then 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 else FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines [FilePath]
toShow
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath]
hidden [FilePath] -> [FilePath] -> 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
$ FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "-- plus more results not shown, pass --count=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
count'Int -> Int -> Int
forall a. Num a => a -> a -> a
+10) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " to see more"
        else do
            let parseType :: FilePath -> (FilePath, Sig FilePath)
parseType x :: FilePath
x = case FilePath -> [Query]
parseQuery FilePath
x of
                                  [QueryType t :: Type ()
t] -> (Type () -> FilePath
forall a. Pretty a => a -> FilePath
pretty Type ()
t, Type () -> Sig FilePath
forall a. Type a -> Sig FilePath
hseToSig Type ()
t)
                                  _ -> FilePath -> (FilePath, Sig FilePath)
forall a. HasCallStack => FilePath -> a
error (FilePath -> (FilePath, Sig FilePath))
-> FilePath -> (FilePath, Sig FilePath)
forall a b. (a -> b) -> a -> b
$ "Expected a type signature, got: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x
            FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ StoreRead
-> (FilePath, Sig FilePath)
-> [(FilePath, Sig FilePath)]
-> [FilePath]
searchFingerprintsDebug StoreRead
store (FilePath -> (FilePath, Sig FilePath)
parseType (FilePath -> (FilePath, Sig FilePath))
-> FilePath -> (FilePath, Sig FilePath)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath]
query) ((FilePath -> (FilePath, Sig FilePath))
-> [FilePath] -> [(FilePath, Sig FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> (FilePath, Sig FilePath)
parseType [FilePath]
compare_)

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

unHTMLtargetItem :: Target -> Target
unHTMLtargetItem :: Target -> Target
unHTMLtargetItem target :: Target
target = Target
target {targetItem :: FilePath
targetItem = FilePath -> FilePath
unHTML (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Target -> FilePath
targetItem Target
target}

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

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


search :: StoreRead -> [Query] -> ([Query], [Target])
search :: StoreRead -> [Query] -> ([Query], [Target])
search store :: StoreRead
store qs :: [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
    (qs :: [Query]
qs, exact :: Bool
exact, filt :: TargetId -> Bool
filt, list :: [TargetId]
list) <- ([Query], Bool, TargetId -> Bool, [TargetId])
-> Identity ([Query], Bool, TargetId -> Bool, [TargetId])
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 (f :: * -> *) a. Applicative f => a -> f a
pure [TargetId]
list
        ([], t :: Query
t:_) -> [TargetId] -> Identity [TargetId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TargetId] -> Identity [TargetId])
-> [TargetId] -> Identity [TargetId]
forall a b. (a -> b) -> a -> b
$ StoreRead -> Sig FilePath -> [TargetId]
searchTypes StoreRead
store (Sig FilePath -> [TargetId]) -> Sig FilePath -> [TargetId]
forall a b. (a -> b) -> a -> b
$ Type () -> Sig FilePath
forall a. Type a -> Sig FilePath
hseToSig (Type () -> Sig FilePath) -> Type () -> Sig FilePath
forall a b. (a -> b) -> a -> b
$ Query -> Type ()
fromQueryType Query
t
        (xs :: [Query]
xs, [] ) -> [TargetId] -> Identity [TargetId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TargetId] -> Identity [TargetId])
-> [TargetId] -> Identity [TargetId]
forall a b. (a -> b) -> a -> b
$ StoreRead -> Bool -> [FilePath] -> [TargetId]
searchNames StoreRead
store Bool
exact ([FilePath] -> [TargetId]) -> [FilePath] -> [TargetId]
forall a b. (a -> b) -> a -> b
$ (Query -> FilePath) -> [Query] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Query -> FilePath
fromQueryName [Query]
xs
        (xs :: [Query]
xs, t :: Query
t:_) -> do
            Set TargetId
nam <- Set TargetId -> Identity (Set TargetId)
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 -> [FilePath] -> [TargetId]
searchNames StoreRead
store Bool
exact ([FilePath] -> [TargetId]) -> [FilePath] -> [TargetId]
forall a b. (a -> b) -> a -> b
$ (Query -> FilePath) -> [Query] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Query -> FilePath
fromQueryName [Query]
xs
            [TargetId] -> Identity [TargetId]
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 FilePath -> [TargetId]
searchTypes StoreRead
store (Sig FilePath -> [TargetId]) -> Sig FilePath -> [TargetId]
forall a b. (a -> b) -> a -> b
$ Type () -> Sig FilePath
forall a. Type a -> Sig FilePath
hseToSig (Type () -> Sig FilePath) -> Type () -> Sig FilePath
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 (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 -> FilePath -> IO ()
action_search_test sample :: Bool
sample database :: FilePath
database = FilePath -> IO () -> IO ()
testing "Action.Search.search" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (StoreRead -> IO ()) -> IO ()
forall a. NFData a => FilePath -> (StoreRead -> IO a) -> IO a
withSearch FilePath
database ((StoreRead -> IO ()) -> IO ()) -> (StoreRead -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \store :: StoreRead
store -> do
    let noResults :: FilePath -> IO ()
noResults a :: FilePath
a = do
          [Target]
res <- [Target] -> IO [Target]
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 (FilePath -> [Query]
parseQuery FilePath
a)
          case [Target]
res of
              [] -> Char -> IO ()
putChar '.'
              _ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> IO a
errorIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Searching for: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\nGot: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Target] -> FilePath
forall a. Show a => a -> FilePath
show (Int -> [Target] -> [Target]
forall a. Int -> [a] -> [a]
take 1 [Target]
res) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n expected none"
    let a :: FilePath
a ==$ :: FilePath -> (FilePath -> Bool) -> IO ()
==$ f :: FilePath -> Bool
f = do
            [Target]
res <- [Target] -> IO [Target]
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 (FilePath -> [Query]
parseQuery FilePath
a)
            case [Target]
res of
                Target{..}:_ | FilePath -> Bool
f FilePath
targetURL -> Char -> IO ()
putChar '.'
                _ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> IO a
errorIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Searching for: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\nGot: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Target] -> FilePath
forall a. Show a => a -> FilePath
show (Int -> [Target] -> [Target]
forall a. Int -> [a] -> [a]
take 1 [Target]
res)
    let a :: FilePath
a === :: FilePath -> FilePath -> IO ()
=== b :: FilePath
b = FilePath
a FilePath -> (FilePath -> Bool) -> IO ()
==$ (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b)

    let query :: String -> [ExpectedQueryResult] -> IO ()
        query :: FilePath -> [ExpectedQueryResult] -> IO ()
query a :: FilePath
a qrs :: [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 (FilePath -> [Query]
parseQuery FilePath
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
$ \qr :: ExpectedQueryResult
qr -> case ExpectedQueryResult -> [[Target]] -> TestResult
matchQR ExpectedQueryResult
qr [[Target]]
results of
                                              Success           -> Char -> IO ()
putChar '.'
                                              ExpectedFailure   -> Char -> IO ()
putChar 'o'
                                              _ -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> IO a
errorIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Searching for: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
a
                                                           FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\nGot: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [[Target]] -> FilePath
forall a. Show a => a -> FilePath
show (Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
take 5 [[Target]]
results)
                                                           FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\n expected " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExpectedQueryResult -> FilePath
expected ExpectedQueryResult
qr

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

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

        let tags :: [FilePath]
tags = StoreRead -> [FilePath]
completionTags StoreRead
store
        let asserts :: Bool -> FilePath -> IO ()
asserts b :: Bool
b x :: FilePath
x = if Bool
b then Char -> IO ()
putChar '.' else FilePath -> IO ()
forall a. HasCallStack => FilePath -> IO a
errorIO (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ "Assertion failed, got False for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
x
        Bool -> FilePath -> IO ()
asserts ("set:haskell-platform" FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
tags) "set:haskell-platform `elem` tags"
        Bool -> FilePath -> IO ()
asserts ("author:Neil-Mitchell" FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
tags) "author:Neil-Mitchell `elem` tags"
        Bool -> FilePath -> IO ()
asserts ("package:uniplate" FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
tags) "package:uniplate `elem` tags"
        Bool -> FilePath -> IO ()
asserts ("package:supero" FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath]
tags) "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 -> FilePath
expected = \case
    TopHit tm :: TargetMatcher
tm       -> TargetMatcher -> FilePath
showTM TargetMatcher
tm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " as first hit."
    InTop n :: Int
n tm :: TargetMatcher
tm      -> TargetMatcher -> FilePath
showTM TargetMatcher
tm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " in top " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " hits."
    RanksBelow n :: Int
n tm :: TargetMatcher
tm -> TargetMatcher -> FilePath
showTM TargetMatcher
tm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " not in top " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " hits."
    DoesNotFind tm :: TargetMatcher
tm  -> "to not match " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TargetMatcher -> FilePath
showTM TargetMatcher
tm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "."
    AppearsBefore tm :: TargetMatcher
tm tm' :: TargetMatcher
tm' -> TargetMatcher -> FilePath
showTM TargetMatcher
tm FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " to appear before " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ TargetMatcher -> FilePath
showTM TargetMatcher
tm' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "."
    NoHits          -> "no results."
    KnownFailure why :: FilePath
why qr :: ExpectedQueryResult
qr -> "to see a failure (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
why FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "): \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExpectedQueryResult -> FilePath
expected ExpectedQueryResult
qr FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "\" But it succeeded!"

data TestResult
    = Success
    | Failure
    | ExpectedFailure
    | UnexpectedSuccess

matchQR :: ExpectedQueryResult -> [[Target]] -> TestResult
matchQR :: ExpectedQueryResult -> [[Target]] -> TestResult
matchQR qr :: ExpectedQueryResult
qr res :: [[Target]]
res = case ExpectedQueryResult
qr of
    TopHit tm :: 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 (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm) ([[Target]] -> [Target]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Target]] -> [Target]) -> [[Target]] -> [Target]
forall a b. (a -> b) -> a -> b
$ Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
take 1 [[Target]]
res)
    InTop n :: Int
n tm :: 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 (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm) ([[Target]] -> [Target]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Target]] -> [Target]) -> [[Target]] -> [Target]
forall a b. (a -> b) -> a -> b
$ Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
take Int
n [[Target]]
res)
    RanksBelow n :: Int
n tm :: 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 (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm) ([[Target]] -> [Target]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Target]] -> [Target]) -> [[Target]] -> [Target]
forall a b. (a -> b) -> a -> b
$ Int -> [[Target]] -> [[Target]]
forall a. Int -> [a] -> [a]
drop Int
n [[Target]]
res)
    DoesNotFind tm :: 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 (TargetMatcher -> Target -> Bool
runTargetMatcher TargetMatcher
tm) ([[Target]] -> [Target]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Target]]
res)
    AppearsBefore tm :: TargetMatcher
tm 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 (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
    NoHits           -> Bool -> TestResult
success (Bool -> TestResult) -> Bool -> TestResult
forall a b. (a -> b) -> a -> b
$ [[Target]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Target]]
res
    KnownFailure _ qr' :: ExpectedQueryResult
qr' -> case ExpectedQueryResult -> [[Target]] -> TestResult
matchQR ExpectedQueryResult
qr' [[Target]]
res of
        Success           -> TestResult
UnexpectedSuccess
        Failure           -> TestResult
ExpectedFailure
        ExpectedFailure   -> TestResult
Failure
        UnexpectedSuccess -> TestResult
Failure
  where
    success :: Bool -> TestResult
success p :: Bool
p = if Bool
p then TestResult
Success else TestResult
Failure
    matchIdx :: TargetMatcher -> Maybe b
matchIdx tm :: TargetMatcher
tm = ((b, Target) -> b) -> Maybe (b, Target) -> 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 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 -> FilePath
showTM = \case
    MatchFunctionInModule  f :: FilePath
f m :: FilePath
m -> FilePath
m FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'s " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
f
    MatchFunctionInPackage f :: FilePath
f p :: FilePath
p -> FilePath
f FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " from package " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
p

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

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

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

-- Group duplicated targets (e.g. re-exports) together.
deDup :: [Target] -> [[Target]]
deDup :: [Target] -> [[Target]]
deDup tgts :: [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 (\(n :: Int
n, ts :: [Target]
ts) (n' :: Int
n', ts' :: [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 (\n :: Int
n t :: Target
t -> (Target -> Target
simple Target
t, (Int
n, [Target
t]))) 0 [Target]
tgts

    simple :: Target -> Target
    simple :: Target -> Target
simple t :: Target
t = Target
t { targetURL :: FilePath
targetURL = "", targetPackage :: Maybe (FilePath, FilePath)
targetPackage = Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing, targetModule :: Maybe (FilePath, FilePath)
targetModule = Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing }