{-# 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
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
$
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_)
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]
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"
"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
"( -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"
"weeder" FilePath -> FilePath -> IO ()
=== FilePath -> FilePath
hackage "weeder"
"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")
]
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")
, 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"
[ 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)"
[ 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"
[ 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"
[ 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"
[ TargetMatcher -> ExpectedQueryResult
TopHit ("adjust" FilePath -> FilePath -> TargetMatcher
`inPackage` "containers")
]
FilePath -> [ExpectedQueryResult] -> IO ()
query "Int -> Integer"
[ 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"
[ 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"
[ 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"
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
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 }