module Hoogle.DataBase.Items where

import Control.Monad.State
import Data.Binary.Defer.Index
import General.Code
import Hoogle.TextBase.All
import Hoogle.TypeSig.All
import Hoogle.Item.All
import Data.Binary.Defer hiding (get,put)
import qualified Data.Binary.Defer as D

-- Invariant: Index Entry is by order of EntryScore

data Items = Items
    {packages :: Index Package
    ,modules :: Index Module
    ,entries :: Index Entry
    }

instance BinaryDefer Items where
    put (Items a b c) = put3 a b c
    get = do
        res@(Items a b c) <- get3 Items
        getDeferPut a
        getDeferPut b
        getDeferPut c
        return res


instance Show Items where
    show (Items a b c) = f "Packages" a ++ "\n" ++ f "Modules" b ++ "\n" ++ f "Entries" c
        where f header x = "== " ++ header ++ " ==\n\n" ++ show x


-- temporary state structure
data S a = S {count :: Int, values :: [a]}

newS = S (-1) []
newIndexS = newIndex . reverse . values
addS x (S i xs) = S (i+1) (x:xs)
getS (S i (x:xs)) = newLink i x
getS _ = error "DataBase.Items.getS, lacking a package/module?"


entriesItems :: Items -> [Link Entry]
entriesItems = indexLinks . entries


createItems :: [(TextItem,String)] -> Items
createItems xs = Items (newIndexS pkgs) (newIndexS mods)
                       (newIndex $ sortOn entryScore ents)
    where
        (ents, (pkgs,mods)) = flip runState (newS,newS) $ concatMapM addTextItem $ init $ tails xs


-- add a TextItem to the state S
addTextItem :: [(TextItem,String)] -> State (S Package, S Module) [Entry]
addTextItem ((ti,doc):rest) = case ti of
    ItemInstance{} -> return []

    ItemAttribute "keyword" name ->
        add False EntryKeyword [Keyword "keyword",Text " ",Focus name]

    ItemAttribute "package" name -> do
        modify $ \(ps,ms) -> (addS (addPkg (Package name "" "" "") rest) ps, ms)
        add False EntryPackage [Keyword "package",Text " ",Focus name]

    ItemAttribute _ _ -> return []

    ItemModule xs -> do
        modify $ \(ps,ms) -> (ps, addS (Module xs) ms)
        add True EntryModule [Keyword "module", Text $ ' ' : concatMap (++ ".") (init xs), Focus (last xs)]

    _ -> add True EntryOther (renderTextItem ti)
    where
        add modu typ txt = do
            (ps,ms) <- get
            let sig = case ti of ItemFunc _ s -> Just (Defer s); _ -> Nothing
            return [Entry (if modu then Just $ getS ms else Nothing) (getS ps)
                          (headDef "" [i | Focus i <- txt])
                          txt typ (newHaddock doc) sig]

        addPkg pkg ((ItemAttribute "version" x,_) : xs) = addPkg pkg{packageVersion=x} xs
        addPkg pkg ((ItemAttribute "haddock" x,_) : xs) = addPkg pkg{haddockURL    =x} xs
        addPkg pkg ((ItemAttribute "hackage" x,_) : xs) = addPkg pkg{hackageURL    =x} xs
        addPkg pkg _ = pkg


mergeItems :: [Items] -> Items
mergeItems [x] = x
mergeItems xs = Items
        (newIndex $ concat $ reverse ps)
        (newIndex $ concat $ reverse ms)
        (newIndex $ sortOn entryScore $ concat $ reverse es)
    where
        (pi,ps,mi,ms,ei,es) = foldl' f (0,[],0,[],0,[]) xs

        f (pi,ps,mi,ms,ei,es) (Items p m e) =
                (pi+length p3,p3:ps, mi+length m3,m3:ms, ei+length e3,e3:es)
            where
                (p2,p3) = add pi p id
                (m2,m3) = add mi m id
                (e2,e3) = add ei e $ \x -> x{entryModule = liftM (\x -> m2 !! linkKey x) $ entryModule x
                                            ,entryPackage = p2 !! linkKey (entryPackage x)}

                add i xs f = (zipWith newLink [i..] xs2, xs2)
                    where xs2 = map (f . fromLink) $ indexLinks xs