{-# 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
FilePath
defaultLoc <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"default_"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
dB_VERSION FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
".hiedb"
FilePath
defdb <- FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
defaultLoc (Maybe FilePath -> FilePath) -> IO (Maybe FilePath) -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"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) <- ParserInfo (Options, Command) -> IO (Options, Command)
forall a. ParserInfo a -> IO a
execParser (ParserInfo (Options, Command) -> IO (Options, Command))
-> ParserInfo (Options, Command) -> IO (Options, Command)
forall a b. (a -> b) -> a -> b
$ FilePath -> Bool -> ParserInfo (Options, Command)
progParseInfo FilePath
defdb Bool
colr
LibDir -> Options -> Command -> IO ()
runCommand LibDir
libdir Options
opts Command
cmd
data Options
= Options
{ Options -> FilePath
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
}
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 :: FilePath -> Bool -> ParserInfo (Options, Command)
progParseInfo FilePath
db Bool
colr = Parser (Options, Command)
-> InfoMod (Options, Command) -> ParserInfo (Options, Command)
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Bool -> Parser (Options, Command)
progParser FilePath
db Bool
colr Parser (Options, Command)
-> Parser ((Options, Command) -> (Options, Command))
-> Parser (Options, Command)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser ((Options, Command) -> (Options, Command))
forall a. Parser (a -> a)
helper)
( InfoMod (Options, Command)
forall a. InfoMod a
fullDesc
InfoMod (Options, Command)
-> InfoMod (Options, Command) -> InfoMod (Options, Command)
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod (Options, Command)
forall a. FilePath -> InfoMod a
progDesc FilePath
"Query .hie files"
InfoMod (Options, Command)
-> InfoMod (Options, Command) -> InfoMod (Options, Command)
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod (Options, Command)
forall a. FilePath -> InfoMod a
header FilePath
"hiedb - a tool to query groups of .hie files" )
progParser :: FilePath -> Bool -> Parser (Options,Command)
progParser :: FilePath -> Bool -> Parser (Options, Command)
progParser FilePath
db Bool
colr = (,) (Options -> Command -> (Options, Command))
-> Parser Options -> Parser (Command -> (Options, Command))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Bool -> Parser Options
optParser FilePath
db Bool
colr Parser (Command -> (Options, Command))
-> Parser Command -> Parser (Options, Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Command
cmdParser
optParser :: FilePath -> Bool -> Parser Options
optParser :: FilePath -> Bool -> Parser Options
optParser FilePath
defdb Bool
colr
= FilePath
-> Bool -> Bool -> Bool -> Maybe Natural -> Bool -> Bool -> Options
Options
(FilePath
-> Bool
-> Bool
-> Bool
-> Maybe Natural
-> Bool
-> Bool
-> Options)
-> Parser FilePath
-> Parser
(Bool -> Bool -> Bool -> Maybe Natural -> Bool -> Bool -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"database" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'D' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DATABASE"
Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
defdb Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"References Database")
Parser
(Bool -> Bool -> Bool -> Maybe Natural -> Bool -> Bool -> Options)
-> Parser Bool
-> Parser
(Bool -> Bool -> Maybe Natural -> Bool -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"trace" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Print SQL queries being executed")
Parser (Bool -> Bool -> Maybe Natural -> Bool -> Bool -> Options)
-> Parser Bool
-> Parser (Bool -> Maybe Natural -> Bool -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"quiet" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'q' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Don't print progress messages")
Parser (Bool -> Maybe Natural -> Bool -> Bool -> Options)
-> Parser Bool -> Parser (Maybe Natural -> Bool -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
colourFlag
Parser (Maybe Natural -> Bool -> Bool -> Options)
-> Parser (Maybe Natural) -> Parser (Bool -> Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Natural -> Parser (Maybe Natural)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Natural -> Mod OptionFields Natural -> Parser Natural
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Natural
forall a. Read a => ReadM a
auto (FilePath -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"context" Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Natural
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'C' Mod OptionFields Natural
-> Mod OptionFields Natural -> Mod OptionFields Natural
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Natural
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Number of lines of context for source spans - show no context by default"))
Parser (Bool -> Bool -> Options)
-> Parser Bool -> Parser (Bool -> Options)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"reindex" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Re-index all files in database before running command, deleting those with missing '.hie' files")
Parser (Bool -> Options) -> Parser Bool -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"keep-missing" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Keep missing files when re-indexing")
where
colourFlag :: Parser Bool
colourFlag = Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"colour" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"color" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Force coloured output")
Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-colour" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-color" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Force uncoloured ouput")
Parser Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
colr
cmdParser :: Parser Command
cmdParser :: Parser Command
cmdParser
= Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser
(Mod CommandFields Command -> Parser Command)
-> Mod CommandFields Command -> Parser Command
forall a b. (a -> b) -> a -> b
$ FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"init" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Init) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Initialize database")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"index" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([FilePath] -> Command
Index ([FilePath] -> Command) -> Parser [FilePath] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIRECTORY..."))) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Index files from directory")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"name-refs" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe Unit -> Command
NameRefs (FilePath -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (FilePath -> ModuleName
mkModuleName (FilePath -> ModuleName) -> Parser FilePath -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"MODULE"))
Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup references of value MODULE.NAME")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"type-refs" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe Unit -> Command
TypeRefs (FilePath -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup references of type MODULE.NAME")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"name-def" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe Unit -> Command
NameDef (FilePath -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup definition of value MODULE.NAME")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"type-def" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Maybe ModuleName -> Maybe Unit -> Command
TypeDef (FilePath -> Maybe ModuleName -> Maybe Unit -> Command)
-> Parser FilePath
-> Parser (Maybe ModuleName -> Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NAME")
Parser (Maybe ModuleName -> Maybe Unit -> Command)
-> Parser (Maybe ModuleName) -> Parser (Maybe Unit -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser
Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup definition of type MODULE.NAME")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"cat" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> Command
Cat (HieTarget -> Command) -> Parser HieTarget -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Dump contents of MODULE as stored in the hiefile")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"ls" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
Ls)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"List all indexed files/modules")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"ls-exports" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Maybe ModuleName -> Command
LsExports (Maybe ModuleName -> Command)
-> Parser (Maybe ModuleName) -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName -> Parser (Maybe ModuleName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ModuleName
moduleNameParser)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"List all exports")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"rm" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([HieTarget] -> Command
Rm ([HieTarget] -> Command) -> Parser [HieTarget] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget -> Parser [HieTarget]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser HieTarget
hieTarget)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Remove targets from index")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"module-uids" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ModuleName -> Command
ModuleUIDs (ModuleName -> Command) -> Parser ModuleName -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"List all the UnitIds MODULE is indexed under in the db")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"lookup-hie" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (ModuleName -> Maybe Unit -> Command
LookupHieFile (ModuleName -> Maybe Unit -> Command)
-> Parser ModuleName -> Parser (Maybe Unit -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser Parser (Maybe Unit -> Command)
-> Parser (Maybe Unit) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe Unit)
maybeUnitId)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Lookup the location of the .hie file corresponding to MODULE")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"point-refs"
(Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
RefsAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find references for symbol at point/span")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"point-types"
(Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
TypesAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"List types of ast at point/span")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"point-defs"
(Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
DefsAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find definition for symbol at point/span")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"point-info"
(Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command
InfoAtPoint (HieTarget -> (Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser HieTarget
-> Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HieTarget
hieTarget
Parser ((Int, Int) -> Maybe (Int, Int) -> Command)
-> Parser (Int, Int) -> Parser (Maybe (Int, Int) -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Parser (Int, Int)
posParser Char
'S'
Parser (Maybe (Int, Int) -> Command)
-> Parser (Maybe (Int, Int)) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Int, Int) -> Parser (Maybe (Int, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser (Int, Int)
posParser Char
'E'))
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Print name, module name, unit id for symbol at point/span")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"ref-graph" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
RefGraph) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Generate a reachability graph")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"dump" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (FilePath -> Command
Dump (FilePath -> Command) -> Parser FilePath -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"HIE")) (InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Dump a HIE AST")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"reachable" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Reachable ([Symbol] -> Command) -> Parser [Symbol] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> Parser [Symbol]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find all symbols reachable from the given symbols")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"unreachable" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Unreachable ([Symbol] -> Command) -> Parser [Symbol] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> Parser [Symbol]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"Find all symbols unreachable from the given symbols")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"html" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info ([Symbol] -> Command
Html ([Symbol] -> Command) -> Parser [Symbol] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Symbol -> Parser [Symbol]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser Symbol
symbolParser)
(InfoMod Command -> ParserInfo Command)
-> InfoMod Command -> ParserInfo Command
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod Command
forall a. FilePath -> InfoMod a
progDesc FilePath
"generate html files for reachability from the given symbols")
Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Command -> Mod CommandFields Command
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"gc" (Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
GCTypeNames) InfoMod Command
forall a. Monoid a => a
mempty)
posParser :: Char -> Parser (Int,Int)
posParser :: Char -> Parser (Int, Int)
posParser Char
c = (,) (Int -> Int -> (Int, Int))
-> Parser Int -> Parser (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto (FilePath -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar (FilePath -> Mod ArgumentFields Int)
-> FilePath -> Mod ArgumentFields Int
forall a b. (a -> b) -> a -> b
$ Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
"LINE") Parser (Int -> (Int, Int)) -> Parser Int -> Parser (Int, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod ArgumentFields Int -> Parser Int
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Int
forall a. Read a => ReadM a
auto (FilePath -> Mod ArgumentFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar (FilePath -> Mod ArgumentFields Int)
-> FilePath -> Mod ArgumentFields Int
forall a b. (a -> b) -> a -> b
$ Char
cChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
"COL")
maybeUnitId :: Parser (Maybe Unit)
maybeUnitId :: Parser (Maybe Unit)
maybeUnitId =
Parser Unit -> Parser (Maybe Unit)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (FilePath -> Unit
stringToUnit (FilePath -> Unit) -> Parser FilePath -> Parser Unit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"unit-id" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"UNITID"))
symbolParser :: Parser Symbol
symbolParser :: Parser Symbol
symbolParser = ReadM Symbol -> Mod ArgumentFields Symbol -> Parser Symbol
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM Symbol
forall a. Read a => ReadM a
auto (Mod ArgumentFields Symbol -> Parser Symbol)
-> Mod ArgumentFields Symbol -> Parser Symbol
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod ArgumentFields Symbol
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SYMBOL"
moduleNameParser :: Parser ModuleName
moduleNameParser :: Parser ModuleName
moduleNameParser = FilePath -> ModuleName
mkModuleName (FilePath -> ModuleName) -> Parser FilePath -> Parser ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"MODULE")
hieTarget :: Parser HieTarget
hieTarget :: Parser HieTarget
hieTarget =
(FilePath -> HieTarget
forall a b. a -> Either a b
Left (FilePath -> HieTarget) -> Parser FilePath -> Parser HieTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"hiefile" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"HIEFILE"))
Parser HieTarget -> Parser HieTarget -> Parser HieTarget
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((ModuleName, Maybe Unit) -> HieTarget
forall a b. b -> Either a b
Right ((ModuleName, Maybe Unit) -> HieTarget)
-> Parser (ModuleName, Maybe Unit) -> Parser HieTarget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (ModuleName -> Maybe Unit -> (ModuleName, Maybe Unit))
-> Parser ModuleName
-> Parser (Maybe Unit -> (ModuleName, Maybe Unit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ModuleName
moduleNameParser Parser (Maybe Unit -> (ModuleName, Maybe Unit))
-> Parser (Maybe Unit) -> Parser (ModuleName, Maybe Unit)
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
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress Handle
hndl Int
total Int
cur FilePath -> DbMonad Bool
act FilePath
f = do
Maybe Int
mw <- IO (Maybe Int) -> DbMonadT IO (Maybe Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Int) -> DbMonadT IO (Maybe Int))
-> IO (Maybe Int) -> DbMonadT IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ (Window Int -> Int) -> Maybe (Window Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Window Int -> Int
forall a. Window a -> a
width (Maybe (Window Int) -> Maybe Int)
-> IO (Maybe (Window Int)) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Window Int))
forall n. Integral n => IO (Maybe (Window n))
size
let msg' :: FilePath
msg' = [FilePath] -> FilePath
unwords [FilePath
"Processing file", Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
total FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":", FilePath
f] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"..."
FilePath
msg <- IO FilePath -> DbMonadT IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> DbMonadT IO FilePath)
-> IO FilePath -> DbMonadT IO FilePath
forall a b. (a -> b) -> a -> b
$ case Maybe Int
mw of
Maybe Int
Nothing -> Handle -> FilePath -> IO ()
hPutStrLn Handle
hndl FilePath
"" IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
msg'
Just Int
w -> do
Handle -> FilePath -> IO ()
hPutStr Handle
hndl (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> FilePath
forall a. Int -> a -> [a]
replicate Int
w Char
' '
Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
"\r"
FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
8) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
msg'
IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
msg
Bool
x <- FilePath -> DbMonad Bool
act FilePath
f
if Bool
x
then IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
" done\r"
else IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStr Handle
hndl FilePath
" skipped\r"
Bool -> DbMonad Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
doIndex :: HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex :: HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex HieDb
_ Options
opts Handle
_ [] | Options -> Bool
reindex Options
opts = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
doIndex HieDb
conn Options
opts Handle
h [FilePath]
files = do
IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
let progress' :: Handle
-> Int
-> Int
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress' = if Options -> Bool
quiet Options
opts then (\Handle
_ Int
_ Int
_ FilePath -> DbMonad Bool
k -> FilePath -> DbMonad Bool
k) else Handle
-> Int
-> Int
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress
IO Seconds
istart <- IO (IO Seconds)
offsetTime
([Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
done, [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length -> Int
skipped)<- IORef NameCache -> DbMonad ([Bool], [Bool]) -> IO ([Bool], [Bool])
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonad ([Bool], [Bool]) -> IO ([Bool], [Bool]))
-> DbMonad ([Bool], [Bool]) -> IO ([Bool], [Bool])
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> ([Bool], [Bool])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Bool -> Bool
forall a. a -> a
id ([Bool] -> ([Bool], [Bool]))
-> DbMonadT IO [Bool] -> DbMonad ([Bool], [Bool])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(FilePath -> Int -> DbMonad Bool)
-> [FilePath] -> [Int] -> DbMonadT IO [Bool]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\FilePath
f Int
n -> Handle
-> Int
-> Int
-> (FilePath -> DbMonad Bool)
-> FilePath
-> DbMonad Bool
progress' Handle
h ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
files) Int
n (HieDb -> FilePath -> DbMonad Bool
forall (m :: * -> *).
(MonadIO m, NameCacheMonad m) =>
HieDb -> FilePath -> m Bool
addRefsFrom HieDb
conn) FilePath
f) [FilePath]
files [Int
0..]
Seconds
indexTime <- IO Seconds
istart
IO Seconds
start <- IO (IO Seconds)
offsetTime
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
done Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDb -> IO Int
garbageCollectTypeNames HieDb
conn
Seconds
gcTime <- IO Seconds
start
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> FilePath -> IO ()
hPutStrLn Handle
h (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"\nCompleted! (" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
done FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" indexed, " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Int -> FilePath
forall a. Show a => a -> FilePath
show Int
skipped FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" skipped in " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Seconds -> FilePath
showDuration Seconds
indexTime FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" + " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Seconds -> FilePath
showDuration Seconds
gcTime FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" gc)"
runCommand :: LibDir -> Options -> Command -> IO ()
runCommand :: LibDir -> Options -> Command -> IO ()
runCommand LibDir
libdir Options
opts Command
cmd = LibDir -> FilePath -> (DynFlags -> HieDb -> IO ()) -> IO ()
forall a. LibDir -> FilePath -> (DynFlags -> HieDb -> IO a) -> IO a
withHieDbAndFlags LibDir
libdir (Options -> FilePath
database Options
opts) ((DynFlags -> HieDb -> IO ()) -> IO ())
-> (DynFlags -> HieDb -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DynFlags
dynFlags HieDb
conn -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
trace Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
HieDb -> Maybe (Text -> IO ()) -> IO ()
setHieTrace HieDb
conn ((Text -> IO ()) -> Maybe (Text -> IO ())
forall a. a -> Maybe a
Just ((Text -> IO ()) -> Maybe (Text -> IO ()))
-> (Text -> IO ()) -> Maybe (Text -> IO ())
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStrLn Handle
stderr (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"\n****TRACE: "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>))
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
reindex Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
HieDb -> IO ()
initConn HieDb
conn
[FilePath]
files' <- (HieModuleRow -> FilePath) -> [HieModuleRow] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map HieModuleRow -> FilePath
hieModuleHieFile ([HieModuleRow] -> [FilePath])
-> IO [HieModuleRow] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieDb -> IO [HieModuleRow]
getAllIndexedMods HieDb
conn
[FilePath]
files <- ([Maybe FilePath] -> [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe FilePath] -> IO [FilePath])
-> IO [Maybe FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
files' ((FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath])
-> (FilePath -> IO (Maybe FilePath)) -> IO [Maybe FilePath]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
if Bool
exists
then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO (Maybe FilePath))
-> Maybe FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
keepMissing Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
HieDb -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn FilePath
f
Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
let n :: Int
n = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
files
orig :: Int
orig = [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
files'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Re-indexing " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" files, deleting " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
orig) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" files"
HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [FilePath]
files
case Command
cmd of
Command
Init -> HieDb -> IO ()
initConn HieDb
conn
Index [FilePath]
dirs -> do
HieDb -> IO ()
initConn HieDb
conn
[FilePath]
files <- [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
getHieFilesIn [FilePath]
dirs
HieDb -> Options -> Handle -> [FilePath] -> IO ()
doIndex HieDb
conn Options
opts Handle
stderr [FilePath]
files
TypeRefs FilePath
typ Maybe ModuleName
mn Maybe Unit
muid -> do
let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
tcClsName FilePath
typ
[Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [FilePath]
-> 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 FilePath
nm Maybe ModuleName
mn Maybe Unit
muid -> do
let ns :: NameSpace
ns = if FilePath -> Bool
isCons FilePath
nm then NameSpace
dataName else NameSpace
varName
let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
ns FilePath
nm
[Res RefRow]
refs <- HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [FilePath]
-> 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 FilePath
nm Maybe ModuleName
mn Maybe Unit
muid -> do
let ns :: NameSpace
ns = if FilePath -> Bool
isCons FilePath
nm then NameSpace
dataName else NameSpace
varName
let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
ns FilePath
nm
(DefRow
row:.ModuleInfo
inf) <- Options
-> Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo))
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
-> IO (DefRow :. ModuleInfo)
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 = Unit -> ModuleName -> Module
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
Options
-> [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath 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),Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (DefRow -> FilePath
defSrc DefRow
row))]
TypeDef FilePath
nm Maybe ModuleName
mn Maybe Unit
muid -> do
let occ :: OccName
occ = NameSpace -> FilePath -> OccName
mkOccName NameSpace
tcClsName FilePath
nm
(DefRow
row:.ModuleInfo
inf) <- Options
-> Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo))
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
-> IO (DefRow :. ModuleInfo)
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 = Unit -> ModuleName -> Module
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
Options
-> [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath 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),Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (DefRow -> FilePath
defSrc DefRow
row))]
Cat HieTarget
target -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target (ByteString -> IO ()
BS.putStrLn (ByteString -> IO ())
-> (HieFile -> ByteString) -> HieFile -> IO ()
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
[HieModuleRow] -> (HieModuleRow -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieModuleRow]
mods ((HieModuleRow -> IO ()) -> IO ())
-> (HieModuleRow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieModuleRow
mod -> do
FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> FilePath
hieModuleHieFile HieModuleRow
mod
FilePath -> IO ()
putStr FilePath
"\t"
FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
moduleNameString (ModuleName -> FilePath) -> ModuleName -> FilePath
forall a b. (a -> b) -> a -> b
$ ModuleInfo -> ModuleName
modInfoName (ModuleInfo -> ModuleName) -> ModuleInfo -> ModuleName
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
mod
FilePath -> IO ()
putStr FilePath
"\t"
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Unit -> FilePath
unitString (Unit -> FilePath) -> Unit -> FilePath
forall a b. (a -> b) -> a -> b
$ ModuleInfo -> Unit
modInfoUnit (ModuleInfo -> Unit) -> ModuleInfo -> Unit
forall a b. (a -> b) -> a -> b
$ HieModuleRow -> ModuleInfo
hieModInfo HieModuleRow
mod
LsExports Maybe ModuleName
mn -> do
[ExportRow]
exports <- IO [ExportRow]
-> (ModuleName -> IO [ExportRow])
-> Maybe ModuleName
-> IO [ExportRow]
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
[ExportRow] -> (ExportRow -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ExportRow]
exports ((ExportRow -> IO ()) -> IO ()) -> (ExportRow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ExportRow{Bool
FilePath
Maybe ModuleName
Maybe Unit
Maybe OccName
ModuleName
Unit
OccName
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 -> FilePath
exportIsDatacon :: Bool
exportParentUnit :: Maybe Unit
exportParentMod :: Maybe ModuleName
exportParent :: Maybe OccName
exportUnit :: Unit
exportMod :: ModuleName
exportName :: OccName
exportHieFile :: FilePath
..} -> do
FilePath -> IO ()
putStr FilePath
exportHieFile
FilePath -> IO ()
putStr FilePath
"\t"
case Maybe OccName
exportParent of
Maybe OccName
Nothing -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ OccName -> FilePath
occNameString OccName
exportName
Just OccName
p -> FilePath -> FilePath -> FilePath -> IO ()
forall r. PrintfType r => FilePath -> r
printf FilePath
"%s(%s)\n" (OccName -> FilePath
occNameString OccName
p) (OccName -> FilePath
occNameString OccName
exportName)
Rm [HieTarget]
targets -> do
[HieTarget] -> (HieTarget -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieTarget]
targets ((HieTarget -> IO ()) -> IO ()) -> (HieTarget -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieTarget
target -> do
case HieTarget
target of
Left FilePath
f -> do
Bool
dir <- FilePath -> IO Bool
doesDirectoryExist FilePath
f
if Bool
dir
then do
[FilePath]
fs <- FilePath -> IO [FilePath]
getHieFilesIn FilePath
f
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (HieDb -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn) [FilePath]
fs
else do
FilePath
cf <- FilePath -> IO FilePath
canonicalizePath FilePath
f
HieDb -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn FilePath
cf
Right (ModuleName
mn,Maybe Unit
muid) -> do
Unit
uid <- Options -> Either HieDbErr Unit -> IO Unit
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr Unit -> IO Unit)
-> IO (Either HieDbErr Unit) -> IO Unit
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either HieDbErr Unit)
-> (Unit -> IO (Either HieDbErr Unit))
-> Maybe Unit
-> IO (Either HieDbErr Unit)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn) (Either HieDbErr Unit -> IO (Either HieDbErr Unit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr Unit -> IO (Either HieDbErr Unit))
-> (Unit -> Either HieDbErr Unit)
-> Unit
-> IO (Either HieDbErr Unit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Either HieDbErr Unit
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 -> Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr () -> IO ()) -> Either HieDbErr () -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (ModuleName -> Maybe Unit -> HieDbErr
NotIndexed ModuleName
mn (Maybe Unit -> HieDbErr) -> Maybe Unit -> HieDbErr
forall a b. (a -> b) -> a -> b
$ Unit -> Maybe Unit
forall a. a -> Maybe a
Just Unit
uid)
Just HieModuleRow
x -> HieDb -> FilePath -> IO ()
deleteFileFromIndex HieDb
conn (HieModuleRow -> FilePath
hieModuleHieFile HieModuleRow
x)
ModuleUIDs ModuleName
mn ->
Unit -> IO ()
forall a. Show a => a -> IO ()
print (Unit -> IO ()) -> IO Unit -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Options -> Either HieDbErr Unit -> IO Unit
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr Unit -> IO Unit)
-> IO (Either HieDbErr Unit) -> IO Unit
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 -> Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr () -> IO ()) -> IO (Either HieDbErr ()) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
Either HieDbErr Unit
euid <- IO (Either HieDbErr Unit)
-> (Unit -> IO (Either HieDbErr Unit))
-> Maybe Unit
-> IO (Either HieDbErr Unit)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (HieDb -> ModuleName -> IO (Either HieDbErr Unit)
resolveUnitId HieDb
conn ModuleName
mn) (Either HieDbErr Unit -> IO (Either HieDbErr Unit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr Unit -> IO (Either HieDbErr Unit))
-> (Unit -> Either HieDbErr Unit)
-> Unit
-> IO (Either HieDbErr Unit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> Either HieDbErr Unit
forall a b. b -> Either a b
Right) Maybe Unit
muid
case Either HieDbErr Unit
euid of
Left HieDbErr
err -> Either HieDbErr () -> IO (Either HieDbErr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr () -> IO (Either HieDbErr ()))
-> Either HieDbErr () -> IO (Either HieDbErr ())
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
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 -> Either HieDbErr () -> IO (Either HieDbErr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieDbErr () -> IO (Either HieDbErr ()))
-> Either HieDbErr () -> IO (Either HieDbErr ())
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (ModuleName -> Maybe Unit -> HieDbErr
NotIndexed ModuleName
mn (Maybe Unit -> HieDbErr) -> Maybe Unit -> HieDbErr
forall a b. (a -> b) -> a -> b
$ Unit -> Maybe Unit
forall a. a -> Maybe a
Just Unit
uid)
Just HieModuleRow
x -> () -> Either HieDbErr ()
forall a b. b -> Either a b
Right (() -> Either HieDbErr ()) -> IO () -> IO (Either HieDbErr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ()
putStrLn (HieModuleRow -> FilePath
hieModuleHieFile HieModuleRow
x)
RefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
let names :: [Name]
names = [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> [Name])
-> [[Name]]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> [Name]) -> [[Name]])
-> (HieAST Int -> [Name]) -> [[Name]]
forall a b. (a -> b) -> a -> b
$ [Either ModuleName Name] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Either ModuleName Name] -> [Name])
-> (HieAST Int -> [Either ModuleName Name]) -> HieAST Int -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either ModuleName Name) (IdentifierDetails Int)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys (Map (Either ModuleName Name) (IdentifierDetails Int)
-> [Either ModuleName Name])
-> (HieAST Int
-> Map (Either ModuleName Name) (IdentifierDetails Int))
-> HieAST Int
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Int
-> Map (Either ModuleName Name) (IdentifierDetails Int))
-> (HieAST Int -> NodeInfo Int)
-> HieAST Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
[Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names ((Name -> IO ()) -> IO ()) -> (Name -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", Options -> OccName -> FilePath
ppName Options
opts (Name -> OccName
nameOccName Name
name),FilePath
"at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
sp,FilePath
"is used at:"]
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
""
case Name -> Maybe Module
nameModule_maybe Name
name of
Just Module
mod -> do
Options -> [Res RefRow] -> IO ()
reportRefs Options
opts ([Res RefRow] -> IO ()) -> IO [Res RefRow] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [FilePath]
-> IO [Res RefRow]
findReferences HieDb
conn Bool
False (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnit Module
mod) []
Maybe Module
Nothing -> do
let refmap :: Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
refmap = Map FastString (HieAST Int)
-> Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
forall (f :: * -> *) a.
Foldable f =>
f (HieAST a)
-> Map (Either ModuleName Name) [(Span, IdentifierDetails a)]
generateReferencesMap (HieASTs Int -> Map FastString (HieAST Int)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts (HieASTs Int -> Map FastString (HieAST Int))
-> HieASTs Int -> Map FastString (HieAST Int)
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 = ((Span, IdentifierDetails Int)
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString)))
-> [(Span, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
forall a b. (a -> b) -> [a] -> [b]
map (Span
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
forall a.
Span
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
toRef (Span
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString)))
-> ((Span, IdentifierDetails Int) -> Span)
-> (Span, IdentifierDetails Int)
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span, IdentifierDetails Int) -> Span
forall a b. (a, b) -> a
fst) ([(Span, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))])
-> [(Span, IdentifierDetails Int)]
-> [(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
forall a b. (a -> b) -> a -> b
$ [(Span, IdentifierDetails Int)]
-> Either ModuleName Name
-> Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
-> [(Span, IdentifierDetails Int)]
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault [] (Name -> Either ModuleName Name
forall a b. b -> Either a b
Right Name
name) Map (Either ModuleName Name) [(Span, IdentifierDetails Int)]
refmap
toRef :: Span
-> (Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))
toRef Span
spn = (HieFile -> Module
hie_module HieFile
hf
,(Span -> Int
srcSpanStartLine Span
spn , Span -> Int
srcSpanStartCol Span
spn)
,(Span -> Int
srcSpanEndLine Span
spn , Span -> Int
srcSpanEndCol Span
spn)
,Either a ByteString -> Maybe (Either a ByteString)
forall a. a -> Maybe a
Just (Either a ByteString -> Maybe (Either a ByteString))
-> Either a ByteString -> Maybe (Either a ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either a ByteString
forall a b. b -> Either a b
Right (HieFile -> ByteString
hie_hs_src HieFile
hf))
Options
-> [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
forall a.
[(Module, (Int, Int), (Int, Int), Maybe (Either a ByteString))]
refs
TypesAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
let types' :: [Int]
types' = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> [Int])
-> [[Int]]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> [Int]) -> [[Int]])
-> (HieAST Int -> [Int]) -> [[Int]]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> [Int]
forall a. NodeInfo a -> [a]
nodeType (NodeInfo Int -> [Int])
-> (HieAST Int -> NodeInfo Int) -> HieAST Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
types :: [HieTypeFix]
types = (Int -> HieTypeFix) -> [Int] -> [HieTypeFix]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Array Int HieTypeFlat -> HieTypeFix)
-> Array Int HieTypeFlat -> Int -> HieTypeFix
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType (Array Int HieTypeFlat -> Int -> HieTypeFix)
-> Array Int HieTypeFlat -> Int -> HieTypeFix
forall a b. (a -> b) -> a -> b
$ HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf) [Int]
types'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([HieTypeFix] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HieTypeFix]
types) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
[HieTypeFix] -> (HieTypeFix -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HieTypeFix]
types ((HieTypeFix -> IO ()) -> IO ()) -> (HieTypeFix -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieTypeFix
typ -> do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> HieTypeFix -> FilePath
renderHieType DynFlags
dynFlags HieTypeFix
typ
DefsAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
let names :: [Name]
names = [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> [Name])
-> [[Name]]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> [Name]) -> [[Name]])
-> (HieAST Int -> [Name]) -> [[Name]]
forall a b. (a -> b) -> a -> b
$ [Either ModuleName Name] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Either ModuleName Name] -> [Name])
-> (HieAST Int -> [Either ModuleName Name]) -> HieAST Int -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either ModuleName Name) (IdentifierDetails Int)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys (Map (Either ModuleName Name) (IdentifierDetails Int)
-> [Either ModuleName Name])
-> (HieAST Int
-> Map (Either ModuleName Name) (IdentifierDetails Int))
-> HieAST Int
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Int
-> Map (Either ModuleName Name) (IdentifierDetails Int))
-> (HieAST Int -> NodeInfo Int)
-> HieAST Int
-> Map (Either ModuleName Name) (IdentifierDetails Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Int -> NodeInfo Int
nodeInfo'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
names) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ HieTarget -> (Int, Int) -> HieDbErr
NoNameAtPoint HieTarget
target (Int, Int)
sp)
[Name] -> (Name -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Name]
names ((Name -> IO ()) -> IO ()) -> (Name -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Name
name -> do
case Name -> SrcSpan
nameSrcSpan Name
name of
#if __GLASGOW_HASKELL__ >= 900
RealSrcSpan dsp _ -> do
#else
RealSrcSpan Span
dsp -> do
#endif
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", Options -> OccName -> FilePath
ppName Options
opts (Name -> OccName
nameOccName Name
name),FilePath
"at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
sp,FilePath
"is defined at:"]
Maybe (Either FilePath ByteString)
contents <- case Name -> Maybe Module
nameModule_maybe Name
name of
Maybe Module
Nothing -> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString)))
-> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall a b. (a -> b) -> a -> b
$ Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath ByteString
forall a b. b -> Either a b
Right (ByteString -> Either FilePath ByteString)
-> ByteString -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
Just Module
mod
| Module
mod Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== HieFile -> Module
hie_module HieFile
hf -> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString)))
-> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall a b. (a -> b) -> a -> b
$ Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either FilePath ByteString
forall a b. b -> Either a b
Right (ByteString -> Either FilePath ByteString)
-> ByteString -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ HieFile -> ByteString
hie_hs_src HieFile
hf
| Bool
otherwise -> IO (Maybe (Either FilePath ByteString))
-> IO (Maybe (Either FilePath ByteString))
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Maybe (Either FilePath ByteString))
-> IO (Maybe (Either FilePath ByteString)))
-> IO (Maybe (Either FilePath ByteString))
-> IO (Maybe (Either FilePath ByteString))
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) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnit Module
mod)
Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString)))
-> Maybe (Either FilePath ByteString)
-> IO (Maybe (Either FilePath ByteString))
forall a b. (a -> b) -> a -> b
$ case Either HieDbErr (DefRow :. ModuleInfo)
loc of
Left HieDbErr
_ -> Maybe (Either FilePath ByteString)
forall a. Maybe a
Nothing
Right (DefRow
row:.ModuleInfo
_) -> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ByteString)
-> FilePath -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ DefRow -> FilePath
defSrc DefRow
row
Options
-> [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
-> IO ()
reportRefSpans Options
opts
[(Module -> Maybe Module -> Module
forall a. a -> Maybe a -> a
fromMaybe (HieFile -> Module
hie_module HieFile
hf) (Name -> Maybe Module
nameModule_maybe Name
name)
,(Span -> Int
srcSpanStartLine Span
dsp,Span -> Int
srcSpanStartCol Span
dsp)
,(Span -> Int
srcSpanEndLine Span
dsp, Span -> Int
srcSpanEndCol Span
dsp)
,Maybe (Either FilePath ByteString)
contents
)]
UnhelpfulSpan FastString
msg -> do
case Name -> Maybe Module
nameModule_maybe Name
name of
Just Module
mod -> do
(DefRow
row:.ModuleInfo
inf) <- Options
-> Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts
(Either HieDbErr (DefRow :. ModuleInfo)
-> IO (DefRow :. ModuleInfo))
-> IO (Either HieDbErr (DefRow :. ModuleInfo))
-> IO (DefRow :. ModuleInfo)
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) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnit Module
mod)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Name", Options -> OccName -> FilePath
ppName Options
opts (Name -> OccName
nameOccName Name
name),FilePath
"at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
sp,FilePath
"is defined at:"]
Options
-> [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
-> IO ()
reportRefSpans Options
opts
[(Unit -> ModuleName -> Module
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)
,Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ByteString)
-> FilePath -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ DefRow -> FilePath
defSrc DefRow
row
)]
Maybe Module
Nothing -> do
Options -> Either HieDbErr () -> IO ()
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr () -> IO ()) -> Either HieDbErr () -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDbErr -> Either HieDbErr ()
forall a b. a -> Either a b
Left (HieDbErr -> Either HieDbErr ()) -> HieDbErr -> Either HieDbErr ()
forall a b. (a -> b) -> a -> b
$ Name -> FilePath -> HieDbErr
NameUnhelpfulSpan Name
name (FastString -> FilePath
unpackFS (FastString -> FilePath) -> FastString -> FilePath
forall a b. (a -> b) -> a -> b
$ FastString -> FastString
unhelpfulSpanFS FastString
msg)
InfoAtPoint HieTarget
target (Int, Int)
sp Maybe (Int, Int)
mep -> HieDb -> Options -> HieTarget -> (HieFile -> IO ()) -> IO ()
forall a.
HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target ((HieFile -> IO ()) -> IO ()) -> (HieFile -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \HieFile
hf -> do
((NodeInfo IfaceType, Span) -> IO ())
-> [(NodeInfo IfaceType, Span)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((NodeInfo IfaceType -> Span -> IO ())
-> (NodeInfo IfaceType, Span) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((NodeInfo IfaceType -> Span -> IO ())
-> (NodeInfo IfaceType, Span) -> IO ())
-> (NodeInfo IfaceType -> Span -> IO ())
-> (NodeInfo IfaceType, Span)
-> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> NodeInfo IfaceType -> Span -> IO ()
printInfo DynFlags
dynFlags) ([(NodeInfo IfaceType, Span)] -> IO ())
-> [(NodeInfo IfaceType, Span)] -> IO ()
forall a b. (a -> b) -> a -> b
$ HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> (NodeInfo IfaceType, Span))
-> [(NodeInfo IfaceType, Span)]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand HieFile
hf (Int, Int)
sp Maybe (Int, Int)
mep ((HieAST Int -> (NodeInfo IfaceType, Span))
-> [(NodeInfo IfaceType, Span)])
-> (HieAST Int -> (NodeInfo IfaceType, Span))
-> [(NodeInfo IfaceType, Span)]
forall a b. (a -> b) -> a -> b
$ \HieAST Int
ast ->
(HieTypeFix -> IfaceType
hieTypeToIface (HieTypeFix -> IfaceType)
-> (Int -> HieTypeFix) -> Int -> IfaceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Array Int HieTypeFlat -> HieTypeFix)
-> Array Int HieTypeFlat -> Int -> HieTypeFix
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) (Int -> IfaceType) -> NodeInfo Int -> NodeInfo IfaceType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HieAST Int -> NodeInfo Int
nodeInfo' HieAST Int
ast, HieAST Int -> Span
forall a. HieAST a -> Span
nodeSpan HieAST Int
ast)
Command
RefGraph -> HieDb -> IO ()
declRefs HieDb
conn
Dump FilePath
path -> do
IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
IORef NameCache -> DbMonadT IO () -> IO ()
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonadT IO () -> IO ()) -> DbMonadT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> FilePath -> DbMonadT IO ()
forall (m :: * -> *).
(NameCacheMonad m, MonadIO m) =>
DynFlags -> FilePath -> m ()
dump DynFlags
dynFlags FilePath
path
Reachable [Symbol]
s -> HieDb -> [Symbol] -> IO [Vertex]
getReachable HieDb
conn [Symbol]
s IO [Vertex] -> ([Vertex] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Vertex -> IO ()) -> [Vertex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vertex -> IO ()
forall a. Show a => a -> IO ()
print
Unreachable [Symbol]
s -> HieDb -> [Symbol] -> IO [Vertex]
getUnreachable HieDb
conn [Symbol]
s IO [Vertex] -> ([Vertex] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Vertex -> IO ()) -> [Vertex] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vertex -> IO ()
forall a. Show a => a -> IO ()
print
Html [Symbol]
s -> do
IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
IORef NameCache -> DbMonadT IO () -> IO ()
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonadT IO () -> IO ()) -> DbMonadT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ HieDb -> [Symbol] -> DbMonadT IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Options -> Bool
quiet Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"GCed " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" types in " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Seconds -> FilePath
showDuration Seconds
end
printInfo :: DynFlags -> NodeInfo IfaceType -> RealSrcSpan -> IO ()
printInfo :: DynFlags -> NodeInfo IfaceType -> Span -> IO ()
printInfo DynFlags
dynFlags NodeInfo IfaceType
x Span
sp = do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Span: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dynFlags (Span -> SDoc
forall a. Outputable a => a -> SDoc
ppr Span
sp)
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Constructors: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dynFlags (Set (FastString, FastString) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Set (FastString, FastString) -> SDoc)
-> Set (FastString, FastString) -> SDoc
forall a b. (a -> b) -> a -> b
$ NodeInfo IfaceType -> Set (FastString, FastString)
forall a. NodeInfo a -> Set (FastString, FastString)
nodeAnnotations NodeInfo IfaceType
x)
FilePath -> IO ()
putStrLn FilePath
"Identifiers:"
let idents :: [(Either ModuleName Name, IdentifierDetails IfaceType)]
idents = Map (Either ModuleName Name) (IdentifierDetails IfaceType)
-> [(Either ModuleName Name, IdentifierDetails IfaceType)]
forall k a. Map k a -> [(k, a)]
M.toList (Map (Either ModuleName Name) (IdentifierDetails IfaceType)
-> [(Either ModuleName Name, IdentifierDetails IfaceType)])
-> Map (Either ModuleName Name) (IdentifierDetails IfaceType)
-> [(Either ModuleName Name, IdentifierDetails IfaceType)]
forall a b. (a -> b) -> a -> b
$ NodeInfo IfaceType
-> Map (Either ModuleName Name) (IdentifierDetails IfaceType)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo IfaceType
x
[(Either ModuleName Name, IdentifierDetails IfaceType)]
-> ((Either ModuleName Name, IdentifierDetails IfaceType) -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Either ModuleName Name, IdentifierDetails IfaceType)]
idents (((Either ModuleName Name, IdentifierDetails IfaceType) -> IO ())
-> IO ())
-> ((Either ModuleName Name, IdentifierDetails IfaceType) -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Either ModuleName Name
ident,IdentifierDetails IfaceType
inf) -> do
case Either ModuleName Name
ident of
Left ModuleName
mdl -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Module: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
moduleNameString ModuleName
mdl
Right Name
nm -> do
case Name -> Maybe Module
nameModule_maybe Name
nm of
Maybe Module
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Module
m -> do
FilePath -> IO ()
putStr FilePath
"Symbol:"
Symbol -> IO ()
forall a. Show a => a -> IO ()
print (Symbol -> IO ()) -> Symbol -> IO ()
forall a b. (a -> b) -> a -> b
$ OccName -> Module -> Symbol
Symbol (Name -> OccName
nameOccName Name
nm) Module
m
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dynFlags (SDoc -> FilePath) -> SDoc -> FilePath
forall a b. (a -> b) -> a -> b
$
SDoc -> Int -> SDoc -> SDoc
hang (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
nm SDoc -> SDoc -> SDoc
<+> FilePath -> SDoc
text FilePath
"defined at" SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SrcSpan
nameSrcSpan Name
nm)) Int
4 (IdentifierDetails IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdentifierDetails IfaceType
inf)
FilePath -> IO ()
putStrLn FilePath
"Types:"
let types :: [IfaceType]
types = NodeInfo IfaceType -> [IfaceType]
forall a. NodeInfo a -> [a]
nodeType NodeInfo IfaceType
x
[IfaceType] -> (IfaceType -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [IfaceType]
types ((IfaceType -> IO ()) -> IO ()) -> (IfaceType -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IfaceType
typ -> do
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> FilePath
showSDoc DynFlags
dynFlags (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
typ)
FilePath -> IO ()
putStrLn FilePath
""
hieFileCommand :: HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand :: HieDb -> Options -> HieTarget -> (HieFile -> IO a) -> IO a
hieFileCommand HieDb
conn Options
opts HieTarget
target HieFile -> IO a
f = IO (IO a) -> IO a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (IO a) -> IO a) -> IO (IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Options -> Either HieDbErr (IO a) -> IO (IO a)
forall a. Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
opts (Either HieDbErr (IO a) -> IO (IO a))
-> IO (Either HieDbErr (IO a)) -> IO (IO a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HieDb
-> HieTarget -> (HieFile -> IO a) -> IO (Either HieDbErr (IO a))
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 :: Options -> Either HieDbErr a -> IO a
reportAmbiguousErr Options
_ (Right a
x) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
reportAmbiguousErr Options
o (Left HieDbErr
e) = do
Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> HieDbErr -> FilePath
showHieDbErr Options
o HieDbErr
e
IO a
forall a. IO a
exitFailure
showHieDbErr :: Options -> HieDbErr -> String
showHieDbErr :: Options -> HieDbErr -> FilePath
showHieDbErr Options
opts HieDbErr
e = case HieDbErr
e of
NoNameAtPoint HieTarget
t (Int, Int)
spn -> [FilePath] -> FilePath
unwords [FilePath
"No symbols found at",Options -> (Int, Int) -> FilePath
ppSpan Options
opts (Int, Int)
spn,FilePath
"in",(FilePath -> FilePath)
-> ((ModuleName, Maybe Unit) -> FilePath) -> HieTarget -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath
forall a. a -> a
id (\(ModuleName
mn,Maybe Unit
muid) -> Options -> ModuleName -> FilePath
ppMod Options
opts ModuleName
mn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (Unit -> FilePath) -> Maybe Unit -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\Unit
uid -> FilePath
"("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Options -> Unit -> FilePath
ppUnit Options
opts Unit
uidFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
")") Maybe Unit
muid) HieTarget
t]
NotIndexed ModuleName
mn Maybe Unit
muid -> [FilePath] -> FilePath
unwords [FilePath
"Module", Options -> ModuleName -> FilePath
ppMod Options
opts ModuleName
mn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (Unit -> FilePath) -> Maybe Unit -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\Unit
uid -> FilePath
"("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Options -> Unit -> FilePath
ppUnit Options
opts Unit
uidFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
")") Maybe Unit
muid, FilePath
"not indexed."]
AmbiguousUnitId NonEmpty ModuleInfo
xs -> [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Unit could be any of:" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: (ModuleInfo -> FilePath) -> [ModuleInfo] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
" - "FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (ModuleInfo -> FilePath) -> ModuleInfo -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unit -> FilePath
unitString (Unit -> FilePath)
-> (ModuleInfo -> Unit) -> ModuleInfo -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleInfo -> Unit
modInfoUnit) (NonEmpty ModuleInfo -> [ModuleInfo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ModuleInfo
xs)
[FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
"Use --unit-id to disambiguate"]
NameNotFound OccName
occ Maybe ModuleName
mn Maybe Unit
muid -> [FilePath] -> FilePath
unwords
[FilePath
"Couldn't find name:", Options -> OccName -> FilePath
ppName Options
opts OccName
occ, FilePath
-> (ModuleName -> FilePath) -> Maybe ModuleName -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" ((FilePath
"from module " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (ModuleName -> FilePath) -> ModuleName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
moduleNameString) Maybe ModuleName
mn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> (Unit -> FilePath) -> Maybe Unit -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\Unit
uid ->FilePath
"("FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++Options -> Unit -> FilePath
ppUnit Options
opts Unit
uidFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
")") Maybe Unit
muid]
NameUnhelpfulSpan Name
nm FilePath
msg -> [FilePath] -> FilePath
unwords
[FilePath
"Got no helpful spans for:", OccName -> FilePath
occNameString (Name -> OccName
nameOccName Name
nm), FilePath
"\nMsg:", FilePath
msg]
reportRefSpans :: Options -> [(Module,(Int,Int),(Int,Int),Maybe (Either FilePath BS.ByteString))] -> IO ()
reportRefSpans :: Options
-> [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
-> IO ()
reportRefSpans Options
opts [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
xs = do
IORef NameCache
nc <- NameCache -> IO (IORef NameCache)
forall a. a -> IO (IORef a)
newIORef (NameCache -> IO (IORef NameCache))
-> IO NameCache -> IO (IORef NameCache)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NameCache
makeNc
IORef NameCache -> DbMonadT IO () -> IO ()
forall a. IORef NameCache -> DbMonad a -> IO a
runDbM IORef NameCache
nc (DbMonadT IO () -> IO ()) -> DbMonadT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
-> ((Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))
-> DbMonadT IO ())
-> DbMonadT IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))]
xs (((Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))
-> DbMonadT IO ())
-> DbMonadT IO ())
-> ((Module, (Int, Int), (Int, Int),
Maybe (Either FilePath ByteString))
-> DbMonadT IO ())
-> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ \(Module
mn,(Int
sl,Int
sc),(Int
el,Int
ec),Maybe (Either FilePath ByteString)
hie_f) -> do
IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
FilePath -> IO ()
putStr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Options -> ModuleName -> FilePath
ppMod Options
opts (ModuleName -> FilePath) -> ModuleName -> FilePath
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mn
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
FilePath -> IO ()
putStr FilePath
":"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[SGR] -> IO ()
setSGR [Underlining -> SGR
SetUnderlining Underlining
SingleUnderline]
FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ Color -> (FilePath -> FilePath) -> Options -> FilePath -> FilePath
forall a. Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
Magenta FilePath -> FilePath
forall a. a -> a
id Options
opts (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
sl
, Char
':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show Int
sc
, Char
'-'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show Int
el
, Char
':'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath
forall a. Show a => a -> FilePath
show Int
ec
]
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
[SGR] -> IO ()
setSGR []
case Options -> Maybe Natural
context Options
opts of
Maybe Natural
Nothing -> () -> DbMonadT IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n) -> do
Maybe ByteString
msrc <- Maybe (Either FilePath ByteString)
-> (Either FilePath ByteString -> DbMonadT IO ByteString)
-> DbMonadT IO (Maybe ByteString)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (Either FilePath ByteString)
hie_f ((Either FilePath ByteString -> DbMonadT IO ByteString)
-> DbMonadT IO (Maybe ByteString))
-> (Either FilePath ByteString -> DbMonadT IO ByteString)
-> DbMonadT IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \case
Left FilePath
loc -> FilePath
-> (HieFile -> DbMonadT IO ByteString) -> DbMonadT IO ByteString
forall (m :: * -> *) a.
(NameCacheMonad m, MonadIO m) =>
FilePath -> (HieFile -> m a) -> m a
withHieFile FilePath
loc ((HieFile -> DbMonadT IO ByteString) -> DbMonadT IO ByteString)
-> (HieFile -> DbMonadT IO ByteString) -> DbMonadT IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> DbMonadT IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> DbMonadT IO ByteString)
-> (HieFile -> ByteString) -> HieFile -> DbMonadT IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieFile -> ByteString
hie_hs_src
Right ByteString
src -> ByteString -> DbMonadT IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
src
IO () -> DbMonadT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DbMonadT IO ()) -> IO () -> DbMonadT IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
msrc of
Maybe ByteString
Nothing -> FilePath -> IO ()
putStrLn FilePath
"<source unavailable>"
Just ByteString
src -> do
let ls :: [ByteString]
ls = ByteString -> [ByteString]
BS.lines ByteString
src
([ByteString]
beforeLines',[ByteString]
duringLines') = Int -> [ByteString] -> ([ByteString], [ByteString])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [ByteString]
ls
([ByteString]
duringLines,[ByteString]
afterLines') = Int -> [ByteString] -> ([ByteString], [ByteString])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
elInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [ByteString]
duringLines'
beforeLines :: [ByteString]
beforeLines = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
takeEnd Int
n [ByteString]
beforeLines'
afterLines :: [ByteString]
afterLines = Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
take Int
n [ByteString]
afterLines'
(ByteString
beforeChars,ByteString
during') = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
scInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
intersperse ByteString
"\n" ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
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' Int -> Int -> Int
forall a. Num a => a -> a -> a
- (ByteString -> Int
BS.length ([ByteString] -> ByteString
forall a. [a] -> a
last [ByteString]
duringLines) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ec) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
during'
before :: ByteString
before = [ByteString] -> ByteString
BS.unlines [ByteString]
beforeLines ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
beforeChars
after :: ByteString
after = ByteString
afterChars ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> ByteString
BS.unlines [ByteString]
afterLines
ByteString -> IO ()
BS.putStr ByteString
before
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
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
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options -> Bool
colour Options
opts) (IO () -> IO ()) -> IO () -> IO ()
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 FilePath 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),Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a. a -> Maybe a
Just (Either FilePath ByteString -> Maybe (Either FilePath ByteString))
-> Either FilePath ByteString -> Maybe (Either FilePath ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath ByteString
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ByteString)
-> FilePath -> Either FilePath ByteString
forall a b. (a -> b) -> a -> b
$ RefRow -> FilePath
refSrc RefRow
x)
| (RefRow
x:.ModuleInfo
inf) <- [Res RefRow]
xs
, let mdl :: Module
mdl = Unit -> ModuleName -> Module
mkModule (ModuleInfo -> Unit
modInfoUnit ModuleInfo
inf) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
inf)
]
colouredPP :: Color -> (a -> String) -> Options -> a -> String
colouredPP :: Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
c a -> FilePath
pp Options
opts a
x = FilePath
pre FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> a -> FilePath
pp a
x FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
post
where
(FilePath
pre,FilePath
post)
| Options -> Bool
colour Options
opts = ([SGR] -> FilePath
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
c], [SGR] -> FilePath
setSGRCode [])
| Bool
otherwise = (FilePath
"",FilePath
"")
ppName :: Options -> OccName -> String
ppName :: Options -> OccName -> FilePath
ppName = Color -> (OccName -> FilePath) -> Options -> OccName -> FilePath
forall a. Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
Red OccName -> FilePath
occNameString
ppMod :: Options -> ModuleName -> String
ppMod :: Options -> ModuleName -> FilePath
ppMod = Color
-> (ModuleName -> FilePath) -> Options -> ModuleName -> FilePath
forall a. Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
Green ModuleName -> FilePath
moduleNameString
ppUnit :: Options -> Unit -> String
ppUnit :: Options -> Unit -> FilePath
ppUnit = Color -> (Unit -> FilePath) -> Options -> Unit -> FilePath
forall a. Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
Yellow Unit -> FilePath
forall a. Show a => a -> FilePath
show
ppSpan :: Options -> (Int,Int) -> String
ppSpan :: Options -> (Int, Int) -> FilePath
ppSpan = Color
-> ((Int, Int) -> FilePath) -> Options -> (Int, Int) -> FilePath
forall a. Color -> (a -> FilePath) -> Options -> a -> FilePath
colouredPP Color
Magenta (Int, Int) -> FilePath
forall a. Show a => a -> FilePath
show