Item.hs

{-# LANGUAGE DeriveDataTypeable #-}

module Hoogle.Type.Item where

import General.Base
import Data.Binary.Defer
import Data.Binary.Defer.Index
import Hoogle.Type.Documentation
import Hoogle.Type.TagStr
import Hoogle.Type.TypeSig
import Data.Generics.Uniplate


type Input = ([Fact], [TextItem])


data TextItem = TextItem
    {itemLevel :: Int -- 0 = package, 1 = module, >2 = entry
    ,itemKey :: String -- how i should be searched for (name for most things, last module component for modules)
    ,itemName :: String -- what is the full text representation of me (key for most things, A.B.C for modules)
    ,itemType :: Maybe TypeSig
    ,itemDisp :: TagStr -- TagColor 0 for result type, TagColor 1.. for arg types, TagBold for name
    ,itemURL :: URL
    ,itemDocs :: String
    ,itemPriority :: Int -- priority, 0 is highest priority
    }
    deriving Show

data Fact
    = FactAlias TypeSig TypeSig
    | FactInstance TypeSig
    | FactDataKind String Int
    | FactClassKind String Int
    | FactCtorType String String -- Ctor, Data
      deriving Show


data Entry = Entry
    {entryPackage :: Maybe (Link Entry)
    ,entryModule :: Maybe (Link Entry)
    ,entryName :: String
    ,entryText :: TagStr
    ,entryDocs :: Documentation
    ,entryURL :: URL
    ,entryPriority :: Int
    ,entryKey :: String -- used only for rebuilding combined databases
    ,entryType :: Maybe TypeSig -- used only for rebuilding combined databases
    }
    deriving (Typeable)


data EntryView = FocusOn String -- characters in the range should be focused
               | ArgPosNum Int Int -- argument a b, a is remapped to b
                 deriving Show


renderEntryText :: [EntryView] -> TagStr -> TagStr
renderEntryText view = transform f
    where
        cols = [(b+1,a+1) | ArgPosNum a b <- view]
        strs = [map toLower x | FocusOn x <- view]

        f (TagColor i x) = maybe x (`TagColor` x) $ lookup i $ [(0,0)|cols/=[]] ++ cols
        f (TagBold (Str xs)) = TagBold $ Tags $ g xs
        f x = x

        g xs | ss /= [] = TagEmph (Str a) : g b
            where ss = filter (`isPrefixOf` map toLower xs) strs
                  (a,b) = splitAt (maximum $ map length ss) xs
        g (x:xs) = Str [x] : g xs
        g [] = []


-- TODO: EntryScore is over-prescriptive, and not overly useful
--       Have name and type scores to it themselves, using name only
--       to break ties when merging
-- the entry priority
-- the name of the entry, in lower case
-- the name of the entry
-- the module
data EntryScore = EntryScore Int String String String
                  deriving (Eq,Ord)


entryScore :: Entry -> EntryScore
entryScore e = EntryScore (entryPriority e) (map toLower $ entryName e) (entryName e) m
    where m = maybe [] (entryName . fromLink) $ entryModule e

instance Show Entry where
    show e = unwords [showTagText $ entryText e, m]
        where
            m = case entryModule e of
                    Nothing -> ""
                    Just y -> "{#" ++ show (linkKey y) ++ "}"

instance BinaryDefer Entry where
    put (Entry a b c d e f g h i) = put9 a b c d e f g h i
    get = get9 Entry