{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module HieDb.Run where

import Prelude hiding (mod)

import GHC
import Compat.HieTypes
import Compat.HieUtils

import qualified Data.Map as M

import qualified Data.Text.IO as T


import System.Environment
import System.Directory
import System.IO
import System.IO.Unsafe (unsafeInterleaveIO)
import System.Exit
import System.Time.Extra

import System.Console.ANSI
import System.Console.Terminal.Size

import Control.Monad
import Control.Monad.IO.Class

import Data.Maybe
import Data.Either
import Data.Foldable
import Data.IORef
import Data.List.Extra

import Numeric.Natural

import qualified Data.ByteString.Char8 as BS

import Options.Applicative

import HieDb
import HieDb.Compat
import HieDb.Dump
import Text.Printf (printf)

hiedbMain :: LibDir -> IO ()
hiedbMain :: LibDir -> IO ()
hiedbMain LibDir
libdir = do
  [Char]
defaultLoc <- XdgDirectory -> [Char] -> IO [Char]
getXdgDirectory XdgDirectory
XdgData forall a b. (a -> b) -> a -> b
$ [Char]
"default_"forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
dB_VERSION forall a. [a] -> [a] -> [a]
++[Char]
".hiedb"
  [Char]
defdb <- forall a. a -> Maybe a -> a
fromMaybe [Char]
defaultLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"HIEDB"
  Bool
colr <- Handle -> IO Bool
hSupportsANSIColor Handle
stdout
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
  (Options
opts, Command
cmd) <- forall a. ParserInfo a -> IO a
execParser forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> ParserInfo (Options, Command)
progParseInfo [Char]
defdb Bool
colr
  LibDir -> Options -> Command -> IO ()
runCommand LibDir
libdir Options
opts Command
cmd


{- USAGE
Some default db location overridden by environment var HIEDB
hiedb init <foo.hiedb>
hiedb index [<dir>...] [hiedb]
hiedb name-refs <name> <module> [unitid] [hiedb]
hiedb type-refs <name> <module> [unitid] [hiedb]
hiedb query-pos <file.hie> <row> <col> [hiedb]
hiedb query-pos --hiedir=<dir> <file.hs> <row> <col> [hiedb]
hiedb cat <module> [unitid]
-}

data Options
  = Options
  { Options -> [Char]
database :: FilePath
  , Options -> Bool
trace :: Bool
  , Options -> Bool
quiet :: Bool
  , Options -> Bool
colour :: Bool
  , Options -> Maybe Natural
context :: Maybe Natural
  , Options -> Bool
reindex :: Bool
  , Options -> Bool
keepMissing :: Bool
  , Options -> Maybe [Char]
srcBaseDir :: Maybe FilePath
  }

data Command
  = Init
  | Index [FilePath]
  | NameRefs String (Maybe ModuleName) (Maybe Unit)
  | TypeRefs String (Maybe ModuleName) (Maybe Unit)
  | NameDef  String (Maybe ModuleName) (Maybe Unit)
  | TypeDef  String (Maybe ModuleName) (Maybe Unit)
  | Cat HieTarget
  | Ls
  | LsExports (Maybe ModuleName)
  | Rm [HieTarget]
  | ModuleUIDs ModuleName
  | LookupHieFile ModuleName (Maybe Unit)
  | RefsAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))
  | TypesAtPoint HieTarget (Int,Int) (Maybe (Int,Int))
  | DefsAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))
  | InfoAtPoint  HieTarget (Int,Int) (Maybe (Int,Int))
  | RefGraph
  | Dump FilePath
  | Reachable [Symbol]
  | Unreachable [Symbol]
  | Html [Symbol]
  | GCTypeNames

progParseInfo :: FilePath -> Bool -> ParserInfo (Options, Command)
progParseInfo :: [Char] -> Bool -> ParserInfo (Options, Command)
progParseInfo [Char]
db Bool
colr = forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Bool -> Parser (Options, Command)
progParser [Char]
db Bool
colr forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper)
  ( forall a. InfoMod a
fullDesc
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> InfoMod a
progDesc [Char]
"Query .hie files"
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> InfoMod a
header [Char]
"hiedb - a tool to query groups of .hie files" )

progParser :: FilePath -> Bool -> Parser (Options,Command)
progParser :: [Char] -> Bool -> Parser (Options, Command)
progParser [Char]
db Bool
colr = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Bool -> Parser Options
optParser [Char]
db Bool
colr forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
cmdParser

optParser :: FilePath -> Bool -> Parser Options
optParser :: [Char] -> Bool -> Parser Options
optParser [Char]
defdb Bool
colr
    = [Char]
-> Bool
-> Bool
-> Bool
-> Maybe Natural
-> Bool
-> Bool
-> Maybe [Char]
-> Options
Options
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"database" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'D' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DATABASE"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value [Char]
defdb forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"References Database")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"trace" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Print SQL queries being executed")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"quiet" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'q' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Don't print progress messages")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
colourFlag
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"context" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'C' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Number of lines of context for source spans - show no context by default"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"reindex" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Re-index all files in database before running command, deleting those with missing '.hie' files")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"keep-missing" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Keep missing files when re-indexing")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"src-base-dir" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Provide a base directory to index src files as real files"))
  where
    colourFlag :: Parser Bool
colourFlag = forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"colour" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"color" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Force coloured output")
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"no-colour" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"no-color" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. [Char] -> Mod f a
help [Char]
"Force uncoloured ouput")
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
colr

cmdParser :: Parser Command
cmdParser :: Parser Command
cmdParser
   = forall a. Mod CommandFields a -> Parser a
hsubparser
   forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"init" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Init) forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Initialize database")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"index" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([[Char]] -> Command
Index forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"DIRECTORY..."))) forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Index files from directory")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"name-refs" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
NameRefs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> ModuleName
mkModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"MODULE"))
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup references of value MODULE.NAME")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"type-refs" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
TypeRefs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
                                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup references of type MODULE.NAME")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"name-def" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
NameDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup definition of value MODULE.NAME")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"type-def" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Maybe ModuleName -> Maybe Unit -> Command
TypeDef forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"NAME")
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup definition of type MODULE.NAME")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"cat" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> Command
Cat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Dump contents of MODULE as stored in the hiefile")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"ls" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Ls)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"List all indexed files/modules")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"ls-exports" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (Maybe ModuleName -> Command
LsExports forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"List all exports")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"rm" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([HieTarget] -> Command
Rm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser HieTarget
hieTarget)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Remove targets from index")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"module-uids" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (ModuleName -> Command
ModuleUIDs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"List all the UnitIds MODULE is indexed under in the db")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"lookup-hie" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (ModuleName -> Maybe Unit -> Command
LookupHieFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Lookup the location of the .hie file corresponding to MODULE")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-refs"
        (forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
RefsAtPoint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                           forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Find references for symbol at point/span")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-types"
        (forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
TypesAtPoint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"List types of ast at point/span")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-defs"
        (forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
DefsAtPoint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Find definition for symbol at point/span")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"point-info"
        (forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
InfoAtPoint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
                            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
              forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Print name, module name, unit id for symbol at point/span")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"ref-graph" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
RefGraph) forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Generate a reachability graph")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"dump" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Char] -> Command
Dump forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"HIE")) forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Dump a HIE AST")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"reachable" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Reachable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
                         forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Find all symbols reachable from the given symbols")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"unreachable" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Unreachable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
                           forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"Find all symbols unreachable from the given symbols")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"html" (forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Html forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
                    forall a b. (a -> b) -> a -> b
$ forall a. [Char] -> InfoMod a
progDesc [Char]
"generate html files for reachability from the given symbols")
  forall a. Semigroup a => a -> a -> a
<> forall a. [Char] -> ParserInfo a -> Mod CommandFields a
command [Char]
"gc" (forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
GCTypeNames) forall a. Monoid a => a
mempty)

posParser :: Char -> Parser (Int,Int)
posParser :: Char -> Parser (Int, Int)
posParser Char
c = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar forall a b. (a -> b) -> a -> b
$ Char
cforall a. a -> [a] -> [a]
:[Char]
"LINE") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall a. Read a => ReadM a
auto (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar forall a b. (a -> b) -> a -> b
$ Char
cforall a. a -> [a] -> [a]
:[Char]
"COL")

maybeUnitId :: Parser (Maybe Unit)
maybeUnitId :: Parser (Maybe Unit)
maybeUnitId =
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ([Char] -> Unit
stringToUnit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"unit-id" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"UNITID"))

symbolParser :: Parser Symbol
symbolParser :: Parser Symbol
symbolParser = forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall a. Read a => ReadM a
auto forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"SYMBOL"

moduleNameParser :: Parser ModuleName
moduleNameParser :: Parser ModuleName
moduleNameParser = [Char] -> ModuleName
mkModuleName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"MODULE")

hieTarget :: Parser HieTarget
hieTarget :: Parser HieTarget
hieTarget =
      (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => [Char] -> Mod f a
long [Char]
"hiefile" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => [Char] -> Mod f a
metavar [Char]
"HIEFILE"))
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId))

progress :: Handle -> Int -> Int -> (FilePath -> DbMonad Bool) -> FilePath -> DbMonad Bool
progress :: Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress Handle
hndl Int
total Int
cur [Char] -> DbMonad Bool
act [Char]
f = do
  Maybe Int
mw <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Window a -> a
width forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Integral n => IO (Maybe (Window n))
size
  let msg' :: [Char]
msg' = [[Char]] -> [Char]
unwords [[Char]
"Processing file", forall a. Show a => a -> [Char]
show (Int
cur forall a. Num a => a -> a -> a
+ Int
1) forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
total forall a. [a] -> [a] -> [a]
++ [Char]
":", [Char]
f] forall a. [a] -> [a] -> [a]
++ [Char]
"..."
  [Char]
msg <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case Maybe Int
mw of
    Maybe Int
Nothing -> Handle -> [Char] -> IO ()
hPutStrLn Handle
hndl [Char]
"" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
msg'
    Just Int
w -> do
      Handle -> [Char] -> IO ()
hPutStr Handle
hndl forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
w Char
' '
      Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
"\r"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (Int
wforall a. Num a => a -> a -> a
-Int
8) forall a b. (a -> b) -> a -> b
$ [Char]
msg'
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
msg
  Bool
x <- [Char] -> DbMonad Bool
act [Char]
f
  if Bool
x
  then forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
" done\r"
  else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> [Char] -> IO ()
hPutStr Handle
hndl [Char]
" skipped\r"
  forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x

doIndex :: HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex :: HieDb -> Options -> Handle -> [[Char]] -> IO ()
doIndex HieDb
_ Options
opts Handle
_ [] | Options -> Bool
reindex Options
opts = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
doIndex HieDb
conn Options
opts Handle
h [[Char]]
files = do
  IORef NameCache
nc <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
  let progress' :: Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress' = if Options -> Bool
quiet Options
opts then (\Handle
_ Int
_ Int
_ [Char] -> DbMonad Bool
k -> [Char] -> DbMonad Bool
k) else Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress

  IO Seconds
istart <- IO (IO Seconds)
offsetTime
  (forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
done, forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
skipped)<- forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> ([a], [a])
partition forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\[Char]
f Int
n -> Handle
-> Int -> Int -> ([Char] -> DbMonad Bool) -> [Char] -> DbMonad Bool
progress' Handle
h (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
files) Int
n (forall (m :: * -> *).
(MonadIO m, NameCacheMonad m) =>
HieDb -> Maybe [Char] -> [Char] -> m Bool
addRefsFrom HieDb
conn (Options -> Maybe [Char]
srcBaseDir Options
opts)) [Char]
f) [[Char]]
files [Int
0..]
  Seconds
indexTime <- IO Seconds
istart

  IO Seconds
start <- IO (IO Seconds)
offsetTime
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
done forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ HieDb -> IO Int
garbageCollectTypeNames HieDb
conn
  Seconds
gcTime <- IO Seconds
start

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) forall a b. (a -> b) -> a -> b
$
    Handle -> [Char] -> IO ()
hPutStrLn Handle
h forall a b. (a -> b) -> a -> b
$ [Char]
"\nCompleted! (" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
done forall a. Semigroup a => a -> a -> a
<> [Char]
" indexed, " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
skipped forall a. Semigroup a => a -> a -> a
<> [Char]
" skipped in " forall a. Semigroup a => a -> a -> a
<> Seconds -> [Char]
showDuration Seconds
indexTime forall a. Semigroup a => a -> a -> a
<> [Char]
" + " forall a. Semigroup a => a -> a -> a
<> Seconds -> [Char]
showDuration Seconds
gcTime forall a. Semigroup a => a -> a -> a
<> [Char]
" gc)"

runCommand :: LibDir -> Options -> Command -> IO ()
runCommand :: LibDir -> Options -> Command -> IO ()
runCommand LibDir
libdir Options
opts Command
cmd = forall a. LibDir -> [Char] -> (DynFlags -> HieDb -> IO a) -> IO a
withHieDbAndFlags LibDir
libdir (Options -> [Char]
database Options
opts) forall a b. (a -> b) -> a -> b
$ \DynFlags
dynFlags HieDb
conn -> do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
trace Options
opts) forall a b. (a -> b) -> a -> b
$
    HieDb -> Maybe (Text -> IO ()) -> IO ()
setHieTrace HieDb
conn (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"\n****TRACE: "forall a. Semigroup a => a -> a -> a
<>))
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
reindex Options
opts) forall a b. (a -> b) -> a -> b
$ do
    HieDb -> IO ()
initConn HieDb
conn
    [[Char]]
files' <- forall a b. (a -> b) -> [a] -> [b]
map HieModuleRow -> [Char]
hieModuleHieFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieDb -> IO [HieModuleRow]
getAllIndexedMods HieDb
conn
    [[Char]]
files <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Char]]
files' forall a b. (a -> b) -> a -> b
$ \[Char]
f -> do
      Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
f
      if Bool
exists
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [Char]
f
      else do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
keepMissing Options
opts) forall a b. (a -> b) -> a -> b
$
          HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn [Char]
f
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    let n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
files
        orig :: Int
orig = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
files'
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) forall a b. (a -> b) -> a -> b
$
      Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [Char]
"Re-indexing " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
" files, deleting " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
nforall a. Num a => a -> a -> a
-Int
orig) forall a. [a] -> [a] -> [a]
++ [Char]
" files"
    HieDb -> Options -> Handle -> [[Char]] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [[Char]]
files
  case Command
cmd of
    Command
Init -> HieDb -> IO ()
initConn HieDb
conn
    Index [[Char]]
dirs -> do
      HieDb -> IO ()
initConn HieDb
conn
      [[Char]]
files <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Char] -> IO [[Char]]
getHieFilesIn [[Char]]
dirs
      HieDb -> Options -> Handle -> [[Char]] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [[Char]]
files
    TypeRefs [Char]
typ Maybe ModuleName
mn Maybe Unit
muid -> do
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
tcClsName [Char]
typ
      [Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [[Char]]
-> IO [Res RefRow]
findReferences HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe Unit
muid []
      Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [Res RefRow]
refs
    NameRefs [Char]
nm Maybe ModuleName
mn Maybe Unit
muid -> do
      let ns :: NameSpace
ns = if [Char] -> Bool
isCons [Char]
nm then NameSpace
dataName else NameSpace
varName
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns [Char]
nm
      [Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [[Char]]
-> IO [Res RefRow]
findReferences HieDb
conn Bool
False OccName
occ Maybe ModuleName
mn Maybe Unit
muid []
      Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [Res RefRow]
refs
    NameDef [Char]
nm Maybe ModuleName
mn Maybe Unit
muid -> do
      let ns :: NameSpace
ns = if [Char] -> Bool
isCons [Char]
nm then NameSpace
dataName else NameSpace
varName
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
ns [Char]
nm
      (DefRow
row:.ModuleInfo
inf) <- forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn OccName
occ Maybe ModuleName
mn Maybe Unit
muid
      let mdl :: Module
mdl = forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
      Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module
mdl, (DefRow -> Int
defSLine DefRow
row, DefRow -> Int
defSCol DefRow
row), (DefRow -> Int
defELine DefRow
row, DefRow -> Int
defECol DefRow
row),forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (DefRow -> [Char]
defSrc DefRow
row))]
    TypeDef [Char]
nm Maybe ModuleName
mn Maybe Unit
muid -> do
      let occ :: OccName
occ = NameSpace -> [Char] -> OccName
mkOccName NameSpace
tcClsName [Char]
nm
      (DefRow
row:.ModuleInfo
inf) <- forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn OccName
occ Maybe ModuleName
mn Maybe Unit
muid
      let mdl :: Module
mdl = forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
      Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module
mdl, (DefRow -> Int
defSLine DefRow
row, DefRow -> Int
defSCol DefRow
row), (DefRow -> Int
defELine DefRow
row, DefRow -> Int
defECol DefRow
row),forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (DefRow -> [Char]
defSrc DefRow
row))]
    Cat HieTarget
target -> forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target (ByteString -> IO ()
BS.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> ByteString
hie_hs_src)
    Command
Ls -> do
      [HieModuleRow]
mods <- HieDb -> IO [HieModuleRow]
getAllIndexedMods HieDb
conn
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieModuleRow]
mods forall a b. (a -> b) -> a -> b
$ \HieModuleRow
mod -> do
        [Char] -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ HieModuleRow -> [Char]
hieModuleHieFile HieModuleRow
mod
        [Char] -> IO ()
putStr [Char]
"\t"
        [Char] -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ ModuleName -> [Char]
moduleNameString forall a b. (a -> b) -> a -> b
$ ModuleInfo -> ModuleName
modInfoName forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
mod
        [Char] -> IO ()
putStr [Char]
"\t"
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall u. IsUnitId u => u -> [Char]
unitString forall a b. (a -> b) -> a -> b
$ ModuleInfo -> Unit
modInfoUnit forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
mod
    LsExports Maybe ModuleName
mn -> do
      [ExportRow]
exports <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> IO [ExportRow]
getAllIndexedExports HieDb
conn) (HieDb -> ModuleName -> IO [ExportRow]
getExportsForModule HieDb
conn) Maybe ModuleName
mn
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExportRow]
exports forall a b. (a -> b) -> a -> b
$ \ExportRow{Bool
[Char]
Maybe OccName
Maybe Unit
Maybe ModuleName
OccName
Unit
ModuleName
exportIsDatacon :: ExportRow -> Bool
exportParentUnit :: ExportRow -> Maybe Unit
exportParentMod :: ExportRow -> Maybe ModuleName
exportParent :: ExportRow -> Maybe OccName
exportUnit :: ExportRow -> Unit
exportMod :: ExportRow -> ModuleName
exportName :: ExportRow -> OccName
exportHieFile :: ExportRow -> [Char]
exportIsDatacon :: Bool
exportParentUnit :: Maybe Unit
exportParentMod :: Maybe ModuleName
exportParent :: Maybe OccName
exportUnit :: Unit
exportMod :: ModuleName
exportName :: OccName
exportHieFile :: [Char]
..} -> do
        [Char] -> IO ()
putStr [Char]
exportHieFile
        [Char] -> IO ()
putStr [Char]
"\t"
        case Maybe OccName
exportParent of
          Maybe OccName
Nothing -> [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ OccName -> [Char]
occNameString OccName
exportName
          Just OccName
p -> forall r. PrintfType r => [Char] -> r
printf [Char]
"%s(%s)\n" (OccName -> [Char]
occNameString OccName
p) (OccName -> [Char]
occNameString OccName
exportName)
    Rm [HieTarget]
targets -> do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieTarget]
targets forall a b. (a -> b) -> a -> b
$ \HieTarget
target -> do
          case HieTarget
target of
            Left [Char]
f -> do
              Bool
dir <- [Char] -> IO Bool
doesDirectoryExist [Char]
f
              if Bool
dir
              then do
                [[Char]]
fs <- [Char] -> IO [[Char]]
getHieFilesIn [Char]
f
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn) [[Char]]
fs
              else do
                [Char]
cf <- [Char] -> IO [Char]
canonicalizePath [Char]
f
                HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn [Char]
cf
            Right (ModuleName
mn,Maybe Unit
muid) -> do
              Unit
uid <- forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) Maybe Unit
muid
              Maybe HieModuleRow
mFile <- HieDb -> ModuleName -> Unit -> IO (Maybe HieModuleRow)
lookupHieFile HieDb
conn ModuleName
mn Unit
uid
              case Maybe HieModuleRow
mFile of
                Maybe HieModuleRow
Nothing -> forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (ModuleName -> Maybe Unit -> HieDbErr
NotIndexed ModuleName
mn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Unit
uid)
                Just HieModuleRow
x -> HieDb -> [Char] -> IO ()
deleteFileFromIndex HieDb
conn (HieModuleRow -> [Char]
hieModuleHieFile HieModuleRow
x)
    ModuleUIDs ModuleName
mn ->
      forall a. Show a => a -> IO ()
print forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn
    LookupHieFile ModuleName
mn Maybe Unit
muid -> forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
      Either HieDbErr Unit
euid <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right) Maybe Unit
muid
      case Either HieDbErr Unit
euid of
        Left HieDbErr
err -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left HieDbErr
err
        Right Unit
uid -> do
          Maybe HieModuleRow
mFile <- HieDb -> ModuleName -> Unit -> IO (Maybe HieModuleRow)
lookupHieFile HieDb
conn ModuleName
mn Unit
uid
          case Maybe HieModuleRow
mFile of
            Maybe HieModuleRow
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (ModuleName -> Maybe Unit -> HieDbErr
NotIndexed ModuleName
mn forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Unit
uid)
            Just HieModuleRow
x -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO ()
putStrLn (HieModuleRow -> [Char]
hieModuleHieFile HieModuleRow
x)
    RefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      let names :: [Name]
names = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) forall a b. (a -> b) -> a -> b
$
        forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names forall a b. (a -> b) -> a -> b
$ \Name
name -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) forall a b. (a -> b) -> a -> b
$ do
          Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Name", Options -> OccName -> [Char]
ppName Options
opts (Name -> OccName
nameOccName Name
name),[Char]
"at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
sp,[Char]
"is used at:"]
          Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
""
        case Name -> Maybe Module
nameModule_maybe Name
name of
          Just Module
mod -> do
            Options -> [Res RefRow] -> IO ()
reportRefs Options
opts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [[Char]]
-> IO [Res RefRow]
findReferences HieDb
conn Bool
False (Name -> OccName
nameOccName Name
name) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> unit
moduleUnit Module
mod) []
          Maybe Module
Nothing -> do
            let refmap :: RefMap Int
refmap = forall (f :: * -> *) a. Foldable f => f (HieAST a) -> RefMap a
generateReferencesMap (forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts forall a b. (a -> b) -> a -> b
$ HieFile -> HieASTs Int
hie_asts HieFile
hf)
                refs :: [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
refs = forall a b. (a -> b) -> [a] -> [b]
map (forall {a}.
RealSrcSpan
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
toRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] (forall a b. b -> Either a b
Right Name
name) RefMap Int
refmap
                toRef :: RealSrcSpan
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
toRef RealSrcSpan
spn = (HieFile -> Module
hie_module HieFile
hf
                            ,(RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
spn , RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
spn)
                            ,(RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
spn , RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
spn)
                            ,forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (HieFile -> ByteString
hie_hs_src HieFile
hf))
            Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts forall {a}.
[(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
refs
    TypesAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      let types' :: [Int]
types' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep forall a b. (a -> b) -> a -> b
$ forall a. NodeInfo a -> [a]
nodeType forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
          types :: [HieTypeFix]
types = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType forall a b. (a -> b) -> a -> b
$ HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf) [Int]
types'
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HieTypeFix]
types) forall a b. (a -> b) -> a -> b
$
        forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieTypeFix]
types forall a b. (a -> b) -> a -> b
$ \HieTypeFix
typ -> do
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ DynFlags -> HieTypeFix -> [Char]
renderHieType DynFlags
dynFlags HieTypeFix
typ
    DefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      let names :: [Name]
names = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
rights forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) forall a b. (a -> b) -> a -> b
$
        forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names forall a b. (a -> b) -> a -> b
$ \Name
name -> do
        case Name -> SrcSpan
nameSrcSpan Name
name of
#if __GLASGOW_HASKELL__ >= 900
          RealSrcSpan RealSrcSpan
dsp Maybe BufSpan
_ -> do
#else
          RealSrcSpan dsp -> do
#endif
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) forall a b. (a -> b) -> a -> b
$
              Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Name", Options -> OccName -> [Char]
ppName Options
opts (Name -> OccName
nameOccName Name
name),[Char]
"at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
sp,[Char]
"is defined at:"]
            Maybe (Either [Char] ByteString)
contents <- case Name -> Maybe Module
nameModule_maybe Name
name of
              Maybe Module
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
              Just Module
mod
                | Module
mod forall a. Eq a => a -> a -> Bool
== HieFile -> Module
hie_module HieFile
hf -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
                | Bool
otherwise -> forall a. IO a -> IO a
unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ do
                    Either HieDbErr (DefRow :. ModuleInfo)
loc <- HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn (Name -> OccName
nameOccName Name
name) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> unit
moduleUnit Module
mod)
                    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either HieDbErr (DefRow :. ModuleInfo)
loc of
                      Left HieDbErr
_ -> forall a. Maybe a
Nothing
                      Right (DefRow
row:.ModuleInfo
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ DefRow -> [Char]
defSrc DefRow
row

            Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts
              [(forall a. a -> Maybe a -> a
fromMaybe (HieFile -> Module
hie_module HieFile
hf) (Name -> Maybe Module
nameModule_maybe Name
name)
               ,(RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
dsp,RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
dsp)
               ,(RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
dsp, RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
dsp)
               ,Maybe (Either [Char] ByteString)
contents
               )]
          UnhelpfulSpan UnhelpfulSpanReason
msg -> do
            case Name -> Maybe Module
nameModule_maybe Name
name of
              Just Module
mod -> do
                (DefRow
row:.ModuleInfo
inf) <- forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts
                    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
findOneDef HieDb
conn (Name -> OccName
nameOccName Name
name) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mod) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> unit
moduleUnit Module
mod)
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) forall a b. (a -> b) -> a -> b
$
                  Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"Name", Options -> OccName -> [Char]
ppName Options
opts (Name -> OccName
nameOccName Name
name),[Char]
"at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
sp,[Char]
"is defined at:"]
                Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts
                  [(forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
                   ,(DefRow -> Int
defSLine DefRow
row,DefRow -> Int
defSCol DefRow
row)
                   ,(DefRow -> Int
defELine DefRow
row,DefRow -> Int
defECol DefRow
row)
                   ,forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ DefRow -> [Char]
defSrc DefRow
row
                   )]
              Maybe Module
Nothing -> do
                forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Name -> [Char] -> HieDbErr
NameUnhelpfulSpan Name
name (FastString -> [Char]
unpackFS forall a b. (a -> b) -> a -> b
$ UnhelpfulSpanReason -> FastString
unhelpfulSpanFS UnhelpfulSpanReason
msg)
    InfoAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo DynFlags
dynFlags) forall a b. (a -> b) -> a -> b
$ forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep forall a b. (a -> b) -> a -> b
$ \HieAST Int
ast ->
        (HieTypeFix -> IfaceType
hieTypeToIface forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType (HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieAST Int -> NodeInfo Int
nodeInfo' HieAST Int
ast, forall a. HieAST a -> RealSrcSpan
nodeSpan HieAST Int
ast)
    Command
RefGraph -> HieDb -> IO ()
declRefs HieDb
conn
    Dump [Char]
path -> do
      IORef NameCache
nc <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
      forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(NameCacheMonad m, MonadIO m) =>
DynFlags -> [Char] -> m ()
dump DynFlags
dynFlags [Char]
path
    Reachable [Symbol]
s -> HieDb -> [Symbol] -> IO [Vertex]
getReachable HieDb
conn [Symbol]
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Show a => a -> IO ()
print
    Unreachable [Symbol]
s -> HieDb -> [Symbol] -> IO [Vertex]
getUnreachable HieDb
conn [Symbol]
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Show a => a -> IO ()
print
    Html [Symbol]
s -> do
      IORef NameCache
nc <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
      forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(NameCacheMonad m, MonadIO m) =>
HieDb -> [Symbol] -> m ()
html HieDb
conn [Symbol]
s
    Command
GCTypeNames -> do
      IO Seconds
start <- IO (IO Seconds)
offsetTime
      Int
n <- HieDb -> IO Int
garbageCollectTypeNames HieDb
conn
      Seconds
end <- IO Seconds
start
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) forall a b. (a -> b) -> a -> b
$
        Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ [Char]
"GCed " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n forall a. [a] -> [a] -> [a]
++ [Char]
" types in " forall a. Semigroup a => a -> a -> a
<> Seconds -> [Char]
showDuration Seconds
end

printInfo :: DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo :: DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo DynFlags
dynFlags NodeInfo IfaceType
x RealSrcSpan
sp = do
  [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Span: " forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags (forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
sp)
  [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Constructors: " forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags (forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ forall a. NodeInfo a -> Set NodeAnnotation
nodeAnnotations NodeInfo IfaceType
x)
  [Char] -> IO ()
putStrLn [Char]
"Identifiers:"
  let idents :: [(Either ModuleName Name, IdentifierDetails IfaceType)]
idents = forall k a. Map k a -> [(k, a)]
M.toList forall a b. (a -> b) -> a -> b
$ forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo IfaceType
x
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Either ModuleName Name, IdentifierDetails IfaceType)]
idents forall a b. (a -> b) -> a -> b
$ \(Either ModuleName Name
ident,IdentifierDetails IfaceType
inf) -> do
    case Either ModuleName Name
ident of
      Left ModuleName
mdl -> [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Module: " forall a. [a] -> [a] -> [a]
++ ModuleName -> [Char]
moduleNameString ModuleName
mdl
      Right Name
nm -> do
        case Name -> Maybe Module
nameModule_maybe Name
nm of
          Maybe Module
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just Module
m -> do
            [Char] -> IO ()
putStr [Char]
"Symbol:"
            forall a. Show a => a -> IO ()
print forall a b. (a -> b) -> a -> b
$ OccName -> Module -> Symbol
Symbol (Name -> OccName
nameOccName Name
nm) Module
m
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags forall a b. (a -> b) -> a -> b
$
          SDoc -> Int -> SDoc -> SDoc
hang (forall a. Outputable a => a -> SDoc
ppr Name
nm SDoc -> SDoc -> SDoc
<+> [Char] -> SDoc
text [Char]
"defined at" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr (Name -> SrcSpan
nameSrcSpan Name
nm)) Int
4 (forall a. Outputable a => a -> SDoc
ppr IdentifierDetails IfaceType
inf)
  [Char] -> IO ()
putStrLn [Char]
"Types:"
  let types :: [IfaceType]
types = forall a. NodeInfo a -> [a]
nodeType NodeInfo IfaceType
x
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [IfaceType]
types forall a b. (a -> b) -> a -> b
$ \IfaceType
typ -> do
    [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> [Char]
showSDoc DynFlags
dynFlags (forall a. Outputable a => a -> SDoc
ppr IfaceType
typ)
  [Char] -> IO ()
putStrLn [Char]
""

hieFileCommand :: HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand :: forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target HieFile -> IO a
f = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a.
HieDb -> HieTarget -> (HieFile -> a) -> IO (Either HieDbErr a)
withTarget HieDb
conn HieTarget
target HieFile -> IO a
f

reportAmbiguousErr :: Options -> Either HieDbErr a -> IO a
reportAmbiguousErr :: forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
_ (Right a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return a
x
reportAmbiguousErr Options
o (Left HieDbErr
e) = do
  Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ Options -> HieDbErr -> [Char]
showHieDbErr Options
o HieDbErr
e
  forall a. IO a
exitFailure

showHieDbErr :: Options -> HieDbErr -> String
showHieDbErr :: Options -> HieDbErr -> [Char]
showHieDbErr Options
opts HieDbErr
e = case HieDbErr
e of
  NoNameAtPoint HieTarget
t (Int, Int)
spn -> [[Char]] -> [Char]
unwords [[Char]
"No symbols found at",Options -> (Int, Int) -> [Char]
ppSpan Options
opts (Int, Int)
spn,[Char]
"in",forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (\(ModuleName
mn,Maybe Unit
muid) -> Options -> ModuleName -> [Char]
ppMod Options
opts ModuleName
mn forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\Unit
uid -> [Char]
"("forall a. [a] -> [a] -> [a]
++Options -> Unit -> [Char]
ppUnit Options
opts Unit
uidforall a. [a] -> [a] -> [a]
++[Char]
")") Maybe Unit
muid) HieTarget
t]
  NotIndexed ModuleName
mn Maybe Unit
muid -> [[Char]] -> [Char]
unwords [[Char]
"Module", Options -> ModuleName -> [Char]
ppMod Options
opts ModuleName
mn forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\Unit
uid -> [Char]
"("forall a. [a] -> [a] -> [a]
++Options -> Unit -> [Char]
ppUnit Options
opts Unit
uidforall a. [a] -> [a] -> [a]
++[Char]
")") Maybe Unit
muid, [Char]
"not indexed."]
  AmbiguousUnitId NonEmpty ModuleInfo
xs -> [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ [Char]
"Unit could be any of:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (([Char]
" - "forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u. IsUnitId u => u -> [Char]
unitString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> Unit
modInfoUnit) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ModuleInfo
xs)
    forall a. Semigroup a => a -> a -> a
<> [[Char]
"Use --unit-id to disambiguate"]
  NameNotFound OccName
occ Maybe ModuleName
mn Maybe Unit
muid -> [[Char]] -> [Char]
unwords
    [[Char]
"Couldn't find name:", Options -> OccName -> [Char]
ppName Options
opts OccName
occ, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (([Char]
"from module " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Char]
moduleNameString) Maybe ModuleName
mn forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\Unit
uid ->[Char]
"("forall a. [a] -> [a] -> [a]
++Options -> Unit -> [Char]
ppUnit Options
opts Unit
uidforall a. [a] -> [a] -> [a]
++[Char]
")") Maybe Unit
muid]
  NameUnhelpfulSpan Name
nm [Char]
msg -> [[Char]] -> [Char]
unwords
    [[Char]
"Got no helpful spans for:", OccName -> [Char]
occNameString (Name -> OccName
nameOccName Name
nm), [Char]
"\nMsg:", [Char]
msg]

reportRefSpans :: Options -> [(Module,(Int,Int),(Int,Int),Maybe (Either FilePath BS.ByteString))] -> IO ()
reportRefSpans :: Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module, (Int, Int), (Int, Int),
  Maybe (Either [Char] ByteString))]
xs = do
  IORef NameCache
nc <- forall a. a -> IO (IORef a)
newIORef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
  forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Module, (Int, Int), (Int, Int),
  Maybe (Either [Char] ByteString))]
xs forall a b. (a -> b) -> a -> b
$ \(Module
mn,(Int
sl,Int
sc),(Int
el,Int
ec),Maybe (Either [Char] ByteString)
hie_f) -> do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
        [Char] -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ Options -> ModuleName -> [Char]
ppMod Options
opts forall a b. (a -> b) -> a -> b
$ forall unit. GenModule unit -> ModuleName
moduleName Module
mn
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
        [Char] -> IO ()
putStr [Char]
":"
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Magenta forall a. a -> a
id Options
opts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ forall a. Show a => a -> [Char]
show Int
sl
          , Char
':'forall a. a -> [a] -> [a]
:forall a. Show a => a -> [Char]
show Int
sc
          , Char
'-'forall a. a -> [a] -> [a]
:forall a. Show a => a -> [Char]
show Int
el
          , Char
':'forall a. a -> [a] -> [a]
:forall a. Show a => a -> [Char]
show Int
ec
          ]
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) forall a b. (a -> b) -> a -> b
$
          [SGR] -> IO ()
setSGR []
      case Options -> Maybe Natural
context Options
opts of
        Maybe Natural
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n) -> do
          Maybe ByteString
msrc <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Either [Char] ByteString)
hie_f forall a b. (a -> b) -> a -> b
$ \case
            Left [Char]
loc -> forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
[Char] -> (HieFile -> m a) -> m a
withHieFile [Char]
loc forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> ByteString
hie_hs_src
            Right ByteString
src -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
src
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
msrc of
            Maybe ByteString
Nothing -> [Char] -> IO ()
putStrLn [Char]
"<source unavailable>"
            Just ByteString
src -> do
              let ls :: [ByteString]
ls = ByteString -> [ByteString]
BS.lines ByteString
src

                  ([ByteString]
beforeLines',[ByteString]
duringLines') = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
slforall a. Num a => a -> a -> a
-Int
1) [ByteString]
ls
                  ([ByteString]
duringLines,[ByteString]
afterLines')   = forall a. Int -> [a] -> ([a], [a])
splitAt (Int
elforall a. Num a => a -> a -> a
-Int
slforall a. Num a => a -> a -> a
+Int
1) [ByteString]
duringLines'

                  beforeLines :: [ByteString]
beforeLines = forall a. Int -> [a] -> [a]
takeEnd Int
n [ByteString]
beforeLines'
                  afterLines :: [ByteString]
afterLines  = forall a. Int -> [a] -> [a]
take    Int
n [ByteString]
afterLines'

                  (ByteString
beforeChars,ByteString
during') = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
scforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse ByteString
"\n" forall a b. (a -> b) -> a -> b
$ [ByteString]
duringLines
                  (ByteString
during,ByteString
afterChars) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (ByteString -> Int
BS.length ByteString
during' forall a. Num a => a -> a -> a
- (ByteString -> Int
BS.length (forall a. [a] -> a
last [ByteString]
duringLines) forall a. Num a => a -> a -> a
- Int
ec) forall a. Num a => a -> a -> a
- Int
1) ByteString
during'

                  before :: ByteString
before = [ByteString] -> ByteString
BS.unlines [ByteString]
beforeLines forall a. Semigroup a => a -> a -> a
<> ByteString
beforeChars
                  after :: ByteString
after  = ByteString
afterChars forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
BS.unlines [ByteString]
afterLines

              ByteString -> IO ()
BS.putStr ByteString
before
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) forall a b. (a -> b) -> a -> b
$
                [SGR] -> IO ()
setSGR [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red, ConsoleIntensity -> SGR
SetConsoleIntensity ConsoleIntensity
BoldIntensity]
              ByteString -> IO ()
BS.putStr ByteString
during
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) forall a b. (a -> b) -> a -> b
$
                [SGR] -> IO ()
setSGR []
              ByteString -> IO ()
BS.putStrLn ByteString
after

reportRefs :: Options -> [Res RefRow] -> IO ()
reportRefs :: Options -> [Res RefRow] -> IO ()
reportRefs Options
opts [Res RefRow]
xs = Options
-> [(Module, (Int, Int), (Int, Int),
     Maybe (Either [Char] ByteString))]
-> IO ()
reportRefSpans Options
opts
  [ (Module
mdl,(RefRow -> Int
refSLine RefRow
x, RefRow -> Int
refSCol RefRow
x),(RefRow -> Int
refELine RefRow
x, RefRow -> Int
refECol RefRow
x),forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ RefRow -> [Char]
refSrc RefRow
x)
  | (RefRow
x:.ModuleInfo
inf) <- [Res RefRow]
xs
  , let mdl :: Module
mdl = forall u. u -> ModuleName -> GenModule u
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
  ]

colouredPP :: Color -> (a -> String) -> Options -> a -> String
colouredPP :: forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
c a -> [Char]
pp Options
opts a
x = [Char]
pre forall a. Semigroup a => a -> a -> a
<> a -> [Char]
pp a
x forall a. Semigroup a => a -> a -> a
<> [Char]
post
  where
    ([Char]
pre,[Char]
post)
      | Options -> Bool
colour Options
opts = ([SGR] -> [Char]
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
c], [SGR] -> [Char]
setSGRCode [])
      | Bool
otherwise = ([Char]
"",[Char]
"")


ppName :: Options -> OccName -> String
ppName :: Options -> OccName -> [Char]
ppName = forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Red OccName -> [Char]
occNameString

ppMod :: Options -> ModuleName -> String
ppMod :: Options -> ModuleName -> [Char]
ppMod = forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Green ModuleName -> [Char]
moduleNameString

ppUnit :: Options -> Unit -> String
ppUnit :: Options -> Unit -> [Char]
ppUnit = forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Yellow forall a. Show a => a -> [Char]
show

ppSpan :: Options -> (Int,Int) -> String
ppSpan :: Options -> (Int, Int) -> [Char]
ppSpan = forall a. Color -> (a -> [Char]) -> Options -> a -> [Char]
colouredPP Color
Magenta forall a. Show a => a -> [Char]
show