{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Stack.Hoogle
( hoogleCmd
) where
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Char ( isSpace )
import qualified Data.Text as T
import Distribution.PackageDescription ( packageDescription, package )
import Distribution.Types.PackageName ( mkPackageName )
import Distribution.Version ( mkVersion )
import Lens.Micro ( (?~) )
import Path ( parseAbsFile )
import Path.IO ( createDirIfMissing, doesFileExist )
import qualified RIO.Map as Map
import RIO.Process ( findExecutable, proc, readProcess_, runProcess_)
import qualified Stack.Build ( build )
import Stack.Build.Target ( NeedTargets (NeedTargets) )
import Stack.Constants ( stackProgName' )
import Stack.Prelude
import Stack.Runners
( ShouldReexec (..), withConfig, withDefaultEnvConfig
, withEnvConfig
)
import Stack.Types.BuildOpts
( BuildOptsCLI (..), buildOptsMonoidHaddockL
, defaultBuildOptsCLI
)
import Stack.Types.Config
( Config (..), HasConfig (..) )
import Stack.Types.EnvConfig
( EnvConfig, HasSourceMap (..), hoogleDatabasePath
, hoogleRoot
)
import Stack.Types.EnvSettings ( EnvSettings (..) )
import Stack.Types.GlobalOpts
( GlobalOpts (..), globalOptsBuildOptsMonoidL )
import Stack.Types.Runner ( Runner, globalOptsL )
import Stack.Types.SourceMap ( DepPackage (..), SourceMap (..) )
data HoogleException
= HoogleDatabaseNotFound
| HoogleOnPathNotFoundBug
deriving (Int -> HoogleException -> ShowS
[HoogleException] -> ShowS
HoogleException -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HoogleException] -> ShowS
$cshowList :: [HoogleException] -> ShowS
show :: HoogleException -> FilePath
$cshow :: HoogleException -> FilePath
showsPrec :: Int -> HoogleException -> ShowS
$cshowsPrec :: Int -> HoogleException -> ShowS
Show, Typeable)
instance Exception HoogleException where
displayException :: HoogleException -> FilePath
displayException HoogleException
HoogleDatabaseNotFound =
FilePath
"Error: [S-3025]\n"
forall a. [a] -> [a] -> [a]
++ FilePath
"No Hoogle database. Not building one due to '--no-setup'."
displayException HoogleException
HoogleOnPathNotFoundBug = FilePath -> ShowS
bugReport FilePath
"[S-9669]"
FilePath
"Cannot find Hoogle executable on PATH, after installing."
newtype HooglePrettyException
= HoogleNotFound StyleDoc
deriving (Int -> HooglePrettyException -> ShowS
[HooglePrettyException] -> ShowS
HooglePrettyException -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HooglePrettyException] -> ShowS
$cshowList :: [HooglePrettyException] -> ShowS
show :: HooglePrettyException -> FilePath
$cshow :: HooglePrettyException -> FilePath
showsPrec :: Int -> HooglePrettyException -> ShowS
$cshowsPrec :: Int -> HooglePrettyException -> ShowS
Show, Typeable)
instance Pretty HooglePrettyException where
pretty :: HooglePrettyException -> StyleDoc
pretty (HoogleNotFound StyleDoc
e) =
StyleDoc
"[S-1329]"
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> StyleDoc
e
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
[ FilePath -> StyleDoc
flow FilePath
"Not installing Hoogle due to"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-setup" forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
]
instance Exception HooglePrettyException
data Muted = Muted | NotMuted
hoogleCmd :: ([String], Bool, Bool, Bool) -> RIO Runner ()
hoogleCmd :: ([FilePath], Bool, Bool, Bool) -> RIO Runner ()
hoogleCmd ([FilePath]
args, Bool
setup, Bool
rebuild, Bool
startServer) =
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall env. HasRunner env => Lens' env GlobalOpts
globalOptsL GlobalOpts -> GlobalOpts
modifyGO) forall a b. (a -> b) -> a -> b
$
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
YesReexec forall a b. (a -> b) -> a -> b
$
forall a. RIO EnvConfig a -> RIO Config a
withDefaultEnvConfig forall a b. (a -> b) -> a -> b
$ do
Path Abs File
hooglePath <- RIO EnvConfig (Path Abs File)
ensureHoogleInPath
Path Abs File -> RIO EnvConfig ()
generateDbIfNeeded Path Abs File
hooglePath
Path Abs File -> [FilePath] -> RIO EnvConfig ()
runHoogle Path Abs File
hooglePath [FilePath]
args'
where
modifyGO :: GlobalOpts -> GlobalOpts
modifyGO :: GlobalOpts -> GlobalOpts
modifyGO = Lens' GlobalOpts BuildOptsMonoid
globalOptsBuildOptsMonoidL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BuildOptsMonoid (Maybe Bool)
buildOptsMonoidHaddockL forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Bool
True
args' :: [String]
args' :: [FilePath]
args' = if Bool
startServer
then [FilePath
"server", FilePath
"--local", FilePath
"--port", FilePath
"8080"] forall a. [a] -> [a] -> [a]
++ [FilePath]
args
else [FilePath]
args
generateDbIfNeeded :: Path Abs File -> RIO EnvConfig ()
generateDbIfNeeded :: Path Abs File -> RIO EnvConfig ()
generateDbIfNeeded Path Abs File
hooglePath = do
Bool
databaseExists <- RIO EnvConfig Bool
checkDatabaseExists
if Bool
databaseExists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
rebuild
then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
else
if Bool
setup Bool -> Bool -> Bool
|| Bool
rebuild
then do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyWarn forall a b. (a -> b) -> a -> b
$
if Bool
rebuild
then FilePath -> StyleDoc
flow FilePath
"Rebuilding database ..."
else
[StyleDoc] -> StyleDoc
fillSep
[ FilePath -> StyleDoc
flow FilePath
"No Hoogle database yet. Automatically building \
\Haddock documentation and Hoogle database (use"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-setup"
, FilePath -> StyleDoc
flow FilePath
"to disable) ..."
]
RIO EnvConfig ()
buildHaddocks
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
FilePath -> m ()
prettyInfoS FilePath
"Built Haddock documentation."
Path Abs File -> RIO EnvConfig ()
generateDb Path Abs File
hooglePath
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
FilePath -> m ()
prettyInfoS FilePath
"Generated Hoogle database."
else forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO HoogleException
HoogleDatabaseNotFound
generateDb :: Path Abs File -> RIO EnvConfig ()
generateDb :: Path Abs File -> RIO EnvConfig ()
generateDb Path Abs File
hooglePath = do
Path Abs Dir
dir <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
hoogleRoot
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
True Path Abs Dir
dir
Path Abs File -> [FilePath] -> RIO EnvConfig ()
runHoogle Path Abs File
hooglePath [FilePath
"generate", FilePath
"--local"]
buildHaddocks :: RIO EnvConfig ()
buildHaddocks :: RIO EnvConfig ()
buildHaddocks = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO Config
config forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall a. RIO EnvConfig a -> RIO Config a
withDefaultEnvConfig forall a b. (a -> b) -> a -> b
$ forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
Stack.Build.build forall a. Maybe a
Nothing)
(\(ExitCode
_ :: ExitCode) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
hooglePackageName :: PackageName
hooglePackageName = FilePath -> PackageName
mkPackageName FilePath
"hoogle"
hoogleMinVersion :: Version
hoogleMinVersion = [Int] -> Version
mkVersion [Int
5, Int
0]
hoogleMinIdent :: PackageIdentifier
hoogleMinIdent =
PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
hooglePackageName Version
hoogleMinVersion
installHoogle :: RIO EnvConfig (Path Abs File)
installHoogle :: RIO EnvConfig (Path Abs File)
installHoogle = forall x. Muted -> RIO EnvConfig x -> RIO EnvConfig x
requiringHoogle Muted
Muted forall a b. (a -> b) -> a -> b
$ do
forall env.
HasEnvConfig env =>
Maybe (Set (Path Abs File) -> IO ()) -> RIO env ()
Stack.Build.build forall a. Maybe a
Nothing
Either ProcessException FilePath
mhooglePath' <- forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
FilePath -> m (Either ProcessException FilePath)
findExecutable FilePath
"hoogle"
case Either ProcessException FilePath
mhooglePath' of
Right FilePath
hooglePath -> forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile FilePath
hooglePath
Left ProcessException
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO HoogleException
HoogleOnPathNotFoundBug
requiringHoogle :: Muted -> RIO EnvConfig x -> RIO EnvConfig x
requiringHoogle :: forall x. Muted -> RIO EnvConfig x -> RIO EnvConfig x
requiringHoogle Muted
muted RIO EnvConfig x
f = do
Text
hoogleTarget <- do
Map PackageName DepPackage
sourceMap <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasSourceMap env => Lens' env SourceMap
sourceMapL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to SourceMap -> Map PackageName DepPackage
smDeps
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
hooglePackageName Map PackageName DepPackage
sourceMap of
Just DepPackage
hoogleDep ->
case DepPackage -> PackageLocation
dpLocation DepPackage
hoogleDep of
PLImmutable PackageLocationImmutable
pli ->
FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> FilePath
packageIdentifierString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall env.
HasLogFunc env =>
Muted -> PackageIdentifier -> RIO env PackageIdentifier
restrictMinHoogleVersion Muted
muted (PackageLocationImmutable -> PackageIdentifier
packageLocationIdent PackageLocationImmutable
pli)
plm :: PackageLocation
plm@(PLMutable ResolvedPath Dir
_) ->
FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> FilePath
packageIdentifierString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageDescription
packageDescription
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Maybe Text -> PackageLocation -> RIO env GenericPackageDescription
loadCabalFile (forall a. a -> Maybe a
Just Text
stackProgName') PackageLocation
plm
Maybe DepPackage
Nothing -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
FilePath -> m ()
prettyWarnS
FilePath
"No hoogle version was found, trying to install the latest version"
Maybe PackageIdentifierRevision
mpir <- forall env.
(HasPantryConfig env, HasLogFunc env) =>
RequireHackageIndex
-> PackageName
-> UsePreferredVersions
-> RIO env (Maybe PackageIdentifierRevision)
getLatestHackageVersion RequireHackageIndex
YesRequireHackageIndex PackageName
hooglePackageName UsePreferredVersions
UsePreferredVersions
let hoogleIdent :: PackageIdentifier
hoogleIdent = case Maybe PackageIdentifierRevision
mpir of
Maybe PackageIdentifierRevision
Nothing -> PackageIdentifier
hoogleMinIdent
Just (PackageIdentifierRevision PackageName
_ Version
ver CabalFileInfo
_) ->
PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
hooglePackageName Version
ver
FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> FilePath
packageIdentifierString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall env.
HasLogFunc env =>
Muted -> PackageIdentifier -> RIO env PackageIdentifier
restrictMinHoogleVersion Muted
muted PackageIdentifier
hoogleIdent
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
let boptsCLI :: BuildOptsCLI
boptsCLI = BuildOptsCLI
defaultBuildOptsCLI
{ boptsCLITargets :: [Text]
boptsCLITargets = [Text
hoogleTarget]
}
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO Config
config forall a b. (a -> b) -> a -> b
$ forall a.
NeedTargets -> BuildOptsCLI -> RIO EnvConfig a -> RIO Config a
withEnvConfig NeedTargets
NeedTargets BuildOptsCLI
boptsCLI RIO EnvConfig x
f
restrictMinHoogleVersion ::
HasLogFunc env
=> Muted
-> PackageIdentifier
-> RIO env PackageIdentifier
restrictMinHoogleVersion :: forall env.
HasLogFunc env =>
Muted -> PackageIdentifier -> RIO env PackageIdentifier
restrictMinHoogleVersion Muted
muted PackageIdentifier
ident =
if PackageIdentifier
ident forall a. Ord a => a -> a -> Bool
< PackageIdentifier
hoogleMinIdent
then do
forall env.
HasLogFunc env =>
LogLevel -> Muted -> Utf8Builder -> RIO env ()
muteableLog LogLevel
LevelWarn Muted
muted forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Minimum " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => FilePath -> a
fromString (PackageIdentifier -> FilePath
packageIdentifierString PackageIdentifier
hoogleMinIdent) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" is not in your index. Installing the minimum version."
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifier
hoogleMinIdent
else do
forall env.
HasLogFunc env =>
LogLevel -> Muted -> Utf8Builder -> RIO env ()
muteableLog LogLevel
LevelInfo Muted
muted forall a b. (a -> b) -> a -> b
$
Utf8Builder
"Minimum version is " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => FilePath -> a
fromString (PackageIdentifier -> FilePath
packageIdentifierString PackageIdentifier
hoogleMinIdent) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
". Found acceptable " forall a. Semigroup a => a -> a -> a
<>
forall a. IsString a => FilePath -> a
fromString (PackageIdentifier -> FilePath
packageIdentifierString PackageIdentifier
ident) forall a. Semigroup a => a -> a -> a
<>
Utf8Builder
" in your index, requiring its installation."
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageIdentifier
ident
muteableLog ::
HasLogFunc env
=> LogLevel
-> Muted
-> Utf8Builder
-> RIO env ()
muteableLog :: forall env.
HasLogFunc env =>
LogLevel -> Muted -> Utf8Builder -> RIO env ()
muteableLog LogLevel
logLevel Muted
muted Utf8Builder
msg =
case Muted
muted of
Muted
Muted -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Muted
NotMuted -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Text -> LogLevel -> Utf8Builder -> m ()
logGeneric Text
"" LogLevel
logLevel Utf8Builder
msg
runHoogle :: Path Abs File -> [String] -> RIO EnvConfig ()
runHoogle :: Path Abs File -> [FilePath] -> RIO EnvConfig ()
runHoogle Path Abs File
hooglePath [FilePath]
hoogleArgs = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
ProcessContext
menv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Config -> EnvSettings -> IO ProcessContext
configProcessContextSettings Config
config EnvSettings
envSettings
Path Abs File
dbpath <- forall env. HasEnvConfig env => RIO env (Path Abs File)
hoogleDatabasePath
let databaseArg :: [FilePath]
databaseArg = [FilePath
"--database=" forall a. [a] -> [a] -> [a]
++ forall b t. Path b t -> FilePath
toFilePath Path Abs File
dbpath]
forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
proc
(forall b t. Path b t -> FilePath
toFilePath Path Abs File
hooglePath)
([FilePath]
hoogleArgs forall a. [a] -> [a] -> [a]
++ [FilePath]
databaseArg)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_
checkDatabaseExists :: RIO EnvConfig Bool
checkDatabaseExists = do
Path Abs File
path <- forall env. HasEnvConfig env => RIO env (Path Abs File)
hoogleDatabasePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
path)
ensureHoogleInPath :: RIO EnvConfig (Path Abs File)
ensureHoogleInPath :: RIO EnvConfig (Path Abs File)
ensureHoogleInPath = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
ProcessContext
menv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Config -> EnvSettings -> IO ProcessContext
configProcessContextSettings Config
config EnvSettings
envSettings
Either ProcessException FilePath
mhooglePath <- forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO ProcessContext
menv (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
FilePath -> m (Either ProcessException FilePath)
findExecutable FilePath
"hoogle") forall a. Semigroup a => a -> a -> a
<>
forall x. Muted -> RIO EnvConfig x -> RIO EnvConfig x
requiringHoogle Muted
NotMuted (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasProcessContext env) =>
FilePath -> m (Either ProcessException FilePath)
findExecutable FilePath
"hoogle")
Either StyleDoc FilePath
eres <- case Either ProcessException FilePath
mhooglePath of
Left ProcessException
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (FilePath -> StyleDoc
flow FilePath
"Hoogle isn't installed.")
Right FilePath
hooglePath -> do
Either SomeException ByteString
result <- forall env a.
HasProcessContext env =>
ProcessContext -> RIO env a -> RIO env a
withProcessContext ProcessContext
menv
forall a b. (a -> b) -> a -> b
$ forall env (m :: * -> *) a.
(HasProcessContext env, HasLogFunc env, MonadReader env m,
MonadIO m, HasCallStack) =>
FilePath -> [FilePath] -> (ProcessConfig () () () -> m a) -> m a
proc FilePath
hooglePath [FilePath
"--numeric-version"]
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> m (ByteString, ByteString)
readProcess_
let unexpectedResult :: StyleDoc -> Either StyleDoc b
unexpectedResult StyleDoc
got = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
[StyleDoc] -> StyleDoc
fillSep
[ Style -> StyleDoc -> StyleDoc
style Style
Shell (forall a. IsString a => FilePath -> a
fromString FilePath
hooglePath)
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--numeric-version"
, FilePath -> StyleDoc
flow FilePath
"did not respond with expected value. Got:"
]
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
forall a. Semigroup a => a -> a -> a
<> StyleDoc
got
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either SomeException ByteString
result of
Left SomeException
err -> forall {b}. StyleDoc -> Either StyleDoc b
unexpectedResult forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
string (forall e. Exception e => e -> FilePath
displayException SomeException
err)
Right ByteString
bs ->
case FilePath -> Maybe Version
parseVersion (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (ByteString -> FilePath
BL8.unpack ByteString
bs)) of
Maybe Version
Nothing -> forall {b}. StyleDoc -> Either StyleDoc b
unexpectedResult forall a b. (a -> b) -> a -> b
$ forall a. IsString a => FilePath -> a
fromString (ByteString -> FilePath
BL8.unpack ByteString
bs)
Just Version
ver
| Version
ver forall a. Ord a => a -> a -> Bool
>= Version
hoogleMinVersion -> forall a b. b -> Either a b
Right FilePath
hooglePath
| Bool
otherwise -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
[StyleDoc] -> StyleDoc
fillSep
[ FilePath -> StyleDoc
flow FilePath
"Installed Hoogle is too old, "
, Style -> StyleDoc -> StyleDoc
style Style
Shell (forall a. IsString a => FilePath -> a
fromString FilePath
hooglePath)
, FilePath -> StyleDoc
flow FilePath
"is version"
, forall a. IsString a => FilePath -> a
fromString (Version -> FilePath
versionString Version
ver)
, FilePath -> StyleDoc
flow FilePath
"but >= 5.0 is required."
]
case Either StyleDoc FilePath
eres of
Right FilePath
hooglePath -> forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseAbsFile FilePath
hooglePath
Left StyleDoc
err
| Bool
setup -> do
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ StyleDoc
err
, FilePath -> StyleDoc
flow FilePath
"Automatically installing (use"
, Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"--no-setup"
, FilePath -> StyleDoc
flow FilePath
"to disable) ..."
]
RIO EnvConfig (Path Abs File)
installHoogle
| Bool
otherwise -> forall e (m :: * -> *) a.
(Exception e, MonadIO m, Pretty e) =>
e -> m a
prettyThrowIO forall a b. (a -> b) -> a -> b
$ StyleDoc -> HooglePrettyException
HoogleNotFound StyleDoc
err
envSettings :: EnvSettings
envSettings =
EnvSettings
{ esIncludeLocals :: Bool
esIncludeLocals = Bool
True
, esIncludeGhcPackagePath :: Bool
esIncludeGhcPackagePath = Bool
True
, esStackExe :: Bool
esStackExe = Bool
True
, esLocaleUtf8 :: Bool
esLocaleUtf8 = Bool
False
, esKeepGhcRts :: Bool
esKeepGhcRts = Bool
False
}