module Hoogle.DataBase.TypeSearch.TypeScore(
TypeScore, newTypeScore, costTypeScore, costsTypeScore
) where
import General.Base
import Hoogle.Score.All
import Hoogle.DataBase.TypeSearch.Binding
import Hoogle.DataBase.TypeSearch.EntryInfo
import Hoogle.DataBase.Instances
import Hoogle.Type.All
data TypeScore = TypeScore
{costTypeScore :: !Int
,badargs :: Int
,badorder :: Bool
,bind :: Binding
,badInstance :: (TypeContext, TypeContext)
,badAlias :: ([String], [String])
}
instance Show TypeScore where
show t = unwords $
['#' : show (costTypeScore t)] ++
replicate (badargs t) "badarg" ++
["badorder" | badorder t] ++
[show $ bind t] ++
both inst (badInstance t) ++
both alis (badAlias t)
where
both f (a,b) = map (f "+") a ++ map (f "-") b
inst op (c,v) = c ++ op ++ v
alis op c = op ++ c
instance Eq TypeScore where
(==) = (==) `on` costTypeScore
instance Ord TypeScore where
compare = comparing costTypeScore
newTypeScore :: Instances -> EntryInfo -> EntryInfo -> Bool -> Binding -> TypeScore
newTypeScore is query result inorder bs = t{costTypeScore = calcScore t}
where
t = TypeScore 0
(entryInfoArity result entryInfoArity query)
(not inorder)
bs
(entryInfoContext query `diff` ctx)
(entryInfoAlias query `diff` entryInfoAlias result)
diff a b = (a \\ b, b \\ a)
ctx = nub $ concat [f c b | (c,v) <- entryInfoContext result, (b, TVar a) <- bindings bs, a == v]
f c (TVar v) = [(c,v)]
f c (TLit l) = [(c,l) | not $ hasInstance is c l]
calcScore :: TypeScore -> Int
calcScore t = costBinding (bind t) + sum (map cost $ costsTypeScoreLocal t)
costsTypeScoreLocal :: TypeScore -> [TypeCost]
costsTypeScoreLocal t =
CostDeadArg *+ badargs t ++
[CostArgReorder | badorder t] ++
CostAliasFwd *+ length (fst $ badAlias t) ++
CostAliasBwd *+ length (snd $ badAlias t) ++
CostInstanceAdd *+ length (fst $ badInstance t) ++
CostInstanceDel *+ length (snd $ badInstance t)
where (*+) = flip replicate
costsTypeScore :: TypeScore -> [TypeCost]
costsTypeScore t = costsBinding (bind t) ++ costsTypeScoreLocal t