module Hoogle.DataBase.TypeSearch.Graph(
Graph, newGraph,
graphSearch
) where
import Hoogle.DataBase.TypeSearch.TypeScore
import Hoogle.DataBase.TypeSearch.Binding
import Hoogle.DataBase.TypeSearch.Result
import Hoogle.DataBase.Aliases
import Hoogle.Item.All
import Hoogle.TypeSig.All
import Data.Generics.Uniplate
import Data.Binary.Defer
import Data.Binary.Defer.Index
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import qualified Data.Heap as Heap
import General.Code
import Data.Key
newtype Graph = Graph (Map.Map Type [Node])
data Node = Node [Type] [(Link EntryInfo,ArgPos)]
instance Show Graph where
show (Graph mp) = unlines $ concatMap f $ Map.toList mp
where f (t,ns) = show (transform g t) : map ((" "++) . show) ns
g x = if x == TVar "" then TVar "_" else x
instance Show Node where
show (Node t xs) = unwords $ map show t ++ "=" : [show (linkKey a) ++ "." ++ show b | (a,b) <- xs]
instance BinaryDefer Graph where
put (Graph a) = put1 a
get = get1 Graph
instance BinaryDefer Node where
put (Node a b) = put2 a b
get = get2 Node
typeStructure :: Type -> Type
typeStructure = transform f
where f x = if isTLit x || isTVar x then TVar "" else x
typeUnstructure :: Type -> [Type]
typeUnstructure = reverse . filter (\x -> isTLit x || isTVar x) . universe
newGraph :: [(Link EntryInfo, ArgPos, Type)] -> Graph
newGraph = Graph . Map.map newNode . foldl' f Map.empty
where f mp x = Map.insertWith (++) (typeStructure $ thd3 x) [x] mp
newNode :: [(Link EntryInfo, ArgPos, Type)] -> [Node]
newNode = map (uncurry Node) . sortGroupFsts . map (\(a,b,c) -> (typeUnstructure c,(a,b)))
graphSearch :: Graph -> Type -> [ResultArg]
graphSearch (Graph mp) t = [ResultArg e p b | (b,ep) <- sortFst xs, (e,p) <- ep]
where
xs = f newBinding s ++ f newBindingRebox (TApp (TVar "") [s]) ++
concat [f newBindingUnbox x | TApp (TVar "") [x] <- [s]]
u = typeUnstructure t
s = typeStructure t
f bind x = mapMaybe (graphCheck bind u) $ Map.findWithDefault [] x mp
graphCheck :: Binding -> [Type] -> Node -> Maybe (Binding, [(Link EntryInfo,ArgPos)])
graphCheck b xs (Node ys res) = do
b <- f b (zip xs ys)
return (b, res)
where
f b [] = Just b
f b (x:xs) = do
b <- addBinding x b
f b xs