<commit_before>{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, OverloadedStrings #-}

module Input.Hoogle(parseHoogle, parseHoogleC) where

import Language.Haskell.Exts as HSE
import Data.Char
import Data.List.Extra
import Data.Maybe
import Input.Type
import General.Util
import Data.IORef.Extra
import System.IO.Unsafe
import qualified Data.Map as Map
import Data.Generics.Uniplate.Data
import General.Conduit
import Control.Monad.Extra
import Data.Functor.Identity
import General.Str


hackage = "https://hackage.haskell.org/"


{-# NOINLINE strings #-}
strings :: IORef (Map.Map Name Name)
strings = unsafePerformIO $ newIORef Map.empty

-- Increases creation time from 27s to 28s
-- Reduces peak memory from 767Mb to 625Mb, and maximum resident with profiling from 100Mb to 45Mb
-- Using Name over String is about 20% better
stringShare :: Name -> Name
stringShare x = unsafePerformIO $ do
    mp <- readIORef strings
    case Map.lookup x mp of
        Just x -> return x
        Nothing -> do
            writeIORef' strings $ Map.insert x x mp
            return x


-- | Given a Hoogle database, grab the Item (Right), or things I failed to parse (Left)
parseHoogle :: FilePath -> LStr -> [Either String ItemEx]
parseHoogle file body = list' $ runIdentity $ runConduit $ sourceLStr body |> linesCR |> parseHoogleC file |> sinkList

-- | Given a file name (for errors), feed in lines to the conduit and emit either errors or items
parseHoogleC :: Monad m => FilePath -> Conduit Str m (Either String ItemEx)
parseHoogleC file = zipFromC 1 |> parserC file |> rightsC (hierarchyC hackage)

parserC :: Monad m => FilePath -> Conduit (Int, Str) m (Either String ItemEx)
parserC file = f [] ""
    where
        f com url = do
            x <- await
            whenJust x $ \(i,s) -> case () of
                _ | Just s <- strStripPrefix "-- | " s -> f [s] url
                  | Just s <- strStripPrefix "--" s -> f (if null com then [] else strTrimStart s : com) url
                  | Just s <- strStripPrefix "@url " s -> f com (strUnpack s)
                  | strNull $ strTrimStart s -> f [] ""
                  | otherwise -> do
                        case parseLine $ fixLine $ strUnpack s of
                            Left y -> yield $ Left $ file ++ ":" ++ show i ++ ":" ++ y
                            -- only check Nothing as some items (e.g. "instance () :> Foo a")
                            -- don't roundtrip but do come out equivalent
                            Right xs -> forM_ xs $ \x -> yield $
                                if isNothing $ readItem $ showItem x
                                then Left $ file ++ ":" ++ show i ++ ":failed to roundtrip: " ++ fixLine (strUnpack s)<commit_msg>Optimise parsing OpenGLRaw for GLenum, good time and memory saving<commit_after>{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, OverloadedStrings #-}

module Input.Hoogle(parseHoogle, parseHoogleC) where

import Language.Haskell.Exts as HSE
import Data.Char
import Data.List.Extra
import Data.Maybe
import Input.Type
import General.Util
import Data.IORef.Extra
import System.IO.Unsafe
import qualified Data.Map as Map
import Data.Generics.Uniplate.Data
import General.Conduit
import Control.Monad.Extra
import Data.Functor.Identity
import General.Str


hackage = "https://hackage.haskell.org/"


{-# NOINLINE strings #-}
strings :: IORef (Map.Map Name Name)
strings = unsafePerformIO $ newIORef Map.empty

-- Increases creation time from 27s to 28s
-- Reduces peak memory from 767Mb to 625Mb, and maximum resident with profiling from 100Mb to 45Mb
-- Using Name over String is about 20% better
stringShare :: Name -> Name
stringShare x = unsafePerformIO $ do
    mp <- readIORef strings
    case Map.lookup x mp of
        Just x -> return x
        Nothing -> do
            writeIORef' strings $ Map.insert x x mp
            return x


-- | Given a Hoogle database, grab the Item (Right), or things I failed to parse (Left)
parseHoogle :: FilePath -> LStr -> [Either String ItemEx]
parseHoogle file body = list' $ runIdentity $ runConduit $ sourceLStr body |> linesCR |> parseHoogleC file |> sinkList

-- | Given a file name (for errors), feed in lines to the conduit and emit either errors or items
parseHoogleC :: Monad m => FilePath -> Conduit Str m (Either String ItemEx)
parseHoogleC file = zipFromC 1 |> parserC file |> rightsC (hierarchyC hackage)

parserC :: Monad m => FilePath -> Conduit (Int, Str) m (Either String ItemEx)
parserC file = f [] ""
    where
        glenum x = IDecl $ TypeSig (SrcLoc "<unknown>.hs" 1 1) [Ident x] (TyCon (UnQual (Ident "GLenum")))

        f com url = do
            x <- await
            whenJust x $ \(i,s) -> case () of
                _ | Just s <- strStripPrefix "-- | " s -> f [s] url
                  | Just s <- strStripPrefix "--" s -> f (if null com then [] else strTrimStart s : com) url
                  | Just s <- strStripPrefix "@url " s -> f com (strUnpack s)
                  | strNull $ strTrimStart s -> f [] ""
                  | Just s <- strStripSuffix " :: GLenum" s ->
                        -- there are 38K instances of :: GLenum in the OpenGLRaw package, so speed them up (saves 16s + 100Mb)
                        yield $ Right $ ItemEx (glenum $ strUnpack s) url Nothing Nothing (reformat $ reverse $ map strUnpack com)
                  | otherwise -> do
                        case parseLine $ fixLine $ strUnpack s of
                            Left y -> yield $ Left $ file ++ ":" ++ show i ++ ":" ++ y
                            -- only check Nothing as some items (e.g. "instance () :> Foo a")
                            -- don't roundtrip but do come out equivalent
                            Right xs -> forM_ xs $ \x -> yield $
                                if isNothing $ readItem $ showItem x
                                then Left $ file ++ ":" ++ show i ++ ":failed to roundtrip: " ++ fixLine (strUnpack s)
{'fraction_non_alphanumeric': 0.0986908358509567, 'fraction_numerical': 0.0075528700906344415, 'mean_word_length': 2.1679957469431153, 'pattern_counts': {'":': 8, '<': 15, '<?xml version=': 0, '>': 53, 'https://': 2, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4290916', 'n_tokens_mistral': 1818, 'n_tokens_neox': 1671, 'n_words': 660}