    {-# LANGUAGE ViewPatterns, TupleSections, ScopedTypeVariables, DeriveDataTypeable, ForeignFunctionInterface, GADTs #-}

    module Output.Names(writeNames, searchNames) where

    import Data.List.Extra
    import qualified Data.ByteString.Char8 as BS
    import qualified Data.ByteString.Unsafe as BS
    import qualified Data.Vector.Storable as V
    import General.Str
    import Foreign.Ptr
    import Foreign.Marshal
    import Foreign.C.String
    import Foreign.C.Types
    import Control.Exception
    import System.IO.Unsafe
    import Data.Maybe

    import Input.Item
    import General.Util
    import General.Store

    foreign import ccall text_search_bound :: CString -> IO CInt

    foreign import ccall text_search :: CString -> Ptr CString -> CInt -> Ptr CInt -> IO CInt

    data NamesSize a where NamesSize :: NamesSize Int deriving Typeable
    data NamesItems a where NamesItems :: NamesItems (V.Vector TargetId) deriving Typeable
    data NamesText a where NamesText :: NamesText BS.ByteString deriving Typeable

    writeNames :: StoreWrite -> [(Maybe TargetId, Item)] -> IO ()
    writeNames :: StoreWrite -> [(Maybe TargetId, Item)] -> IO ()
    writeNames StoreWrite
    store [(Maybe TargetId, Item)]
    xs = do
        let ([TargetId]
    ids, [String]
    strs) = [(TargetId, String)] -> ([TargetId], [String])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(TargetId
    i, [Char
    ' ' | String -> Bool
    isUpper1 String
    name] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    lower String
    name) | (Just TargetId
    i, Item
    x) <- [(Maybe TargetId, Item)]
    xs, String
    name <- Item -> [String]
    itemNamePart Item
    x]
        let b :: ByteString
    b = [String] -> ByteString
    bstr0Join ([String] -> ByteString) -> [String] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [String]
    strs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String
    "",String
    ""]
        bound <- ByteString -> (Ptr CChar -> IO CInt) -> IO CInt
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
    BS.unsafeUseAsCString ByteString
    b ((Ptr CChar -> IO CInt) -> IO CInt)
    -> (Ptr CChar -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ \Ptr CChar
    ptr -> Ptr CChar -> IO CInt
    text_search_bound Ptr CChar
    ptr
        storeWrite store NamesSize $ fromIntegral bound
        storeWrite store NamesItems $ V.fromList ids
        storeWrite store NamesText b

    itemNamePart :: Item -> [String]
    itemNamePart :: Item -> [String]
    itemNamePart (IModule ModName
    x) = [[String] -> String
    forall a. HasCallStack => [a] -> a
    last ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> [String]
    forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
    splitOn String
    "." (String -> [String]) -> String -> [String]
    forall a b. (a -> b) -> a -> b
    $ ModName -> String
    strUnpack ModName
    x]
    itemNamePart Item
    x = Maybe String -> [String]
    forall a. Maybe a -> [a]
    maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
    forall a b. (a -> b) -> a -> b
    $ ModName -> String
    strUnpack (ModName -> String) -> Maybe ModName -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Item -> Maybe ModName
    itemName Item
    x

    searchNames :: StoreRead -> Bool -> [String] -> [TargetId]
    -- very important to not search for [" "] or [] since the output buffer is too small
    searchNames :: StoreRead -> Bool -> [String] -> [TargetId]
    searchNames StoreRead
    store Bool
    exact ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    "") ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    trim -> [String]
    xs) = IO [TargetId] -> [TargetId]
    forall a. IO a -> a
    unsafePerformIO (IO [TargetId] -> [TargetId]) -> IO [TargetId] -> [TargetId]
    forall a b. (a -> b) -> a -> b
    $ do
        let vs :: Vector TargetId
    vs = StoreRead -> NamesItems (Vector TargetId) -> Vector TargetId
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store NamesItems (Vector TargetId)
    NamesItems
        -- if there are no questions, we will match everything, which exceeds the result buffer
        if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    xs then [TargetId] -> IO [TargetId]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([TargetId] -> IO [TargetId]) -> [TargetId] -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ Vector TargetId -> [TargetId]
    forall a. Storable a => Vector a -> [a]
    V.toList Vector TargetId
    vs else do
            let tweak :: String -> ByteString
    tweak String
    x = String -> ByteString
    bstrPack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char
    ' ' | String -> Bool
    isUpper1 String
    x] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    lower String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\0"
            IO (Ptr CInt)
    -> (Ptr CInt -> IO ())
    -> (Ptr CInt -> IO [TargetId])
    -> IO [TargetId]
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket (Int -> IO (Ptr CInt)
    forall a. Storable a => Int -> IO (Ptr a)
    mallocArray (Int -> IO (Ptr CInt)) -> Int -> IO (Ptr CInt)
    forall a b. (a -> b) -> a -> b
    $ StoreRead -> NamesSize Int -> Int
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store NamesSize Int
    NamesSize) Ptr CInt -> IO ()
    forall a. Ptr a -> IO ()
    free ((Ptr CInt -> IO [TargetId]) -> IO [TargetId])
    -> (Ptr CInt -> IO [TargetId]) -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ \Ptr CInt
    result ->
                ByteString -> (Ptr CChar -> IO [TargetId]) -> IO [TargetId]
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
    BS.unsafeUseAsCString (StoreRead -> NamesText ByteString -> ByteString
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store NamesText ByteString
    NamesText) ((Ptr CChar -> IO [TargetId]) -> IO [TargetId])
    -> (Ptr CChar -> IO [TargetId]) -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ \Ptr CChar
    haystack ->
                    [(Ptr CChar -> IO [TargetId]) -> IO [TargetId]]
    -> ([Ptr CChar] -> IO [TargetId]) -> IO [TargetId]
    forall a r. [(a -> r) -> r] -> ([a] -> r) -> r
    withs ((String -> (Ptr CChar -> IO [TargetId]) -> IO [TargetId])
    -> [String] -> [(Ptr CChar -> IO [TargetId]) -> IO [TargetId]]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString -> (Ptr CChar -> IO [TargetId]) -> IO [TargetId]
    forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
    BS.unsafeUseAsCString (ByteString -> (Ptr CChar -> IO [TargetId]) -> IO [TargetId])
    -> (String -> ByteString)
    -> String
    -> (Ptr CChar -> IO [TargetId])
    -> IO [TargetId]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    tweak) [String]
    xs) (([Ptr CChar] -> IO [TargetId]) -> IO [TargetId])
    -> ([Ptr CChar] -> IO [TargetId]) -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ \[Ptr CChar]
    needles ->
                        Ptr CChar
    -> [Ptr CChar]
    -> (Ptr (Ptr CChar) -> IO [TargetId])
    -> IO [TargetId]
    forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
    withArray0 Ptr CChar
    forall a. Ptr a
    nullPtr [Ptr CChar]
    needles ((Ptr (Ptr CChar) -> IO [TargetId]) -> IO [TargetId])
    -> (Ptr (Ptr CChar) -> IO [TargetId]) -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ \Ptr (Ptr CChar)
    needles -> do
                            found <- Ptr CChar -> Ptr (Ptr CChar) -> CInt -> Ptr CInt -> IO CInt
    c_text_search Ptr CChar
    haystack Ptr (Ptr CChar)
    needles (if Bool
    exact then CInt
    1 else CInt
    0) Ptr CInt
    result
                            xs <- peekArray (fromIntegral found) result
                            pure $ map ((vs V.!) . fromIntegral) xs

    {-# NOINLINE c_text_search #-} -- for profiling
    c_text_search :: Ptr CChar -> Ptr (Ptr CChar) -> CInt -> Ptr CInt -> IO CInt
    c_text_search Ptr CChar
    a Ptr (Ptr CChar)
    b CInt
    c Ptr CInt
    d = Ptr CChar -> Ptr (Ptr CChar) -> CInt -> Ptr CInt -> IO CInt
    text_search Ptr CChar
    a Ptr (Ptr CChar)
    b CInt
    c Ptr CInt
    d