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