module Parochial.HoogleGenerator (
    buildHoogleDB
  ) where


import           Protolude
import qualified Data.String as S
import qualified Hoogle as H

import           System.FilePath.Posix (addExtension)

import           Parochial.Types


-- Generate the Hoogle options to be passed to @hoogle@.
-- This is a bit yucky as it uses @hoogle@ which appears to be
-- a convenience function for the command line tool. I did look at not
-- using this wrapper but it's a bit intimidating!
hoogleGenOptions :: Target -> [FilePath] -> [S.String]
hoogleGenOptions :: Target -> [Target] -> [Target]
hoogleGenOptions Target
t [Target]
ps = [Target]
generateCommand [Target] -> [Target] -> [Target]
forall a. Semigroup a => a -> a -> a
<> [Target] -> [Target]
locals [Target]
ps
  where
    generateCommand :: [Target]
generateCommand = [Target
"generate", Target
"--database=" Target -> Target -> Target
forall a. Semigroup a => a -> a -> a
<> Target -> Target -> Target
addExtension Target
t Target
"hoo"]
    locals :: [Target] -> [Target]
locals = (Target -> Target) -> [Target] -> [Target]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Target
"--local=" Target -> Target -> Target
forall a. Semigroup a => a -> a -> a
<>)


-- | Build the hoogle database. This extracts the paths from all the packages,
--   checks they exist and passes them to the hoogle command.
buildHoogleDB :: Target -> [Pkg] -> IO ()
buildHoogleDB :: Target -> [Pkg] -> IO ()
buildHoogleDB Target
t = [Target] -> IO ()
H.hoogle ([Target] -> IO ()) -> ([Pkg] -> [Target]) -> [Pkg] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target -> [Target] -> [Target]
hoogleGenOptions Target
t ([Target] -> [Target]) -> ([Pkg] -> [Target]) -> [Pkg] -> [Target]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pkg] -> [Target]
forall a b. [(a, b)] -> [b]
extractPaths
  where
    extractPaths :: [(a, b)] -> [b]
extractPaths = ((a, b) -> b) -> [(a, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (a, b) -> b
forall a b. (a, b) -> b
snd