    {-# LANGUAGE ViewPatterns, TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards #-}

    module Action.Generate(actionGenerate) where

    import Data.List.Extra
    import System.FilePath
    import System.Directory.Extra
    import System.IO.Extra
    import Data.Tuple.Extra
    import Control.Exception.Extra
    import Data.IORef
    import Data.Maybe
    import qualified Data.Set as Set
    import qualified Data.Map.Strict as Map
    import Control.Monad.Extra
    import Data.Monoid
    import Data.Ord
    import System.Console.CmdArgs.Verbosity
    import Prelude

    import Output.Items
    import Output.Tags
    import Output.Names
    import Output.Types
    import Input.Cabal
    import Input.Haddock
    import Input.Download
    import Input.Reorder
    import Input.Set
    import Input.Settings
    import Input.Item
    import General.Util
    import General.Store
    import General.Timing
    import General.Str
    import Action.CmdLine
    import General.Conduit
    import Control.DeepSeq

    {-

    data GenList
        = GenList_Package String -- a literally named package
        | GenList_GhcPkg String -- command to run, or "" for @ghc-pkg list@
        | GenList_Stackage String -- URL of stackage file, defaults to @http://www.stackage.org/lts/cabal.config@
        | GenList_Dependencies String -- dependencies in a named .cabal file
        | GenList_Sort String -- URL of file to sort by, defaults to @http://packdeps.haskellers.com/reverse@

    data GenTags
        = GenTags_GhcPkg String -- command to run, or "" for @ghc-pkg dump@
        | GenTags_Diff FilePath -- a diff to apply to previous metadata
        | GenTags_Tarball String -- tarball of Cabal files, defaults to http://hackage.haskell.org/packages/index.tar.gz
        | GetTags_Cabal FilePath -- tarball to get tag information from

    data GenData
        = GenData_File FilePath -- a file containing package data
        | GenData_Tarball String -- URL where a tarball of data files resides

    * `hoogle generate` - generate for all things in Stackage based on Hackage information.
    * `hoogle generate --source=file1.txt --source=local --source=stackage --source=hackage --source=tarball.tar.gz`

    Which files you want to index. Currently the list on stackage, could be those locally installed, those in a .cabal file etc. A `--list` flag, defaults to `stackage=url`. Can also be `ghc-pkg`, `ghc-pkg=user` `ghc-pkg=global`. `name=p1`.

    Extra metadata you want to apply. Could be a file. `+shake author:Neil-Mitchell`, `-shake author:Neil-Mitchel`. Can be sucked out of .cabal files. A `--tags` flag, defaults to `tarball=url` and `diff=renamings.txt`.

    Where the haddock files are. Defaults to `tarball=hackage-url`. Can also be `file=p1.txt`. Use `--data` flag.

    Defaults to: `hoogle generate --list=ghc-pkg --list=constrain=stackage-url`.

    Three pieces of data:

    * Which packages to index, in order.
    * Metadata.

    generate :: Maybe Int -> [GenList] -> [GenTags] -> [GenData] -> IO ()
    -- how often to redownload, where to put the files

    generate :: FilePath -> [(String, [(String, String)])] -> [(String, LBS.ByteString)] -> IO ()
    generate output metadata = ...
    -}

    -- -- generate all
    -- @tagsoup -- generate tagsoup
    -- @tagsoup filter -- search the tagsoup package
    -- filter -- search all

    type Download = String -> URL -> IO FilePath

    readHaskellOnline :: Timing -> Settings -> Download -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
    readHaskellOnline :: Timing
    -> Settings
    -> Download
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellOnline Timing
    timing Settings
    settings Download
    download = do
        String
    stackageLts <- Download
    download String
    "haskell-stackage-lts.txt" String
    "https://www.stackage.org/lts/cabal.config"
        String
    stackageNightly <- Download
    download String
    "haskell-stackage-nightly.txt" String
    "https://www.stackage.org/nightly/cabal.config"
        String
    platform <- Download
    download String
    "haskell-platform.txt" String
    "https://raw.githubusercontent.com/haskell/haskell-platform/master/hptool/src/Releases2015.hs"
        String
    cabals   <- Download
    download String
    "haskell-cabal.tar.gz" String
    "https://hackage.haskell.org/packages/index.tar.gz"
        String
    hoogles  <- Download
    download String
    "haskell-hoogle.tar.gz" String
    "https://hackage.haskell.org/packages/hoogle.tar.gz"

        -- peakMegabytesAllocated = 2
        Set PkgName
    setStackage <- (String -> PkgName) -> Set String -> Set PkgName
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    Set.map String -> PkgName
    strPack (Set String -> Set PkgName) -> IO (Set String) -> IO (Set PkgName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Set String -> Set String -> Set String
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (Set String -> Set String -> Set String)
    -> IO (Set String) -> IO (Set String -> Set String)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Set String)
    setStackage String
    stackageLts IO (Set String -> Set String) -> IO (Set String) -> IO (Set String)
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> String -> IO (Set String)
    setStackage String
    stackageNightly)
        Set PkgName
    setPlatform <- (String -> PkgName) -> Set String -> Set PkgName
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    Set.map String -> PkgName
    strPack (Set String -> Set PkgName) -> IO (Set String) -> IO (Set PkgName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Set String)
    setPlatform String
    platform
        Set PkgName
    setGHC <- (String -> PkgName) -> Set String -> Set PkgName
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    Set.map String -> PkgName
    strPack (Set String -> Set PkgName) -> IO (Set String) -> IO (Set PkgName)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Set String)
    setGHC String
    platform

        Map PkgName Package
    cbl <- Timing
    -> String -> IO (Map PkgName Package) -> IO (Map PkgName Package)
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timed Timing
    timing String
    "Reading Cabal" (IO (Map PkgName Package) -> IO (Map PkgName Package))
    -> IO (Map PkgName Package) -> IO (Map PkgName Package)
    forall a b. (a -> b) -> a -> b
    $ Settings -> String -> IO (Map PkgName Package)
    parseCabalTarball Settings
    settings String
    cabals
        let want :: Set PkgName
    want = PkgName -> Set PkgName -> Set PkgName
    forall a. Ord a => a -> Set a -> Set a
    Set.insert (String -> PkgName
    strPack String
    "ghc") (Set PkgName -> Set PkgName) -> Set PkgName -> Set PkgName
    forall a b. (a -> b) -> a -> b
    $ [Set PkgName] -> Set PkgName
    forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
    Set.unions [Set PkgName
    setStackage, Set PkgName
    setPlatform, Set PkgName
    setGHC]
        Map PkgName Package
    cbl <- Map PkgName Package -> IO (Map PkgName Package)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package -> IO (Map PkgName Package))
    -> Map PkgName Package -> IO (Map PkgName Package)
    forall a b. (a -> b) -> a -> b
    $ ((PkgName -> Package -> Package)
     -> Map PkgName Package -> Map PkgName Package)
    -> Map PkgName Package
    -> (PkgName -> Package -> Package)
    -> Map PkgName Package
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (PkgName -> Package -> Package)
    -> Map PkgName Package -> Map PkgName Package
    forall k a b. (k -> a -> b) -> Map k a -> Map k b
    Map.mapWithKey Map PkgName Package
    cbl ((PkgName -> Package -> Package) -> Map PkgName Package)
    -> (PkgName -> Package -> Package) -> Map PkgName Package
    forall a b. (a -> b) -> a -> b
    $ \PkgName
    name Package
    p ->
            Package
    p{packageTags =
                [(strPack "set",strPack "included-with-ghc") | name `Set.member` setGHC] ++
                [(strPack "set",strPack "haskell-platform") | name `Set.member` setPlatform] ++
                [(strPack "set",strPack "stackage") | name `Set.member` setStackage] ++
                packageTags p}

        let source :: ConduitT i (PkgName, String, LBStr) IO ()
    source = do
                [(String, LBStr)]
    tar <- IO [(String, LBStr)]
    -> ConduitT i (PkgName, String, LBStr) IO [(String, LBStr)]
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [(String, LBStr)]
     -> ConduitT i (PkgName, String, LBStr) IO [(String, LBStr)])
    -> IO [(String, LBStr)]
    -> ConduitT i (PkgName, String, LBStr) IO [(String, LBStr)]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [(String, LBStr)]
    tarballReadFiles String
    hoogles
                [(String, LBStr)]
    -> ((String, LBStr) -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(String, LBStr)]
    tar (((String, LBStr) -> ConduitT i (PkgName, String, LBStr) IO ())
     -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ((String, LBStr) -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall a b. (a -> b) -> a -> b
    $ \(String -> PkgName
    strPack (String -> PkgName) -> (String -> String) -> String -> PkgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    takeBaseName -> PkgName
    name, LBStr
    src) ->
                    (PkgName, String, LBStr)
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield (PkgName
    name, PkgName -> String
    hackagePackageURL PkgName
    name, LBStr
    src)
        (Map PkgName Package, Set PkgName,
     ConduitT () (PkgName, String, LBStr) IO ())
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package
    cbl, Set PkgName
    want, ConduitT () (PkgName, String, LBStr) IO ()
    forall {i}. ConduitT i (PkgName, String, LBStr) IO ()
    source)

    readHaskellDirs :: Timing -> Settings -> [FilePath] -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
    readHaskellDirs :: Timing
    -> Settings
    -> [String]
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellDirs Timing
    timing Settings
    settings [String]
    dirs = do
        [String]
    files <- (String -> IO [String]) -> [String] -> IO [String]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM String -> IO [String]
    listFilesRecursive [String]
    dirs
        -- We reverse/sort the list because of #206
        -- Two identical package names with different versions might be foo-2.0 and foo-1.0
        -- We never distinguish on versions, so they are considered equal when reordering
        -- So put 2.0 first in the list and rely on stable sorting. A bit of a hack.
        let order :: String -> (String, Down [Int])
    order String
    a = ([Int] -> Down [Int]) -> (String, [Int]) -> (String, Down [Int])
    forall b b' a. (b -> b') -> (a, b) -> (a, b')
    second [Int] -> Down [Int]
    forall a. a -> Down a
    Down ((String, [Int]) -> (String, Down [Int]))
    -> (String, [Int]) -> (String, Down [Int])
    forall a b. (a -> b) -> a -> b
    $ String -> (String, [Int])
    parseTrailingVersion String
    a
        let packages :: [(PkgName, String)]
    packages = (String -> (PkgName, String)) -> [String] -> [(PkgName, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> PkgName
    strPack (String -> PkgName) -> (String -> String) -> String -> PkgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    takeBaseName (String -> PkgName)
    -> (String -> String) -> String -> (PkgName, String)
    forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
    &&& String -> String
    forall a. a -> a
    id) ([String] -> [(PkgName, String)])
    -> [String] -> [(PkgName, String)]
    forall a b. (a -> b) -> a -> b
    $ (String -> [(String, Down [Int])]) -> [String] -> [String]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn ((String -> (String, Down [Int]))
    -> [String] -> [(String, Down [Int])]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> (String, Down [Int])
    order ([String] -> [(String, Down [Int])])
    -> (String -> [String]) -> String -> [(String, Down [Int])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    splitDirectories) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) String
    ".txt" (String -> Bool) -> (String -> String) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    takeExtension) [String]
    files
        [(PkgName, Package)]
    cabals <- (String -> IO (PkgName, Package))
    -> [String] -> IO [(PkgName, Package)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> IO (PkgName, Package)
    parseCabal ([String] -> IO [(PkgName, Package)])
    -> [String] -> IO [(PkgName, Package)]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) String
    ".cabal" (String -> Bool) -> (String -> String) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    takeExtension) [String]
    files
        let source :: ConduitT i (PkgName, String, LBStr) IO ()
    source = [(PkgName, String)]
    -> ((PkgName, String) -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(PkgName, String)]
    packages (((PkgName, String) -> ConduitT i (PkgName, String, LBStr) IO ())
     -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ((PkgName, String) -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall a b. (a -> b) -> a -> b
    $ \(PkgName
    name, String
    file) -> do
                BStr
    src <- IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr)
    -> IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a b. (a -> b) -> a -> b
    $ String -> IO BStr
    bstrReadFile String
    file
                String
    dir <- IO String -> ConduitT i (PkgName, String, LBStr) IO String
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> ConduitT i (PkgName, String, LBStr) IO String)
    -> IO String -> ConduitT i (PkgName, String, LBStr) IO String
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    canonicalizePath (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    takeDirectory String
    file
                let url :: String
    url = String
    "file://" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '/' | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "/" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    dir] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace String
    "\\" String
    "/" String
    dir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/"
                (PkgName, String, LBStr)
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield (PkgName
    name, String
    url, [BStr] -> LBStr
    lbstrFromChunks [BStr
    src])
        (Map PkgName Package, Set PkgName,
     ConduitT () (PkgName, String, LBStr) IO ())
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package -> Map PkgName Package -> Map PkgName Package
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    Map.union
                    ([(PkgName, Package)] -> Map PkgName Package
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(PkgName, Package)]
    cabals)
                    ((Package -> Package -> Package)
    -> [(PkgName, Package)] -> Map PkgName Package
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith Package -> Package -> Package
    forall a. Semigroup a => a -> a -> a
    (<>) ([(PkgName, Package)] -> Map PkgName Package)
    -> [(PkgName, Package)] -> Map PkgName Package
    forall a b. (a -> b) -> a -> b
    $ ((PkgName, String) -> (PkgName, Package))
    -> [(PkgName, String)] -> [(PkgName, Package)]
    forall a b. (a -> b) -> [a] -> [b]
    map (PkgName, String) -> (PkgName, Package)
    forall {a}. (a, String) -> (a, Package)
    generateBarePackage [(PkgName, String)]
    packages)
               ,[PkgName] -> Set PkgName
    forall a. Ord a => [a] -> Set a
    Set.fromList ([PkgName] -> Set PkgName) -> [PkgName] -> Set PkgName
    forall a b. (a -> b) -> a -> b
    $ ((PkgName, String) -> PkgName) -> [(PkgName, String)] -> [PkgName]
    forall a b. (a -> b) -> [a] -> [b]
    map (PkgName, String) -> PkgName
    forall a b. (a, b) -> a
    fst [(PkgName, String)]
    packages, ConduitT () (PkgName, String, LBStr) IO ()
    forall {i}. ConduitT i (PkgName, String, LBStr) IO ()
    source)
      where
        parseCabal :: String -> IO (PkgName, Package)
    parseCabal String
    fp = do
            String
    src <- String -> IO String
    readFileUTF8' String
    fp
            let pkg :: Package
    pkg = Settings -> String -> Package
    readCabal Settings
    settings String
    src
            (PkgName, Package) -> IO (PkgName, Package)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> PkgName
    strPack (String -> PkgName) -> String -> PkgName
    forall a b. (a -> b) -> a -> b
    $ String -> String
    takeBaseName String
    fp, Package
    pkg)

        generateBarePackage :: (a, String) -> (a, Package)
    generateBarePackage (a
    name, String
    file) =
            (a
    name, Package
    forall a. Monoid a => a
    mempty{packageTags = (strPack "set", strPack "all") : sets})
          where
            sets :: [(PkgName, PkgName)]
    sets = (String -> (PkgName, PkgName)) -> [String] -> [(PkgName, PkgName)]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> (PkgName, PkgName)
    setFromDir ([String] -> [(PkgName, PkgName)])
    -> [String] -> [(PkgName, PkgName)]
    forall a b. (a -> b) -> a -> b
    $ (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    file) [String]
    dirs
            setFromDir :: String -> (PkgName, PkgName)
    setFromDir String
    dir = (String -> PkgName
    strPack String
    "set", String -> PkgName
    strPack (String -> PkgName) -> String -> PkgName
    forall a b. (a -> b) -> a -> b
    $ String -> String
    takeFileName (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    dropTrailingPathSeparator String
    dir)

    readFregeOnline :: Timing -> Download -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
    readFregeOnline :: Timing
    -> Download
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readFregeOnline Timing
    timing Download
    download = do
        String
    frege <- Download
    download String
    "frege-frege.txt" String
    "http://try.frege-lang.org/hoogle-frege.txt"
        let source :: ConduitT i (PkgName, String, LBStr) IO ()
    source = do
                BStr
    src <- IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr)
    -> IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a b. (a -> b) -> a -> b
    $ String -> IO BStr
    bstrReadFile String
    frege
                (PkgName, String, LBStr)
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield (String -> PkgName
    strPack String
    "frege", String
    "http://google.com/", [BStr] -> LBStr
    lbstrFromChunks [BStr
    src])
        (Map PkgName Package, Set PkgName,
     ConduitT () (PkgName, String, LBStr) IO ())
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package
    forall k a. Map k a
    Map.empty, PkgName -> Set PkgName
    forall a. a -> Set a
    Set.singleton (PkgName -> Set PkgName) -> PkgName -> Set PkgName
    forall a b. (a -> b) -> a -> b
    $ String -> PkgName
    strPack String
    "frege", ConduitT () (PkgName, String, LBStr) IO ()
    forall {i}. ConduitT i (PkgName, String, LBStr) IO ()
    source)

    readHaskellGhcpkg :: Timing -> Settings -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
    readHaskellGhcpkg :: Timing
    -> Settings
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellGhcpkg Timing
    timing Settings
    settings = do
        Map PkgName Package
    cbl <- Timing
    -> String -> IO (Map PkgName Package) -> IO (Map PkgName Package)
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timed Timing
    timing String
    "Reading ghc-pkg" (IO (Map PkgName Package) -> IO (Map PkgName Package))
    -> IO (Map PkgName Package) -> IO (Map PkgName Package)
    forall a b. (a -> b) -> a -> b
    $ Settings -> IO (Map PkgName Package)
    readGhcPkg Settings
    settings
        let source :: ConduitT i (PkgName, String, LBStr) IO ()
    source =
                [(PkgName, Package)]
    -> ((PkgName, Package)
        -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Map PkgName Package -> [(PkgName, Package)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PkgName Package
    cbl) (((PkgName, Package) -> ConduitT i (PkgName, String, LBStr) IO ())
     -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ((PkgName, Package)
        -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall a b. (a -> b) -> a -> b
    $ \(PkgName
    name,Package{Bool
    [(PkgName, PkgName)]
    [PkgName]
    Maybe String
    PkgName
    packageTags :: Package -> [(PkgName, PkgName)]
    packageTags :: [(PkgName, PkgName)]
    packageLibrary :: Bool
    packageSynopsis :: PkgName
    packageVersion :: PkgName
    packageDepends :: [PkgName]
    packageDocs :: Maybe String
    packageLibrary :: Package -> Bool
    packageSynopsis :: Package -> PkgName
    packageVersion :: Package -> PkgName
    packageDepends :: Package -> [PkgName]
    packageDocs :: Package -> Maybe String
    ..}) -> Maybe String
    -> (String -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *) a.
    Applicative m =>
    Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe String
    packageDocs ((String -> ConduitT i (PkgName, String, LBStr) IO ())
     -> ConduitT i (PkgName, String, LBStr) IO ())
    -> (String -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall a b. (a -> b) -> a -> b
    $ \String
    docs -> do
                    let file :: String
    file = String
    docs String -> String -> String
    </> PkgName -> String
    strUnpack PkgName
    name String -> String -> String
    <.> String
    "txt"
                    ConduitT i (PkgName, String, LBStr) IO Bool
    -> ConduitT i (PkgName, String, LBStr) IO ()
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (IO Bool -> ConduitT i (PkgName, String, LBStr) IO Bool
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> ConduitT i (PkgName, String, LBStr) IO Bool)
    -> IO Bool -> ConduitT i (PkgName, String, LBStr) IO Bool
    forall a b. (a -> b) -> a -> b
    $ String -> IO Bool
    doesFileExist String
    file) (ConduitT i (PkgName, String, LBStr) IO ()
     -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                        BStr
    src <- IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr)
    -> IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a b. (a -> b) -> a -> b
    $ String -> IO BStr
    bstrReadFile String
    file
                        String
    docs <- IO String -> ConduitT i (PkgName, String, LBStr) IO String
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> ConduitT i (PkgName, String, LBStr) IO String)
    -> IO String -> ConduitT i (PkgName, String, LBStr) IO String
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    canonicalizePath String
    docs
                        let url :: String
    url = String
    "file://" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '/' | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isPathSeparator (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    1 String
    docs] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                  String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace String
    "\\" String
    "/" (String -> String
    addTrailingPathSeparator String
    docs)
                        (PkgName, String, LBStr)
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield (PkgName
    name, String
    url, [BStr] -> LBStr
    lbstrFromChunks [BStr
    src])
        Map PkgName Package
    cbl <- Map PkgName Package -> IO (Map PkgName Package)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package -> IO (Map PkgName Package))
    -> Map PkgName Package -> IO (Map PkgName Package)
    forall a b. (a -> b) -> a -> b
    $ let ts :: [(PkgName, PkgName)]
    ts = ((String, String) -> (PkgName, PkgName))
    -> [(String, String)] -> [(PkgName, PkgName)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> PkgName) -> (String, String) -> (PkgName, PkgName)
    forall a b. (a -> b) -> (a, a) -> (b, b)
    both String -> PkgName
    strPack) [(String
    "set",String
    "stackage"),(String
    "set",String
    "installed")]
                        in (Package -> Package) -> Map PkgName Package -> Map PkgName Package
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (\Package
    p -> Package
    p{packageTags = ts ++ packageTags p}) Map PkgName Package
    cbl
        (Map PkgName Package, Set PkgName,
     ConduitT () (PkgName, String, LBStr) IO ())
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package
    cbl, Map PkgName Package -> Set PkgName
    forall k a. Map k a -> Set k
    Map.keysSet Map PkgName Package
    cbl, ConduitT () (PkgName, String, LBStr) IO ()
    forall {i}. ConduitT i (PkgName, String, LBStr) IO ()
    source)

    -- | @hoogle generate --haddock=path/to/doc@ works similarly to @hoogle generate --local@,
    -- getting package info from a local ghc-pkg database, but uses @path/to/doc@
    -- as the canonical source of Haddock documentation.
    -- @path/to/doc@ should be a path to the directory that contains the root @index.html@
    -- generated by cabal haddock or stack haddock.
    -- Paths stored in the database are relative to this root.
    --
    -- @hoogle server --haddock=path/to/doc@ is intended to be used with a database
    -- containing relative paths. In contrast to @hoogle server --local@,
    -- paths relative to the filesystem root are not allowed;
    -- only files from @path/to/doc@ are served.
    --
    -- These features are intended to be used together, when you want to
    -- create a Hoogle index for your project in one place, then serve it somewhere else.
    -- This enables a workflow such as the following:
    --
    -- 1. Run cabal haddock or stack haddock on your build server
    -- 2. Run hoogle generate --haddock=path/to/doc on your build server (this assumes you know where the docs were written)
    -- 3. Deploy the Hoogle database and Haddock files to your documentation server & run hoogle server --haddock=new/path/to/doc
    --
    -- from https://github.com/ndmitchell/hoogle/pull/202
    readHaskellHaddock :: Timing -> Settings -> FilePath -> IO (Map.Map PkgName Package, Set.Set PkgName, ConduitT () (PkgName, URL, LBStr) IO ())
    readHaskellHaddock :: Timing
    -> Settings
    -> String
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellHaddock Timing
    timing Settings
    settings String
    docBaseDir = do
        Map PkgName Package
    cbl <- Timing
    -> String -> IO (Map PkgName Package) -> IO (Map PkgName Package)
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timed Timing
    timing String
    "Reading ghc-pkg" (IO (Map PkgName Package) -> IO (Map PkgName Package))
    -> IO (Map PkgName Package) -> IO (Map PkgName Package)
    forall a b. (a -> b) -> a -> b
    $ Settings -> IO (Map PkgName Package)
    readGhcPkg Settings
    settings
        let source :: ConduitT i (PkgName, String, LBStr) IO ()
    source =
                [(PkgName, Package)]
    -> ((PkgName, Package)
        -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Map PkgName Package -> [(PkgName, Package)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PkgName Package
    cbl) (((PkgName, Package) -> ConduitT i (PkgName, String, LBStr) IO ())
     -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ((PkgName, Package)
        -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall a b. (a -> b) -> a -> b
    $ \(PkgName
    name, p :: Package
    p@Package{Bool
    [(PkgName, PkgName)]
    [PkgName]
    Maybe String
    PkgName
    packageTags :: Package -> [(PkgName, PkgName)]
    packageLibrary :: Package -> Bool
    packageSynopsis :: Package -> PkgName
    packageVersion :: Package -> PkgName
    packageDepends :: Package -> [PkgName]
    packageDocs :: Package -> Maybe String
    packageTags :: [(PkgName, PkgName)]
    packageLibrary :: Bool
    packageSynopsis :: PkgName
    packageVersion :: PkgName
    packageDepends :: [PkgName]
    packageDocs :: Maybe String
    ..}) -> do
                    let docs :: String
    docs = String -> Package -> String
    docDir (PkgName -> String
    strUnpack PkgName
    name) Package
    p
                        file :: String
    file = String
    docBaseDir String -> String -> String
    </> String
    docs String -> String -> String
    </> (PkgName -> String
    strUnpack PkgName
    name) String -> String -> String
    <.> String
    "txt"
                    ConduitT i (PkgName, String, LBStr) IO Bool
    -> ConduitT i (PkgName, String, LBStr) IO ()
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (IO Bool -> ConduitT i (PkgName, String, LBStr) IO Bool
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> ConduitT i (PkgName, String, LBStr) IO Bool)
    -> IO Bool -> ConduitT i (PkgName, String, LBStr) IO Bool
    forall a b. (a -> b) -> a -> b
    $ String -> IO Bool
    doesFileExist String
    file) (ConduitT i (PkgName, String, LBStr) IO ()
     -> ConduitT i (PkgName, String, LBStr) IO ())
    -> ConduitT i (PkgName, String, LBStr) IO ()
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                        BStr
    src <- IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a. IO a -> ConduitT i (PkgName, String, LBStr) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr)
    -> IO BStr -> ConduitT i (PkgName, String, LBStr) IO BStr
    forall a b. (a -> b) -> a -> b
    $ String -> IO BStr
    bstrReadFile String
    file
                        let url :: String
    url = [Char
    '/' | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isPathSeparator (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    1 String
    docs] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                  String -> String -> String -> String
    forall a. Eq a => [a] -> [a] -> [a] -> [a]
    replace String
    "\\" String
    "/" (String -> String
    addTrailingPathSeparator String
    docs)
                        (PkgName, String, LBStr)
    -> ConduitT i (PkgName, String, LBStr) IO ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield (PkgName
    name, String
    url, [BStr] -> LBStr
    lbstrFromChunks [BStr
    src])
        Map PkgName Package
    cbl <- Map PkgName Package -> IO (Map PkgName Package)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package -> IO (Map PkgName Package))
    -> Map PkgName Package -> IO (Map PkgName Package)
    forall a b. (a -> b) -> a -> b
    $ let ts :: [(PkgName, PkgName)]
    ts = ((String, String) -> (PkgName, PkgName))
    -> [(String, String)] -> [(PkgName, PkgName)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> PkgName) -> (String, String) -> (PkgName, PkgName)
    forall a b. (a -> b) -> (a, a) -> (b, b)
    both String -> PkgName
    strPack) [(String
    "set",String
    "stackage"),(String
    "set",String
    "installed")]
                        in (Package -> Package) -> Map PkgName Package -> Map PkgName Package
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (\Package
    p -> Package
    p{packageTags = ts ++ packageTags p}) Map PkgName Package
    cbl
        (Map PkgName Package, Set PkgName,
     ConduitT () (PkgName, String, LBStr) IO ())
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Map PkgName Package
    cbl, Map PkgName Package -> Set PkgName
    forall k a. Map k a -> Set k
    Map.keysSet Map PkgName Package
    cbl, ConduitT () (PkgName, String, LBStr) IO ()
    forall {i}. ConduitT i (PkgName, String, LBStr) IO ()
    source)

        where docDir :: String -> Package -> String
    docDir String
    name Package{Bool
    [(PkgName, PkgName)]
    [PkgName]
    Maybe String
    PkgName
    packageTags :: Package -> [(PkgName, PkgName)]
    packageLibrary :: Package -> Bool
    packageSynopsis :: Package -> PkgName
    packageVersion :: Package -> PkgName
    packageDepends :: Package -> [PkgName]
    packageDocs :: Package -> Maybe String
    packageTags :: [(PkgName, PkgName)]
    packageLibrary :: Bool
    packageSynopsis :: PkgName
    packageVersion :: PkgName
    packageDepends :: [PkgName]
    packageDocs :: Maybe String
    ..} = String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "-" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ PkgName -> String
    strUnpack PkgName
    packageVersion

    actionGenerate :: CmdLine -> IO ()
    actionGenerate :: CmdLine -> IO ()
    actionGenerate g :: CmdLine
    g@Generate{Bool
    String
    [String]
    Maybe Bool
    Maybe Int
    Maybe String
    Language
    download :: Maybe Bool
    database :: String
    insecure :: Bool
    include :: [String]
    count :: Maybe Int
    local_ :: [String]
    haddock :: Maybe String
    debug :: Bool
    language :: Language
    database :: CmdLine -> String
    count :: CmdLine -> Maybe Int
    language :: CmdLine -> Language
    download :: CmdLine -> Maybe Bool
    insecure :: CmdLine -> Bool
    include :: CmdLine -> [String]
    local_ :: CmdLine -> [String]
    haddock :: CmdLine -> Maybe String
    debug :: CmdLine -> Bool
    ..} = Maybe String -> (Timing -> IO ()) -> IO ()
    forall a. Maybe String -> (Timing -> IO a) -> IO a
    withTiming (if Bool
    debug then String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String
    replaceExtension String
    database String
    "timing" else Maybe String
    forall a. Maybe a
    Nothing) ((Timing -> IO ()) -> IO ()) -> (Timing -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Timing
    timing -> do
        String -> IO ()
    putStrLn String
    "Starting generate"
        Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> String
    takeDirectory String
    database
        IO () -> IO ()
    whenLoud (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Generating files to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    takeDirectory String
    database

        let warnFlagIgnored :: String -> String -> Bool -> String -> IO ()
    warnFlagIgnored String
    thisFlag String
    reason Bool
    ignoredFlagPred String
    ignoredFlag =
              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    ignoredFlagPred (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Warning: " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    thisFlag String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " is " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    reason String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ", which means " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ignoredFlag String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    " is ignored."

        let doDownload :: Download
    doDownload String
    name String
    url = do
              let download' :: DownloadInput
    download' = case Maybe Bool
    download of
                    Just Bool
    True -> DownloadInput
    AlwaysDownloadInput
                    Just Bool
    False -> DownloadInput
    NeverDownloadInput
                    Maybe Bool
    Nothing -> DownloadInput
    DownloadInputIfNotThere
              Timing -> Bool -> DownloadInput -> String -> Download
    downloadInput Timing
    timing Bool
    insecure DownloadInput
    download' (String -> String
    takeDirectory String
    database) String
    name String
    url

        Settings
    settings <- IO Settings
    loadSettings
        (Map PkgName Package
    cbl, Set PkgName
    want, ConduitT () (PkgName, String, LBStr) IO ()
    source) <- case Language
    language of
            Language
    Haskell | Just String
    dir <- Maybe String
    haddock -> do
                        String -> String -> Bool -> String -> IO ()
    warnFlagIgnored String
    "--haddock" String
    "set" ([String]
    local_ [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []) String
    "--local"
                        String -> String -> Bool -> String -> IO ()
    warnFlagIgnored String
    "--haddock" String
    "set" (Maybe Bool -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Bool
    download) String
    "--download"
                        Timing
    -> Settings
    -> String
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellHaddock Timing
    timing Settings
    settings String
    dir
                    | [String
    ""] <- [String]
    local_ -> do
                        String -> String -> Bool -> String -> IO ()
    warnFlagIgnored String
    "--local" String
    "used as flag (no paths)" (Maybe Bool -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Bool
    download) String
    "--download"
                        Timing
    -> Settings
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellGhcpkg Timing
    timing Settings
    settings
                    | [] <- [String]
    local_ -> do Timing
    -> Settings
    -> Download
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellOnline Timing
    timing Settings
    settings Download
    doDownload
                    | Bool
    otherwise -> Timing
    -> Settings
    -> [String]
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readHaskellDirs Timing
    timing Settings
    settings [String]
    local_
            Language
    Frege | [] <- [String]
    local_ -> Timing
    -> Download
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    readFregeOnline Timing
    timing Download
    doDownload
                  | Bool
    otherwise -> String
    -> IO
         (Map PkgName Package, Set PkgName,
          ConduitT () (PkgName, String, LBStr) IO ())
    forall a. Partial => String -> IO a
    errorIO String
    "No support for local Frege databases"
        ([String]
    cblErrs, Map PkgName Int
    popularity) <- ([String], Map PkgName Int) -> IO ([String], Map PkgName Int)
    forall a. a -> IO a
    evaluate (([String], Map PkgName Int) -> IO ([String], Map PkgName Int))
    -> ([String], Map PkgName Int) -> IO ([String], Map PkgName Int)
    forall a b. (a -> b) -> a -> b
    $ Map PkgName Package -> ([String], Map PkgName Int)
    packagePopularity Map PkgName Package
    cbl
        Map PkgName Package
    cbl <- Map PkgName Package -> IO (Map PkgName Package)
    forall a. a -> IO a
    evaluate (Map PkgName Package -> IO (Map PkgName Package))
    -> Map PkgName Package -> IO (Map PkgName Package)
    forall a b. (a -> b) -> a -> b
    $ (Package -> Package) -> Map PkgName Package -> Map PkgName Package
    forall a b k. (a -> b) -> Map k a -> Map k b
    Map.map (\Package
    p -> Package
    p{packageDepends=[]}) Map PkgName Package
    cbl -- clear the memory, since the information is no longer used
        Map PkgName Int -> IO (Map PkgName Int)
    forall a. a -> IO a
    evaluate Map PkgName Int
    popularity

        -- mtl is more popular than transformers, despite having dodgy docs, which is a shame, so we hack it
        Map PkgName Int
    popularity <- Map PkgName Int -> IO (Map PkgName Int)
    forall a. a -> IO a
    evaluate (Map PkgName Int -> IO (Map PkgName Int))
    -> Map PkgName Int -> IO (Map PkgName Int)
    forall a b. (a -> b) -> a -> b
    $ (Int -> Int) -> PkgName -> Map PkgName Int -> Map PkgName Int
    forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
    Map.adjust (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max (Int -> Int -> Int) -> Int -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> PkgName -> Map PkgName Int -> Int
    forall k a. Ord k => a -> k -> Map k a -> a
    Map.findWithDefault Int
    0 (String -> PkgName
    strPack String
    "mtl") Map PkgName Int
    popularity) (String -> PkgName
    strPack String
    "transformers") Map PkgName Int
    popularity

        Set PkgName
    want <- Set PkgName -> IO (Set PkgName)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Set PkgName -> IO (Set PkgName))
    -> Set PkgName -> IO (Set PkgName)
    forall a b. (a -> b) -> a -> b
    $ if [String]
    include [String] -> [String] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] then [PkgName] -> Set PkgName
    forall a. Ord a => [a] -> Set a
    Set.fromList ([PkgName] -> Set PkgName) -> [PkgName] -> Set PkgName
    forall a b. (a -> b) -> a -> b
    $ (String -> PkgName) -> [String] -> [PkgName]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> PkgName
    strPack [String]
    include else Set PkgName
    want
        Set PkgName
    want <- Set PkgName -> IO (Set PkgName)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Set PkgName -> IO (Set PkgName))
    -> Set PkgName -> IO (Set PkgName)
    forall a b. (a -> b) -> a -> b
    $ case Maybe Int
    count of Maybe Int
    Nothing -> Set PkgName
    want; Just Int
    count -> [PkgName] -> Set PkgName
    forall a. Ord a => [a] -> Set a
    Set.fromList ([PkgName] -> Set PkgName) -> [PkgName] -> Set PkgName
    forall a b. (a -> b) -> a -> b
    $ Int -> [PkgName] -> [PkgName]
    forall a. Int -> [a] -> [a]
    take Int
    count ([PkgName] -> [PkgName]) -> [PkgName] -> [PkgName]
    forall a b. (a -> b) -> a -> b
    $ Set PkgName -> [PkgName]
    forall a. Set a -> [a]
    Set.toList Set PkgName
    want

        ([String]
    stats, ()
    _) <- String -> (StoreWrite -> IO ()) -> IO ([String], ())
    forall a. String -> (StoreWrite -> IO a) -> IO ([String], a)
    storeWriteFile String
    database ((StoreWrite -> IO ()) -> IO ([String], ()))
    -> (StoreWrite -> IO ()) -> IO ([String], ())
    forall a b. (a -> b) -> a -> b
    $ \StoreWrite
    store -> do
            [(Maybe TargetId, Item)]
    xs <- String
    -> IOMode
    -> (Handle -> IO [(Maybe TargetId, Item)])
    -> IO [(Maybe TargetId, Item)]
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile (String
    database String -> String -> String
    `replaceExtension` String
    "warn") IOMode
    WriteMode ((Handle -> IO [(Maybe TargetId, Item)])
     -> IO [(Maybe TargetId, Item)])
    -> (Handle -> IO [(Maybe TargetId, Item)])
    -> IO [(Maybe TargetId, Item)]
    forall a b. (a -> b) -> a -> b
    $ \Handle
    warnings -> do
                Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    warnings TextEncoding
    utf8
                Handle -> String -> IO ()
    hPutStr Handle
    warnings (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String]
    cblErrs
                Int
    nCblErrs <- Int -> IO Int
    forall a. a -> IO a
    evaluate (Int -> IO Int) -> Int -> IO Int
    forall a b. (a -> b) -> a -> b
    $ [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    cblErrs

                IORef Integer
    itemWarn <- Integer -> IO (IORef Integer)
    forall a. a -> IO (IORef a)
    newIORef Integer
    0
                let warning :: String -> IO ()
    warning String
    msg = do IORef Integer -> (Integer -> Integer) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef Integer
    itemWarn Integer -> Integer
    forall a. Enum a => a -> a
    succ; Handle -> String -> IO ()
    hPutStrLn Handle
    warnings String
    msg

                let consume :: ConduitM (Int, (PkgName, URL, LBStr)) (Maybe Target, [Item]) IO ()
                    consume :: ConduitM
      (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    consume = ((Int, (PkgName, String, LBStr))
     -> ConduitM
          (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ())
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    forall (m :: * -> *) i o r.
    Monad m =>
    (i -> ConduitT i o m r) -> ConduitT i o m ()
    awaitForever (((Int, (PkgName, String, LBStr))
      -> ConduitM
           (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ())
     -> ConduitM
          (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ())
    -> ((Int, (PkgName, String, LBStr))
        -> ConduitM
             (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ())
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Int
    i, (PkgName -> String
    strUnpack -> String
    pkg, String
    url, LBStr
    body)) -> do
                        Timing
    -> String
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timedOverwrite Timing
    timing (String
    "[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    i String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Set PkgName -> Int
    forall a. Set a -> Int
    Set.size Set PkgName
    want) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "] " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pkg) (ConduitM
       (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
     -> ConduitM
          (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ())
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    forall a b. (a -> b) -> a -> b
    $
                            (String -> IO ())
    -> String
    -> LBStr
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    forall (m :: * -> *) i.
    Monad m =>
    (String -> m ())
    -> String -> LBStr -> ConduitM i (Maybe Target, [Item]) m ()
    parseHoogle (\String
    msg -> String -> IO ()
    warning (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    pkg String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msg) String
    url LBStr
    body

                StoreWrite
    -> (ConduitM (Maybe Target, [Item]) (Maybe TargetId, [Item]) IO ()
        -> IO [(Maybe TargetId, Item)])
    -> IO [(Maybe TargetId, Item)]
    forall item a.
    StoreWrite
    -> (ConduitM (Maybe Target, item) (Maybe TargetId, item) IO ()
        -> IO a)
    -> IO a
    writeItems StoreWrite
    store ((ConduitM (Maybe Target, [Item]) (Maybe TargetId, [Item]) IO ()
      -> IO [(Maybe TargetId, Item)])
     -> IO [(Maybe TargetId, Item)])
    -> (ConduitM (Maybe Target, [Item]) (Maybe TargetId, [Item]) IO ()
        -> IO [(Maybe TargetId, Item)])
    -> IO [(Maybe TargetId, Item)]
    forall a b. (a -> b) -> a -> b
    $ \ConduitM (Maybe Target, [Item]) (Maybe TargetId, [Item]) IO ()
    items -> do
                    [(Maybe TargetId, [Item])]
    xs <- ConduitT () Void IO [(Maybe TargetId, [Item])]
    -> IO [(Maybe TargetId, [Item])]
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void IO [(Maybe TargetId, [Item])]
     -> IO [(Maybe TargetId, [Item])])
    -> ConduitT () Void IO [(Maybe TargetId, [Item])]
    -> IO [(Maybe TargetId, [Item])]
    forall a b. (a -> b) -> a -> b
    $
                        ConduitT () (PkgName, String, LBStr) IO ()
    source ConduitT () (PkgName, String, LBStr) IO ()
    -> ConduitT
         (PkgName, String, LBStr) Void IO [(Maybe TargetId, [Item])]
    -> ConduitT () Void IO [(Maybe TargetId, [Item])]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .|
                        ((PkgName, String, LBStr) -> Bool)
    -> ConduitT (PkgName, String, LBStr) (PkgName, String, LBStr) IO ()
    forall {m :: * -> *} {a}.
    Monad m =>
    (a -> Bool) -> ConduitT a a m ()
    filterC ((PkgName -> Set PkgName -> Bool) -> Set PkgName -> PkgName -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip PkgName -> Set PkgName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Set PkgName
    want (PkgName -> Bool)
    -> ((PkgName, String, LBStr) -> PkgName)
    -> (PkgName, String, LBStr)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PkgName, String, LBStr) -> PkgName
    forall a b c. (a, b, c) -> a
    fst3) ConduitT (PkgName, String, LBStr) (PkgName, String, LBStr) IO ()
    -> ConduitT
         (PkgName, String, LBStr) Void IO [(Maybe TargetId, [Item])]
    -> ConduitT
         (PkgName, String, LBStr) Void IO [(Maybe TargetId, [Item])]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .|
                        ConduitT
      (PkgName, String, LBStr) (Maybe Target, [Item]) IO ((), ())
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    -> ConduitT
         (PkgName, String, LBStr) (Maybe Target, [Item]) IO ((), ())
    forall (m :: * -> *) i o r1 r2.
    Monad m =>
    ConduitM i o m r1 -> ConduitM i o m r2 -> ConduitM i o m (r1, r2)
    (|$|)
                            (Int
    -> ConduitM
         (PkgName, String, LBStr) (Int, (PkgName, String, LBStr)) IO ()
    forall (m :: * -> *) i a.
    (Monad m, Enum i) =>
    i -> ConduitM a (i, a) m ()
    zipFromC Int
    1 ConduitM
      (PkgName, String, LBStr) (Int, (PkgName, String, LBStr)) IO ()
    -> ConduitM
         (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitM
      (Int, (PkgName, String, LBStr)) (Maybe Target, [Item]) IO ()
    consume)
                            (do Set PkgName
    seen <- ([PkgName] -> Set PkgName)
    -> ConduitT
         (PkgName, String, LBStr) (Maybe Target, [Item]) IO [PkgName]
    -> ConduitT
         (PkgName, String, LBStr) (Maybe Target, [Item]) IO (Set PkgName)
    forall a b.
    (a -> b)
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO a
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [PkgName] -> Set PkgName
    forall a. Ord a => [a] -> Set a
    Set.fromList (ConduitT
       (PkgName, String, LBStr) (Maybe Target, [Item]) IO [PkgName]
     -> ConduitT
          (PkgName, String, LBStr) (Maybe Target, [Item]) IO (Set PkgName))
    -> ConduitT
         (PkgName, String, LBStr) (Maybe Target, [Item]) IO [PkgName]
    -> ConduitT
         (PkgName, String, LBStr) (Maybe Target, [Item]) IO (Set PkgName)
    forall a b. (a -> b) -> a -> b
    $ ((PkgName, String, LBStr) -> IO PkgName)
    -> ConduitT (PkgName, String, LBStr) PkgName IO ()
    forall {m :: * -> *} {a} {b}.
    Monad m =>
    (a -> m b) -> ConduitT a b m ()
    mapMC (PkgName -> IO PkgName
    forall a. a -> IO a
    evaluate (PkgName -> IO PkgName)
    -> ((PkgName, String, LBStr) -> PkgName)
    -> (PkgName, String, LBStr)
    -> IO PkgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PkgName -> PkgName
    forall a. NFData a => a -> a
    force (PkgName -> PkgName)
    -> ((PkgName, String, LBStr) -> PkgName)
    -> (PkgName, String, LBStr)
    -> PkgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PkgName -> PkgName
    strCopy (PkgName -> PkgName)
    -> ((PkgName, String, LBStr) -> PkgName)
    -> (PkgName, String, LBStr)
    -> PkgName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PkgName, String, LBStr) -> PkgName
    forall a b c. (a, b, c) -> a
    fst3) ConduitT (PkgName, String, LBStr) PkgName IO ()
    -> ConduitT PkgName (Maybe Target, [Item]) IO [PkgName]
    -> ConduitT
         (PkgName, String, LBStr) (Maybe Target, [Item]) IO [PkgName]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT PkgName (Maybe Target, [Item]) IO [PkgName]
    forall (m :: * -> *) a o. Monad m => ConduitM a o m [a]
    sinkList
                                let missing :: [PkgName]
    missing = [PkgName
    x | PkgName
    x <- Set PkgName -> [PkgName]
    forall a. Set a -> [a]
    Set.toList (Set PkgName -> [PkgName]) -> Set PkgName -> [PkgName]
    forall a b. (a -> b) -> a -> b
    $ Set PkgName
    want Set PkgName -> Set PkgName -> Set PkgName
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set PkgName
    seen
                                                 , (Package -> Bool) -> Maybe Package -> Maybe Bool
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Package -> Bool
    packageLibrary (PkgName -> Map PkgName Package -> Maybe Package
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup PkgName
    x Map PkgName Package
    cbl) Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False]
                                IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a.
    IO a
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ()
     -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
    -> IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    putStrLn String
    ""
                                IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a.
    IO a
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ()
     -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
    -> IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ()
    whenNormal (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([PkgName]
    missing [PkgName] -> [PkgName] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= []) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                    String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Packages missing documentation: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords ((String -> String) -> [String] -> [String]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn String -> String
    lower ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (PkgName -> String) -> [PkgName] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map PkgName -> String
    strUnpack [PkgName]
    missing)
                                IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a.
    IO a
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ()
     -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
    -> IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Set PkgName -> Bool
    forall a. Set a -> Bool
    Set.null Set PkgName
    seen) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                                    String -> IO ()
    exitFail String
    "No packages were found, aborting (use no arguments to index all of Stackage)"
                                -- synthesise things for Cabal packages that are not documented
                                [(PkgName, Package)]
    -> ((PkgName, Package)
        -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Map PkgName Package -> [(PkgName, Package)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map PkgName Package
    cbl) (((PkgName, Package)
      -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
     -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
    -> ((PkgName, Package)
        -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a b. (a -> b) -> a -> b
    $ \(PkgName
    name, Package{Bool
    [(PkgName, PkgName)]
    [PkgName]
    Maybe String
    PkgName
    packageTags :: Package -> [(PkgName, PkgName)]
    packageLibrary :: Package -> Bool
    packageSynopsis :: Package -> PkgName
    packageVersion :: Package -> PkgName
    packageDepends :: Package -> [PkgName]
    packageDocs :: Package -> Maybe String
    packageTags :: [(PkgName, PkgName)]
    packageLibrary :: Bool
    packageSynopsis :: PkgName
    packageVersion :: PkgName
    packageDepends :: [PkgName]
    packageDocs :: Maybe String
    ..}) -> Bool
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (PkgName
    name PkgName -> Set PkgName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.notMember` Set PkgName
    seen) (ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
     -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ())
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                    let ret :: String -> ConduitT i (Maybe Target, [Item]) m ()
    ret String
    prefix = (Maybe Target, [Item]) -> ConduitT i (Maybe Target, [Item]) m ()
    forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
    yield ((Maybe Target, [Item]) -> ConduitT i (Maybe Target, [Item]) m ())
    -> (Maybe Target, [Item]) -> ConduitT i (Maybe Target, [Item]) m ()
    forall a b. (a -> b) -> a -> b
    $ PkgName -> String -> (Maybe Target, [Item])
    fakePackage PkgName
    name (String -> (Maybe Target, [Item]))
    -> String -> (Maybe Target, [Item])
    forall a b. (a -> b) -> a -> b
    $ String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    trim (PkgName -> String
    strUnpack PkgName
    packageSynopsis)
                                    if PkgName
    name PkgName -> Set PkgName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set PkgName
    want then
                                        (if Bool
    packageLibrary
                                            then String
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall {m :: * -> *} {i}.
    Monad m =>
    String -> ConduitT i (Maybe Target, [Item]) m ()
    ret String
    "Documentation not found, so not searched.\n"
                                            else String
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall {m :: * -> *} {i}.
    Monad m =>
    String -> ConduitT i (Maybe Target, [Item]) m ()
    ret String
    "Executable only. ")
                                    else if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    include then
                                        String
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall {m :: * -> *} {i}.
    Monad m =>
    String -> ConduitT i (Maybe Target, [Item]) m ()
    ret String
    "Not on Stackage, so not searched.\n"
                                    else
                                        ()
    -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    forall a.
    a -> ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                                ))
                        ConduitT (PkgName, String, LBStr) (Maybe Target, [Item]) IO ()
    -> ConduitT
         (Maybe Target, [Item]) Void IO [(Maybe TargetId, [Item])]
    -> ConduitT
         (PkgName, String, LBStr) Void IO [(Maybe TargetId, [Item])]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| Int
    -> ConduitT
         (Maybe Target, [Item]) Void IO [(Maybe TargetId, [Item])]
    -> ConduitT
         (Maybe Target, [Item]) Void IO [(Maybe TargetId, [Item])]
    forall o r. Int -> ConduitM o Void IO r -> ConduitM o Void IO r
    pipelineC Int
    10 (ConduitM (Maybe Target, [Item]) (Maybe TargetId, [Item]) IO ()
    items ConduitM (Maybe Target, [Item]) (Maybe TargetId, [Item]) IO ()
    -> ConduitT
         (Maybe TargetId, [Item]) Void IO [(Maybe TargetId, [Item])]
    -> ConduitT
         (Maybe Target, [Item]) Void IO [(Maybe TargetId, [Item])]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT
      (Maybe TargetId, [Item]) Void IO [(Maybe TargetId, [Item])]
    forall (m :: * -> *) a o. Monad m => ConduitM a o m [a]
    sinkList)

                    Integer
    itemWarn <- IORef Integer -> IO Integer
    forall a. IORef a -> IO a
    readIORef IORef Integer
    itemWarn
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Integer
    itemWarn Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer
    0) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Found " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    itemWarn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " warnings when processing items"
                    [(Maybe TargetId, Item)] -> IO [(Maybe TargetId, Item)]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [(Maybe TargetId
    a,Item
    b) | (Maybe TargetId
    a,[Item]
    bs) <- [(Maybe TargetId, [Item])]
    xs, Item
    b <- [Item]
    bs]

            Maybe String
    itemsMemory <- IO (Maybe String)
    getStatsCurrentLiveBytes
            [(Maybe TargetId, Item)]
    xs <- Timing
    -> String
    -> IO [(Maybe TargetId, Item)]
    -> IO [(Maybe TargetId, Item)]
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timed Timing
    timing String
    "Reordering items" (IO [(Maybe TargetId, Item)] -> IO [(Maybe TargetId, Item)])
    -> IO [(Maybe TargetId, Item)] -> IO [(Maybe TargetId, Item)]
    forall a b. (a -> b) -> a -> b
    $ [(Maybe TargetId, Item)] -> IO [(Maybe TargetId, Item)]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([(Maybe TargetId, Item)] -> IO [(Maybe TargetId, Item)])
    -> [(Maybe TargetId, Item)] -> IO [(Maybe TargetId, Item)]
    forall a b. (a -> b) -> a -> b
    $! Settings
    -> (PkgName -> Int)
    -> [(Maybe TargetId, Item)]
    -> [(Maybe TargetId, Item)]
    forall a.
    Settings -> (PkgName -> Int) -> [(a, Item)] -> [(a, Item)]
    reorderItems Settings
    settings (\PkgName
    s -> Int -> (Int -> Int) -> Maybe Int -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    1 Int -> Int
    forall a. Num a => a -> a
    negate (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ PkgName -> Map PkgName Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup PkgName
    s Map PkgName Int
    popularity) [(Maybe TargetId, Item)]
    xs
            Timing -> String -> IO () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timed Timing
    timing String
    "Writing tags" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ StoreWrite
    -> (PkgName -> Bool)
    -> (PkgName -> [(String, String)])
    -> [(Maybe TargetId, Item)]
    -> IO ()
    writeTags StoreWrite
    store (PkgName -> Set PkgName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set PkgName
    want) (\PkgName
    x -> [(String, String)]
    -> (Package -> [(String, String)])
    -> Maybe Package
    -> [(String, String)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (((PkgName, PkgName) -> (String, String))
    -> [(PkgName, PkgName)] -> [(String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((PkgName -> String) -> (PkgName, PkgName) -> (String, String)
    forall a b. (a -> b) -> (a, a) -> (b, b)
    both PkgName -> String
    strUnpack) ([(PkgName, PkgName)] -> [(String, String)])
    -> (Package -> [(PkgName, PkgName)])
    -> Package
    -> [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Package -> [(PkgName, PkgName)]
    packageTags) (Maybe Package -> [(String, String)])
    -> Maybe Package -> [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ PkgName -> Map PkgName Package -> Maybe Package
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup PkgName
    x Map PkgName Package
    cbl) [(Maybe TargetId, Item)]
    xs
            Timing -> String -> IO () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timed Timing
    timing String
    "Writing names" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ StoreWrite -> [(Maybe TargetId, Item)] -> IO ()
    writeNames StoreWrite
    store [(Maybe TargetId, Item)]
    xs
            Timing -> String -> IO () -> IO ()
    forall (m :: * -> *) a. MonadIO m => Timing -> String -> m a -> m a
    timed Timing
    timing String
    "Writing types" (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ StoreWrite -> Maybe String -> [(Maybe TargetId, Item)] -> IO ()
    writeTypes StoreWrite
    store (if Bool
    debug then String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    dropExtension String
    database else Maybe String
    forall a. Maybe a
    Nothing) [(Maybe TargetId, Item)]
    xs

            Verbosity
    x <- IO Verbosity
    getVerbosity
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    x Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    Loud) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                IO (Maybe String) -> (String -> IO ()) -> IO ()
    forall (m :: * -> *) a.
    Monad m =>
    m (Maybe a) -> (a -> m ()) -> m ()
    whenJustM IO (Maybe String)
    getStatsDebug String -> IO ()
    forall a. Show a => a -> IO ()
    print
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    x Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    Normal) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                IO (Maybe String) -> (String -> IO ()) -> IO ()
    forall (m :: * -> *) a.
    Monad m =>
    m (Maybe a) -> (a -> m ()) -> m ()
    whenJustM IO (Maybe String)
    getStatsPeakAllocBytes ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \String
    x ->
                    String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Peak of " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ", " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "unknown" Maybe String
    itemsMemory String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " for items"

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    debug (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String -> String -> IO ()
    writeFile (String
    database String -> String -> String
    `replaceExtension` String
    "store") (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unlines [String]
    stats