    {-# 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 store :: StoreWrite
    store xs :: [(Maybe TargetId, Item)]
    xs = do
        let (ids :: [TargetId]
    ids, strs :: [[Char]]
    strs) = [(TargetId, [Char])] -> ([TargetId], [[Char]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(TargetId
    i, [' ' | [Char] -> Bool
    isUpper1 [Char]
    name] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    lower [Char]
    name) | (Just i :: TargetId
    i, x :: Item
    x) <- [(Maybe TargetId, Item)]
    xs, [Char]
    name <- Item -> [[Char]]
    itemNamePart Item
    x]
        let b :: BStr0
    b = [[Char]] -> BStr0
    bstr0Join ([[Char]] -> BStr0) -> [[Char]] -> BStr0
    forall a b. (a -> b) -> a -> b
    $ [[Char]]
    strs [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ ["",""]
        CInt
    bound <- BStr0 -> (CString -> IO CInt) -> IO CInt
    forall a. BStr0 -> (CString -> IO a) -> IO a
    BS.unsafeUseAsCString BStr0
    b ((CString -> IO CInt) -> IO CInt)
    -> (CString -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ \ptr :: CString
    ptr -> CString -> IO CInt
    text_search_bound CString
    ptr
        StoreWrite -> NamesSize Int -> Int -> IO ()
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreWrite -> t a -> a -> IO ()
    storeWrite StoreWrite
    store NamesSize Int
    NamesSize (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    bound
        StoreWrite
    -> NamesItems (Vector TargetId) -> Vector TargetId -> IO ()
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreWrite -> t a -> a -> IO ()
    storeWrite StoreWrite
    store NamesItems (Vector TargetId)
    NamesItems (Vector TargetId -> IO ()) -> Vector TargetId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [TargetId] -> Vector TargetId
    forall a. Storable a => [a] -> Vector a
    V.fromList [TargetId]
    ids
        StoreWrite -> NamesText BStr0 -> BStr0 -> IO ()
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreWrite -> t a -> a -> IO ()
    storeWrite StoreWrite
    store NamesText BStr0
    NamesText BStr0
    b

    itemNamePart :: Item -> [String]
    itemNamePart :: Item -> [[Char]]
    itemNamePart (IModule x :: ModName
    x) = [[[Char]] -> [Char]
    forall a. [a] -> a
    last ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> [[Char]]
    forall a. (Partial, Eq a) => [a] -> [a] -> [[a]]
    splitOn "." ([Char] -> [[Char]]) -> [Char] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ModName -> [Char]
    strUnpack ModName
    x]
    itemNamePart x :: Item
    x = Maybe [Char] -> [[Char]]
    forall a. Maybe a -> [a]
    maybeToList (Maybe [Char] -> [[Char]]) -> Maybe [Char] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ModName -> [Char]
    strUnpack (ModName -> [Char]) -> Maybe ModName -> Maybe [Char]
    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 -> [[Char]] -> [TargetId]
    searchNames store :: StoreRead
    store exact :: Bool
    exact (([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= "") ([[Char]] -> [[Char]])
    -> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    trim -> [[Char]]
    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 [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    xs then [TargetId] -> IO [TargetId]
    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 :: [Char] -> BStr0
    tweak x :: [Char]
    x = [Char] -> BStr0
    bstrPack ([Char] -> BStr0) -> [Char] -> BStr0
    forall a b. (a -> b) -> a -> b
    $ [' ' | [Char] -> Bool
    isUpper1 [Char]
    x] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    lower [Char]
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ "\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
    $ \result :: Ptr CInt
    result ->
                BStr0 -> (CString -> IO [TargetId]) -> IO [TargetId]
    forall a. BStr0 -> (CString -> IO a) -> IO a
    BS.unsafeUseAsCString (StoreRead -> NamesText BStr0 -> BStr0
    forall (t :: * -> *) a.
    (Typeable (t a), Typeable a, Stored a) =>
    StoreRead -> t a -> a
    storeRead StoreRead
    store NamesText BStr0
    NamesText) ((CString -> IO [TargetId]) -> IO [TargetId])
    -> (CString -> IO [TargetId]) -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ \haystack :: CString
    haystack ->
                    [(CString -> IO [TargetId]) -> IO [TargetId]]
    -> ([CString] -> IO [TargetId]) -> IO [TargetId]
    forall a r. [(a -> r) -> r] -> ([a] -> r) -> r
    withs (([Char] -> (CString -> IO [TargetId]) -> IO [TargetId])
    -> [[Char]] -> [(CString -> IO [TargetId]) -> IO [TargetId]]
    forall a b. (a -> b) -> [a] -> [b]
    map (BStr0 -> (CString -> IO [TargetId]) -> IO [TargetId]
    forall a. BStr0 -> (CString -> IO a) -> IO a
    BS.unsafeUseAsCString (BStr0 -> (CString -> IO [TargetId]) -> IO [TargetId])
    -> ([Char] -> BStr0)
    -> [Char]
    -> (CString -> IO [TargetId])
    -> IO [TargetId]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> BStr0
    tweak) [[Char]]
    xs) (([CString] -> IO [TargetId]) -> IO [TargetId])
    -> ([CString] -> IO [TargetId]) -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ \needles :: [CString]
    needles ->
                        CString
    -> [CString] -> (Ptr CString -> IO [TargetId]) -> IO [TargetId]
    forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
    withArray0 CString
    forall a. Ptr a
    nullPtr [CString]
    needles ((Ptr CString -> IO [TargetId]) -> IO [TargetId])
    -> (Ptr CString -> IO [TargetId]) -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ \needles :: Ptr CString
    needles -> do
                            CInt
    found <- CString -> Ptr CString -> CInt -> Ptr CInt -> IO CInt
    c_text_search CString
    haystack Ptr CString
    needles (if Bool
    exact then 1 else 0) Ptr CInt
    result
                            [CInt]
    xs <- Int -> Ptr CInt -> IO [CInt]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray (CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CInt
    found) Ptr CInt
    result
                            [TargetId] -> IO [TargetId]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([TargetId] -> IO [TargetId]) -> [TargetId] -> IO [TargetId]
    forall a b. (a -> b) -> a -> b
    $ (CInt -> TargetId) -> [CInt] -> [TargetId]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Vector TargetId
    vs Vector TargetId -> Int -> TargetId
    forall a. Storable a => Vector a -> Int -> a
    V.!) (Int -> TargetId) -> (CInt -> Int) -> CInt -> TargetId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) [CInt]
    xs

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