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

module Input.Hoogle(parseHoogle, renderItem) where

import Language.Haskell.Exts as HSE
import Data.Char
import Data.List.Extra
import Data.Maybe
import Input.Item
import General.Util
import Control.DeepSeq
import Data.IORef.Extra
import System.IO.Unsafe
import Control.Monad.Trans.Class
import qualified Data.Map as Map
import Data.Generics.Uniplate.Data
import General.Conduit
import Control.Monad.Extra
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 file name (for errors), feed in lines to the conduit and emit either errors or items
parseHoogle :: Monad m => (String -> m ()) -> FilePath -> LStr -> Producer m (Target, Item)
parseHoogle warning file body = sourceLStr body =$= linesCR =$= zipFromC 1 =$= parserC warning file =$= hierarchyC hackage =$= mapC (\x -> rnf x `seq` x)

parserC :: Monad m => (String -> m ()) -> FilePath -> Conduit (Int, Str) m (Target, Item)
parserC warning 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 -> do
                        -- there are 38K instances of :: GLenum in the OpenGLRaw package, so speed them up (saves 16s + 100Mb)
                        yield (Target url Nothing Nothing "" (renderItem $ glenum $ strUnpack s) $ reformat $ reverse $ map strUnpack com, glenum $ strUnpack s)
                        f [] ""
                  | otherwise -> do
                        case parseLine $ fixLine $ strUnpack s of
                            Left y -> lift $ warning $ 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 ->
                                if isNothing $ readItem $ showItem x
                                then lift $ warning $ file ++ ":" ++ show i ++ ":failed to roundtrip: " ++ fixLine (strUnpack s)
                                else yield (Target url Nothing Nothing (typeItem x) (renderItem x) $ reformat $ reverse $ map strUnpack com, descendBi stringShare x)
                        f [] ""

typeItem (IPackage x) = "package"
typeItem (IModule x) = "module"
typeItem _ = ""


-- FIXME: used to be in two different modules, now does and then undoes lots of stuff
reformat = trimStart . replace "<p>" "" . replace "</p>" "\n" . unwords . lines .
           unlines . replace ["</p>","<p>"] ["</p><p>"] . concatMap f . wordsBy (== "")
    where f xs@(x:_) | x `elem` ["<pre>","<ul>"] = xs
          f xs = ["<p>",unwords xs,"</p>"]


hierarchyC :: Monad m => String -> Conduit (Target, Item) m (Target, Item)
hierarchyC hackage = void $ mapAccumC f (Nothing, Nothing)
    where
        f (pkg, mod) (t, IPackage x) = ((Just (x, url), Nothing), (t{targetURL=url}, IPackage x))
            where url = targetURL t `orIfNull` hackage ++ "package/" ++ x
        f (pkg, mod) (t, IModule x) = ((pkg, Just (x, url)), (t{targetPackage=pkg, targetURL=url}, IModule x))
            where url = targetURL t `orIfNull` maybe "" snd pkg ++ "/docs/" ++ replace "." "-" x ++ ".html" 
        f (pkg, mod) (t, IDecl x) = ((pkg, mod), (t{targetPackage=pkg, targetModule=mod, targetURL=url}, IDecl x))
            where url = targetURL t `orIfNull` maybe "" snd mod ++ "#" ++ declURL x

        orIfNull x y = if null x then y else x

        declURL (TypeSig _ [name] _) = "v:" ++ esc (fromName name)<commit_msg>Remove the readItem/showItem check, since I no longer use readItem later on<commit_after>{-# LANGUAGE ViewPatterns, PatternGuards, TupleSections, OverloadedStrings, Rank2Types #-}

module Input.Hoogle(parseHoogle, renderItem) where

import Language.Haskell.Exts as HSE
import Data.Char
import Data.List.Extra
import Input.Item
import General.Util
import Control.DeepSeq
import Data.IORef.Extra
import System.IO.Unsafe
import Control.Monad.Trans.Class
import qualified Data.Map as Map
import Data.Generics.Uniplate.Data
import General.Conduit
import Control.Monad.Extra
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 file name (for errors), feed in lines to the conduit and emit either errors or items
parseHoogle :: Monad m => (String -> m ()) -> FilePath -> LStr -> Producer m (Target, Item)
parseHoogle warning file body = sourceLStr body =$= linesCR =$= zipFromC 1 =$= parserC warning file =$= hierarchyC hackage =$= mapC (\x -> rnf x `seq` x)

parserC :: Monad m => (String -> m ()) -> FilePath -> Conduit (Int, Str) m (Target, Item)
parserC warning 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 -> do
                        -- there are 38K instances of :: GLenum in the OpenGLRaw package, so speed them up (saves 16s + 100Mb)
                        yield (Target url Nothing Nothing "" (renderItem $ glenum $ strUnpack s) $ reformat $ reverse $ map strUnpack com, glenum $ strUnpack s)
                        f [] ""
                  | otherwise -> do
                        case parseLine $ fixLine $ strUnpack s of
                            Left y -> lift $ warning $ 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 (Target url Nothing Nothing (typeItem x) (renderItem x) $ reformat $ reverse $ map strUnpack com, descendBi stringShare x)
                        f [] ""

typeItem (IPackage x) = "package"
typeItem (IModule x) = "module"
typeItem _ = ""


-- FIXME: used to be in two different modules, now does and then undoes lots of stuff
reformat = trimStart . replace "<p>" "" . replace "</p>" "\n" . unwords . lines .
           unlines . replace ["</p>","<p>"] ["</p><p>"] . concatMap f . wordsBy (== "")
    where f xs@(x:_) | x `elem` ["<pre>","<ul>"] = xs
          f xs = ["<p>",unwords xs,"</p>"]


hierarchyC :: Monad m => String -> Conduit (Target, Item) m (Target, Item)
hierarchyC hackage = void $ mapAccumC f (Nothing, Nothing)
    where
        f (pkg, mod) (t, IPackage x) = ((Just (x, url), Nothing), (t{targetURL=url}, IPackage x))
            where url = targetURL t `orIfNull` hackage ++ "package/" ++ x
        f (pkg, mod) (t, IModule x) = ((pkg, Just (x, url)), (t{targetPackage=pkg, targetURL=url}, IModule x))
            where url = targetURL t `orIfNull` maybe "" snd pkg ++ "/docs/" ++ replace "." "-" x ++ ".html" 
        f (pkg, mod) (t, IDecl x) = ((pkg, mod), (t{targetPackage=pkg, targetModule=mod, targetURL=url}, IDecl x))
            where url = targetURL t `orIfNull` maybe "" snd mod ++ "#" ++ declURL x

        orIfNull x y = if null x then y else x

        declURL (TypeSig _ [name] _) = "v:" ++ esc (fromName name)
{'fraction_non_alphanumeric': 0.12898950855880728, 'fraction_numerical': 0.006184428492545555, 'mean_word_length': 2.215909090909091, 'pattern_counts': {'":': 6, '<': 37, '<?xml version=': 0, '>': 77, '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': '7515658', 'n_tokens_mistral': 2856, 'n_tokens_neox': 2677, 'n_words': 1022}