    {-# LANGUAGE RecordWildCards #-}

    module Hoogle.DataBase2.Str(
        createStr', searchStr',
        createStr, mergeStr, searchStr
        ) where

    import General.Base
    import Hoogle.DataBase2.Type
    import Hoogle.Type.All
    import Hoogle.Score.All
    import General.Util
    import Data.Binary
    import System.IO.Unsafe
    import System.FilePath
    import qualified General.FMIndex as FM
    import qualified Data.ByteString.Char8 as BS

    data Strs = Strs
        {posMaximum :: Pos
        ,posOffset :: [(Package, Pos)]
        ,fmIndex :: FM.FMIndex Pos
        } deriving Show

    posResolve :: Strs -> Pos -> (Package, Pos)
    posResolve Strs{..} p = f posOffset
        where
            f [(pkg,off)] = (pkg,p-off)
            f ((p1,o1):(p2,o2):rest)
                | p < o2 = (p1,p-o1)
                | otherwise = f $ (p2,o2):rest

    instance Binary Strs where
        put (Strs a b c) = put a >> put b >> put c
        get = Strs <$> get <*> get <*> get

    saveStr :: FilePath -> Strs -> IO ()
    saveStr = encodeFile

    loadStr :: FilePath -> IO Strs
    loadStr = decodeFile

    createStr :: Package -> [(Pos, BS.ByteString)] -> FilePath -> IO ()
    createStr pkg items file = saveStr file $ Strs (maximum $ 0 : map fst items) [(pkg, 0)] $ FM.create '\0' $ map ((BS.map toLower . snd) &&& fst) items

    mergeStr :: [FilePath] -> FilePath -> IO ()
    mergeStr xs file = do
        let f mx Strs{..} = (mx + posMaximum, Strs 0 (map (second (+mx)) posOffset) (fmap (+mx) fmIndex))
        (mx,xs) <- mapAccumL f 0 <$> mapM loadStr xs
        saveStr file $ Strs mx (concatMap posOffset xs) (FM.create '\0' $ concatMap (FM.extract . fmIndex) xs)

    searchStr :: [FilePath] -> BS.ByteString -> IO [(Package, Pos, [EntryView], Score)]
    searchStr files x = do
        files <- mapM loadStr files
        let locate (how1,how2) =
                [ ((pkg,pos),(pkg,pos,[FocusOn $ BS.unpack x],textScore how2))
                | file <- files
                , ((pkg,pos),_) <- map (first $ posResolve file) $ FM.locate (fmIndex file) how1 $ BS.map toLower x]
        return $ map snd $ nubOrdOn fst $ concatMap locate [(FM.Exact,MatchExact), (FM.Prefix,MatchPrefix), (FM.Infix,MatchSubstr)]

    ---------------------------------------------------------------------

    createStr' :: Package -> [(Pos, Entry)] -> FilePath -> IO ()
    createStr' pkg items out = createStr pkg (mapMaybe f items) out
        where f (pos, Entry{..}) = if null entryKey then Nothing else Just (pos, BS.pack entryKey)

    searchStr' :: (String -> Word32 -> IO Entry) -> [FilePath] -> String -> IO [Result]
    searchStr' resolve files x = do
        res <- searchStr (map (<.> "str") files) $ BS.pack x
        return $ flip map res $ \(Package a,Pos b,c,d) -> Result (unsafePerformIO $ resolve (BS.unpack a) b) c d