module Hoogle.Type.Item where
import General.Base
import General.Util
import Hoogle.Store.All
import Hoogle.Type.Docs
import Hoogle.Type.TagStr
import Hoogle.Type.TypeSig
import Data.Generics.Uniplate
type Input = ([Fact], [TextItem])
data ItemKind = PackageItem
| ModuleItem
| FunctionItem
| DataCtorItem
| TypeCtorItem
| TypeSynonymItem
| ClassItem
| InstanceItem
| UnclassifiedItem
deriving (Data,Typeable,Show,Eq,Enum)
instance NFData ItemKind where
rnf = rnf . fromEnum
data TextItem = TextItem
{itemLevel :: Int
,itemKind :: ItemKind
,itemKey :: String
,itemName :: String
,itemType :: Maybe TypeSig
,itemDisp :: TagStr
,itemURL :: URL
,itemDocs :: String
,itemPriority :: Int
}
deriving Show
data Fact
= FactAlias TypeSig TypeSig
| FactInstance TypeSig
| FactDataKind String Int
| FactClassKind String Int
| FactCtorType String String
deriving Show
data Entry = Entry
{entryLocations :: [(URL, [Once Entry])]
,entryKind :: ItemKind
,entryLevel :: Int
,entryName :: String
,entryText :: TagStr
,entryDocs :: Docs
,entryPriority :: Int
,entryKey :: String
,entryType :: Maybe TypeSig
}
deriving (Eq, Typeable)
instance NFData Entry where
rnf ent@(Entry a b c d e f g h i) = rnf (map (second $ map (f . fromOnce)) a,b,c,d,e,f,g,h,i)
where f ent2 = if entryUnique ent == entryUnique ent2 then () else rnf ent2
entryUnique Entry{..} = (entryName, entryText, entryDocs, entryKey, entryType)
entryJoin e1 e2 = e1
{entryPriority = min (entryPriority e1) (entryPriority e2)
,entryLocations = nubOn (map (entryName . fromOnce) . snd) $ concatMap entryLocations $
if entryScore e1 < entryScore e2 then [e1,e2] else [e2,e1]}
entryURL e = head $ map fst (entryLocations e) ++ [""]
data EntryView = FocusOn String
| ArgPosNum Int Int
deriving (Eq, 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 [] = []
data EntryScore = EntryScore Int String String
deriving (Eq,Ord)
entryScore :: Entry -> EntryScore
entryScore e = EntryScore (entryPriority e) (map toLower $ entryName e) (entryName e)
instance Show Entry where
show = showTagText . entryText
instance Store 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
instance Store Fact where
put (FactAlias x y) = putByte 0 >> put2 x y
put (FactInstance x) = putByte 1 >> put1 x
put (FactDataKind x y) = putByte 2 >> put2 x y
put (FactClassKind x y) = putByte 3 >> put2 x y
put (FactCtorType x y) = putByte 4 >> put2 x y
get = do i <- getByte
case i of
0 -> get2 FactAlias
1 -> get1 FactInstance
2 -> get2 FactDataKind
3 -> get2 FactClassKind
4 -> get2 FactCtorType
instance Store ItemKind where
put PackageItem = putByte 0
put ModuleItem = putByte 1
put FunctionItem = putByte 2
put DataCtorItem = putByte 4
put TypeCtorItem = putByte 5
put TypeSynonymItem = putByte 6
put ClassItem = putByte 7
put InstanceItem = putByte 8
put UnclassifiedItem = putByte 9
get = do i <- getByte
case i of
0 -> get0 PackageItem
1 -> get0 ModuleItem
2 -> get0 FunctionItem
3 -> get0 FunctionItem
4 -> get0 DataCtorItem
5 -> get0 TypeCtorItem
6 -> get0 TypeSynonymItem
7 -> get0 ClassItem
8 -> get0 InstanceItem
9 -> get0 UnclassifiedItem