{-# LANGUAGE DeriveDataTypeable #-}
{-|
    Search for a type signature and context through a graph.

    Return results in best-first order, taking account of which
    nodes and edges have already been paid for.
-}

module Hoogle.DataBase.TypeSearch.Graph(
    Graph, newGraph,
    graphSearch
    ) where

import Hoogle.DataBase.TypeSearch.Binding
import Hoogle.DataBase.TypeSearch.Result
import Hoogle.Type.All
import Data.Generics.Uniplate
import Hoogle.Store.All
import qualified Data.Map as Map
import General.Base
import General.Util



newtype Graph = Graph (Map.Map Type [Node])

-- the Type's are stored in reverse, to make box/unbox computations quicker
data Node = Node [Type] [(Once EntryInfo,ArgPos)]
            deriving Typeable


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 b | (a,b) <- xs]


instance Store Graph where
    put (Graph a) = put1 a
    get = get1 Graph

instance Store Node where
    put (Node a b) = put2 a b
    get = get2 Node


---------------------------------------------------------------------
-- GRAPH CONSTRUCTION


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 :: [(Once 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 :: [(Once EntryInfo, ArgPos, Type)] -> [Node]
newNode = map (uncurry Node) . sortGroupFsts . map (\(a,b,c) -> (typeUnstructure c,(a,b)))




---------------------------------------------------------------------
-- GRAPH SEARCHING

-- must search for each (node,bindings) pair, rather than just nodes

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, [(Once 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